From dc8feed452a7b62cab7f9dbb6e0961639ea0cec2 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 17 Jan 2020 14:21:47 -0700 Subject: [PATCH 001/274] remove dependency on GFS_typedefs for rrtmg_sw_pre --- physics/dcyc2.f | 1 - physics/rrtmg_sw_pre.F90 | 57 +++++---- physics/rrtmg_sw_pre.meta | 241 +++++++++++++++++++++++++++++--------- 3 files changed, 212 insertions(+), 87 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 92369d712..9bb3a1d58 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -404,7 +404,6 @@ subroutine dcyc2t3_post_run( & & im, adjsfcdsw, adjsfcnsw, adjsfcusw, & & errmsg, errflg) - use GFS_typedefs, only: GFS_diag_type use machine, only: kind_phys implicit none diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 8eeb16430..a76aed443 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -14,35 +14,36 @@ end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table !! \htmlinclude rrtmg_sw_pre_run.html !! - subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & - nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & - alb1d, errmsg, errflg) + subroutine rrtmg_sw_pre_run (im, lsswr, pertalb, tsfg, tsfa, coszen, & + alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf,& + alnwf, facsf, facwf, fice, tisfc, sfalb, nday, idxday, sfcalb1, & + sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_sfcprop_type use module_radiation_surface, only: NF_ALBD, setalb implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_grid_type), intent(in) :: Grid - integer, intent(in) :: im - integer, intent(out) :: nday - integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: alb1d - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(in) :: im + logical, intent(in) :: lsswr + real(kind=kind_phys), dimension(5), intent(in) :: pertalb + real(kind=kind_phys), dimension(im), intent(in) :: tsfa, tsfg, coszen + real(kind=kind_phys), dimension(im), intent(in) :: alb1d + real(kind=kind_phys), dimension(im), intent(in) :: slmsk, snowd, & + sncovr, snoalb, zorl, & + hprime, alvsf, alnsf, & + alvwf, alnwf, facsf, & + facwf, fice, tisfc + real(kind=kind_phys), dimension(im), intent(inout) :: sfalb + integer, intent(out) :: nday + integer, dimension(im), intent(out) :: idxday + real(kind=kind_phys), dimension(im), intent(out) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables integer :: i - real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb + real(kind=kind_phys), dimension(im,NF_ALBD) :: sfcalb ! Initialize CCPP error handling variables errmsg = '' @@ -51,13 +52,13 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & ! --- ... start radiation calculations ! remember to set heating rate unit to k/sec! !> -# Start SW radiation calculations - if (Model%lsswr) then + if (lsswr) then !> - Check for daytime points for SW radiation. nday = 0 idxday = 0 do i = 1, IM - if (Radtend%coszen(i) >= 0.0001) then + if (coszen(i) >= 0.0001) then nday = nday + 1 idxday(nday) = i endif @@ -66,17 +67,13 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. - call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, & ! --- inputs: - Sfcprop%snoalb, Sfcprop%zorl, Radtend%coszen, & - tsfg, tsfa, Sfcprop%hprime(:,1), Sfcprop%alvsf, & - Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & - Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & - Sfcprop%tisfc, IM, & - alb1d, Model%pertalb, & ! mg, sfc-perts + call setalb (slmsk, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, & ! --- inputs + hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, & + tisfc, IM, alb1d, pertalb, & ! mg, sfc-perts sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. - Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) else nday = 0 idxday = 0 diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 6a68a8cd6..76c3e6f97 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -6,61 +6,30 @@ [ccpp-arg-table] name = rrtmg_sw_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT - dimensions = () - type = GFS_control_type - intent = in - optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT - dimensions = () - type = GFS_grid_type - intent = in - optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = Fortran DDT containing FV3-GFS surface fields - units = DDT - dimensions = () - type = GFS_sfcprop_type - intent = in - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = Fortran DDT containing FV3-GFS radiation tendencies - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F [im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent + standard_name = horizontal_dimension + long_name = horizontal dimension units = count dimensions = () type = integer intent = in optional = F -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = integer - intent = out + type = logical + intent = in optional = F -[idxday] - standard_name = daytime_points - long_name = daytime points - units = index - dimensions = (horizontal_dimension) - type = integer - intent = out +[pertalb] + standard_name = magnitude_of_surface_albedo_perturbation + long_name = magnitude of surface albedo perturbation + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation @@ -80,6 +49,175 @@ kind = kind_phys intent = in optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alb1d] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name = fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfalb] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = out + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F [sfcalb1] standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam @@ -116,15 +254,6 @@ kind = kind_phys intent = out optional = F -[alb1d] - standard_name = surface_albedo_perturbation - long_name = surface albedo perturbation - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From fda501ec210d8accff5854dc5f18f9d952451e76 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 21 Jan 2020 12:39:39 -0700 Subject: [PATCH 002/274] remove dependency on GFS_typedefs.F90 for rrtmg_sw_post scheme --- physics/rrtmg_sw_post.F90 | 106 ++++++++++----------- physics/rrtmg_sw_post.meta | 190 +++++++++++++++++++++++++++++-------- 2 files changed, 206 insertions(+), 90 deletions(-) diff --git a/physics/rrtmg_sw_post.F90 b/physics/rrtmg_sw_post.F90 index e11491d48..e433271e2 100644 --- a/physics/rrtmg_sw_post.F90 +++ b/physics/rrtmg_sw_post.F90 @@ -15,29 +15,29 @@ end subroutine rrtmg_sw_post_init !! \htmlinclude rrtmg_sw_post_run.html !! #endif - subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & - im, ltp, nday, lm, kd, htswc, htsw0, & - sfcalb1, sfcalb2, sfcalb3, sfcalb4, scmpsw, errmsg, errflg) + subroutine rrtmg_sw_post_run (im, levr, levs, ltp, nday, lm, kd, lsswr, & + swhtr, htswc, htsw0, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & + scmpsw, sfcfsw, topfsw, nirbmdi, nirdfdi, visbmdi, visdfdi, & + nirbmui, nirdfui, visbmui, visdfui, sfcdsw, sfcnsw, htrsw, & + swhc, errmsg, errflg) use machine, only: kind_phys use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & cmpfsw_type - use GFS_typedefs, only: GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_diag_type implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_grid_type), intent(in) :: Grid - type(GFS_diag_type), intent(inout) :: Diag - integer, intent(in) :: im, lm, kd, nday, ltp - type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(inout) :: scmpsw - real(kind=kind_phys), dimension(Size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htswc, htsw0 - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 + + integer, intent(in) :: im, lm, kd, nday, levr, levs, ltp + logical, intent(in) :: lsswr, swhtr + real(kind=kind_phys), dimension(im, levr+LTP), intent(in) :: htswc, htsw0 + real(kind=kind_phys), dimension(im), intent(in) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 + type(cmpfsw_type), dimension(im), intent(inout) :: scmpsw + type(sfcfsw_type), dimension(im), intent(inout) :: sfcfsw + type(topfsw_type), dimension(im), intent(inout) :: topfsw + real(kind=kind_phys), dimension(im), intent(inout) :: nirbmdi, nirdfdi, visbmdi, & + visdfdi, nirbmui, nirdfui, & + visbmui, visdfui, sfcdsw, sfcnsw + real(kind=kind_phys), dimension(im,levs), intent(inout) :: htrsw, swhc character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables @@ -47,29 +47,29 @@ subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & errmsg = '' errflg = 0 - if (Model%lsswr) then + if (lsswr) then if (nday > 0) then do k = 1, LM k1 = k + kd - Radtend%htrsw(1:im,k) = htswc(1:im,k1) + htrsw(1:im,k) = htswc(1:im,k1) enddo ! We are assuming that radiative tendencies are from bottom to top ! --- repopulate the points above levr i.e. LM - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%htrsw (1:im,k) = Radtend%htrsw (1:im,LM) + if (lm < levs) then + do k = lm, levs + htrsw (1:im,k) = htrsw (1:im,LM) enddo endif - if (Model%swhtr) then + if (swhtr) then do k = 1, lm k1 = k + kd - Radtend%swhc(1:im,k) = htsw0(1:im,k1) + swhc(1:im,k) = htsw0(1:im,k1) enddo ! --- repopulate the points above levr i.e. LM - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%swhc(1:im,k) = Radtend%swhc(1:im,LM) + if (lm < levs) then + do k = lm, levs + swhc(1:im,k) = swhc(1:im,LM) enddo endif endif @@ -79,47 +79,47 @@ subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & !! output. do i=1,im - Coupling%nirbmdi(i) = scmpsw(i)%nirbm - Coupling%nirdfdi(i) = scmpsw(i)%nirdf - Coupling%visbmdi(i) = scmpsw(i)%visbm - Coupling%visdfdi(i) = scmpsw(i)%visdf - - Coupling%nirbmui(i) = scmpsw(i)%nirbm * sfcalb1(i) - Coupling%nirdfui(i) = scmpsw(i)%nirdf * sfcalb2(i) - Coupling%visbmui(i) = scmpsw(i)%visbm * sfcalb3(i) - Coupling%visdfui(i) = scmpsw(i)%visdf * sfcalb4(i) + nirbmdi(i) = scmpsw(i)%nirbm + nirdfdi(i) = scmpsw(i)%nirdf + visbmdi(i) = scmpsw(i)%visbm + visdfdi(i) = scmpsw(i)%visdf + + nirbmui(i) = scmpsw(i)%nirbm * sfcalb1(i) + nirdfui(i) = scmpsw(i)%nirdf * sfcalb2(i) + visbmui(i) = scmpsw(i)%visbm * sfcalb3(i) + visdfui(i) = scmpsw(i)%visdf * sfcalb4(i) enddo else ! if_nday_block - Radtend%htrsw(:,:) = 0.0 + htrsw(:,:) = 0.0 - Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) - Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) do i=1,im - Coupling%nirbmdi(i) = 0.0 - Coupling%nirdfdi(i) = 0.0 - Coupling%visbmdi(i) = 0.0 - Coupling%visdfdi(i) = 0.0 - - Coupling%nirbmui(i) = 0.0 - Coupling%nirdfui(i) = 0.0 - Coupling%visbmui(i) = 0.0 - Coupling%visdfui(i) = 0.0 + nirbmdi(i) = 0.0 + nirdfdi(i) = 0.0 + visbmdi(i) = 0.0 + visdfdi(i) = 0.0 + + nirbmui(i) = 0.0 + nirdfui(i) = 0.0 + visbmui(i) = 0.0 + visdfui(i) = 0.0 enddo - if (Model%swhtr) then - Radtend%swhc(:,:) = 0 + if (swhtr) then + swhc(:,:) = 0 endif endif ! end_if_nday ! --- radiation fluxes for other physics processes do i=1,im - Coupling%sfcnsw(i) = Radtend%sfcfsw(i)%dnfxc - Radtend%sfcfsw(i)%upfxc - Coupling%sfcdsw(i) = Radtend%sfcfsw(i)%dnfxc + sfcnsw(i) = sfcfsw(i)%dnfxc - sfcfsw(i)%upfxc + sfcdsw(i) = sfcfsw(i)%dnfxc enddo endif ! end_if_lsswr diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 28b54b5bf..b1e0e63db 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -6,49 +6,25 @@ [ccpp-arg-table] name = rrtmg_sw_post_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[levr] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = adjusted number of vertical layers for radiation + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = Fortran DDT containing FV3-GFS diagnotics data - units = DDT - dimensions = () - type = GFS_diag_type - intent = inout - optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = Fortran DDT containing FV3-GFS fields targetted for diagnostic output - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components - units = DDT - dimensions = () - type = GFS_coupling_type - intent = inout - optional = F -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels units = count dimensions = () type = integer @@ -86,6 +62,22 @@ type = integer intent = in optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[swhtr] + standard_name = flag_for_output_of_shortwave_heating_rate + long_name = flag to output sw heating rate (Radtend%swhc) + units = flag + dimensions = () + type = logical + intent = in + optional = F [htswc] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky heating rate due to shortwave radiation @@ -148,6 +140,130 @@ type = cmpfsw_type intent = inout optional = F +[sfcfsw] + standard_name = sw_fluxes_sfc + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcfsw_type + intent = inout + optional = F +[topfsw] + standard_name = sw_fluxes_top_atmosphere + long_name = sw radiation fluxes at toa + units = W m-2 + dimensions = (horizontal_dimension) + type = topfsw_type + intent = inout + optional = F +[nirbmdi] + standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir beam sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nirdfdi] + standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir diff sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[visbmdi] + standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis beam sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[visdfdi] + standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis diff sw downward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nirbmui] + standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir beam sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[nirdfui] + standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step + long_name = sfc nir diff sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[visbmui] + standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis beam sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[visdfui] + standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step + long_name = sfc uv+vis diff sw upward flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcdsw] + standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky sfc downward sw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcnsw] + standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step + long_name = total sky sfc netsw flx into ground + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[htrsw] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + long_name = total sky sw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[swhc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = clear sky sw heating rates + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 2d353c0a547b68efe50c9d063cd6cab0f9a48eee Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 21 Jan 2020 12:40:15 -0700 Subject: [PATCH 003/274] remove dependency on GFS_typedefs.F90 for rrtmg_lw_pre scheme --- physics/rrtmg_lw_pre.F90 | 33 +++++------- physics/rrtmg_lw_pre.meta | 106 +++++++++++++++++++++++++++----------- 2 files changed, 91 insertions(+), 48 deletions(-) diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 5f128a79a..c14053a10 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -14,37 +14,32 @@ end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table !! \htmlinclude rrtmg_lw_pre_run.html !! - subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errmsg, errflg) + subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& + zorl, hprime, tsfg, tsfa, semis, errmsg, errflg) use machine, only: kind_phys - - use GFS_typedefs, only: GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_sfcprop_type use module_radiation_surface, only: setemis implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_grid_type), intent(in) :: Grid - integer, intent(in) :: im - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + + integer, intent(in) :: im + logical, intent(in) :: lslwr + real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, slmsk, & + snowd, sncovr, zorl, hprime, tsfa, tsfg + real(kind=kind_phys), dimension(im), intent(out) :: semis + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (Model%lslwr) then + if (lslwr) then !> - Call module_radiation_surface::setemis(),to setup surface !! emissivity for LW radiation. - call setemis (Grid%xlon, Grid%xlat, Sfcprop%slmsk, & ! --- inputs - Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%zorl, & - tsfg, tsfa, Sfcprop%hprime(:,1), IM, & - Radtend%semis) ! --- outputs + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, & + hprime, im, & ! --- inputs + semis) ! --- outputs endif end subroutine rrtmg_lw_pre_run diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 6b4488b26..481850494 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -6,44 +6,83 @@ [ccpp-arg-table] name = rrtmg_lw_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag dimensions = () - type = GFS_grid_type + type = logical intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = Fortran DDT containing FV3-GFS surface fields - units = DDT - dimensions = () - type = GFS_sfcprop_type +[xlat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys intent = in optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = Fortran DDT containing FV3-GFS radiation tendencies - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in optional = F -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys intent = in optional = F [tsfg] @@ -64,6 +103,15 @@ kind = kind_phys intent = in optional = F +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From eeaa98bc84f2709be9f6cc82a4eaafae14e89fec Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 21 Jan 2020 15:52:13 -0700 Subject: [PATCH 004/274] remove dependency on GFS_typedefs.F90 for rrtmg_lw_post scheme --- physics/rrtmg_lw_post.F90 | 57 ++++++++++----------- physics/rrtmg_lw_post.meta | 100 +++++++++++++++++++++++++------------ 2 files changed, 97 insertions(+), 60 deletions(-) diff --git a/physics/rrtmg_lw_post.F90 b/physics/rrtmg_lw_post.F90 index 971b278dd..310b660e3 100644 --- a/physics/rrtmg_lw_post.F90 +++ b/physics/rrtmg_lw_post.F90 @@ -16,25 +16,26 @@ end subroutine rrtmg_lw_post_init !! \htmlinclude rrtmg_lw_post_run.html !! #endif - subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & - im, ltp, lm, kd, tsfa, htlwc, htlw0, errmsg, errflg) + subroutine rrtmg_lw_post_run (im, levs, ltp, lm, kd, lslwr, lwhtr, & + tsfa, htlwc, htlw0, sfcflw, tsflw, htrlw, lwhc, sfcdlw, & + errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type + use module_radlw_parameters, only: sfcflw_type + implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_grid_type), intent(in) :: Grid - type(GFS_radtend_type), intent(inout) :: Radtend - integer, intent(in) :: im, ltp, LM, kd - real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlwc - real(kind=kind_phys), dimension(size(Grid%xlon,1), Model%levr+LTP), intent(in) :: htlw0 - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + + integer, intent(in) :: im, ltp, LM, kd, levs + logical, intent(in) :: lslwr, lwhtr + real(kind=kind_phys), dimension(im, LM+LTP), intent(in) :: htlwc + real(kind=kind_phys), dimension(im, LM+LTP), intent(in) :: htlw0 + real(kind=kind_phys), dimension(im), intent(in) :: tsfa + type(sfcflw_type), dimension(im), intent(in) :: sfcflw + real(kind=kind_phys), dimension(im), intent(inout) :: tsflw, sfcdlw + real(kind=kind_phys), dimension(im, levs), intent(inout) :: htrlw, lwhc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! local variables integer :: k1, k @@ -42,38 +43,38 @@ subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & errmsg = '' errflg = 0 - if (Model%lslwr) then + if (lslwr) then !> -# Save calculation results !> - Save surface air temp for diurnal adjustment at model t-steps - Radtend%tsflw (:) = tsfa(:) + tsflw (:) = tsfa(:) do k = 1, LM k1 = k + kd - Radtend%htrlw(1:im,k) = htlwc(1:im,k1) + htrlw(1:im,k) = htlwc(1:im,k1) enddo ! --- repopulate the points above levr - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%htrlw (1:im,k) = Radtend%htrlw (1:im,LM) + if (lm < levs) then + do k = lm, levs + htrlw (1:im,k) = htrlw (1:im,LM) enddo endif - if (Model%lwhtr) then + if (lwhtr) then do k = 1, lm k1 = k + kd - Radtend%lwhc(1:im,k) = htlw0(1:im,k1) + lwhc(1:im,k) = htlw0(1:im,k1) enddo ! --- repopulate the points above levr - if (lm < Model%levs) then - do k = lm,Model%levs - Radtend%lwhc(1:im,k) = Radtend%lwhc(1:im,LM) + if (lm < levs) then + do k = lm, levs + lwhc(1:im,k) = lwhc(1:im,LM) enddo endif endif ! --- radiation fluxes for other physics processes - Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc + sfcdlw(:) = sfcflw(:)%dnfxc endif ! end_if_lslwr diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 92b4003d7..b5176392d 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -6,41 +6,17 @@ [ccpp-arg-table] name = rrtmg_lw_post_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT - dimensions = () - type = GFS_control_type - intent = in - optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = Fortran DDT containing FV3-GFS fields targetted for diagnostic output - units = DDT - dimensions = () - type = GFS_radtend_type - intent = inout - optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components - units = DDT - dimensions = () - type = GFS_coupling_type - intent = inout - optional = F -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels units = count dimensions = () type = integer @@ -70,6 +46,22 @@ type = integer intent = in optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lwhtr] + standard_name = flag_for_output_of_longwave_heating_rate + long_name = flag to output lw heating rate (Radtend%lwhc) + units = flag + dimensions = () + type = logical + intent = in + optional = F [tsfa] standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation @@ -97,6 +89,50 @@ kind = kind_phys intent = in optional = F +[sfcflw] + standard_name = lw_fluxes_sfc + long_name = lw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcflw_type + intent = in + optional = F +[tsflw] + standard_name = surface_midlayer_air_temperature_in_longwave_radiation + long_name = surface air temp during lw calculation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[htrlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + long_name = total sky lw heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lwhc] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + long_name = clear sky lw heating rates + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcdlw] + standard_name = surface_downwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc downward lw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From c7dbbcee73f1bd9456a4fa4bf4b9681ecb1a5ace Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 23 Jan 2020 09:55:12 -0700 Subject: [PATCH 005/274] remove dependency on GFS_typedefs for GFS_phys_time_vary_init for the SCM --- physics/GFS_phys_time_vary.scm.F90 | 117 ++++---- physics/GFS_phys_time_vary.scm.meta | 361 +++++++++++++++++++++-- physics/GFS_suite_init_finalize_test.F90 | 2 - 3 files changed, 405 insertions(+), 75 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 3b4bbaf77..ec4f13a28 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -33,18 +33,33 @@ module GFS_phys_time_vary !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! - subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errflg) + subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, aero_in, & + iccn, iflip, idate, nblks, blksz, nx, ny, xlat_d, xlon_d, levh2o_int, & + levozp_int, ozpl, h2opl, aer_nm, jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, & + jindx2_h, ddy_h, jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, & + ddx_aer, jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, & + oz_pres_int, h2o_pres_int, imap, jmap, errmsg, errflg) - use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_Tbd_type, GFS_interstitial_type + use machine, only: kind_phys implicit none ! Interface variables - type(GFS_grid_type), intent(inout) :: Grid - type(GFS_control_type), intent(in) :: Model - type(GFS_interstitial_type), intent(inout) :: Interstitial - type(GFS_tbd_type), intent(in) :: Tbd + integer, intent(in) :: im, ntoz, me, master, iflip, nblks, nx, ny, levh2o_int, levozp_int + integer, dimension(4), intent(in) :: idate + integer, dimension(nblks), intent(in) :: blksz + logical, intent(in) :: h2o_phys, aero_in, iccn + real(kind=kind_phys), dimension(im), intent(in) :: xlat_d, xlon_d + real(kind=kind_phys), dimension(:,:,:), intent(in) :: ozpl + real(kind=kind_phys), dimension(:,:,:), intent(in) :: h2opl + real(kind=kind_phys), dimension(:,:,:), intent(in) :: aer_nm + + integer, dimension(im), intent(inout) :: imap, jmap + integer, dimension(:), intent(inout) :: jindx1_o3, jindx2_o3, jindx1_h, jindx2_h, jindx1_aer, jindx2_aer, iindx1_aer, iindx2_aer, jindx1_ci, jindx2_ci, iindx1_ci, iindx2_ci + real(kind=kind_phys), dimension(:), intent(inout) :: ddy_o3, ddy_h, ddy_aer, ddx_aer, ddy_ci, ddx_ci + real(kind=kind_phys), dimension(levozp_int), intent(inout) :: oz_pres_int + real(kind=kind_phys), dimension(levh2o_int), intent(inout) :: h2o_pres_int + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -60,120 +75,120 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf nb = 1 nt = 1 - call read_o3data (Model%ntoz, Model%me, Model%master) + call read_o3data (ntoz, me, master) ! Consistency check that the hardcoded values for levozp and ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(Tbd%ozpl, dim=2).ne.levozp) then + if (size(ozpl, dim=2).ne.levozp) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(Tbd%ozpl, dim=2) + levozp, " /= ", size(ozpl, dim=2) errflg = 1 end if - if (size(Tbd%ozpl, dim=3).ne.oz_coeff) then + if (size(ozpl, dim=3).ne.oz_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(Tbd%ozpl, dim=3) + oz_coeff, " /= ", size(ozpl, dim=3) errflg = 1 end if - call read_h2odata (Model%h2o_phys, Model%me, Model%master) + call read_h2odata (h2o_phys, me, master) ! Consistency check that the hardcoded values for levh2o and ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(Tbd%h2opl, dim=2).ne.levh2o) then + if (size(h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(Tbd%h2opl, dim=2) + levh2o, " /= ", size(h2opl, dim=2) errflg = 1 end if - if (size(Tbd%h2opl, dim=3).ne.h2o_coeff) then + if (size(h2opl, dim=3).ne.h2o_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(Tbd%h2opl, dim=3) + h2o_coeff, " /= ", size(h2opl, dim=3) errflg = 1 end if - if (Model%aero_in) then + if (aero_in) then ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def - if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then + if (size(aer_nm, dim=3).ne.ntrcaerm) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & - ntrcaerm, " /= ", size(Tbd%aer_nm, dim=3) + ntrcaerm, " /= ", size(aer_nm, dim=3) errflg = 1 else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .true., then ntrcaer == ntrcaerm - ntrcaer = size(Tbd%aer_nm, dim=3) + ! If aero_in is .true., then ntrcaer == ntrcaerm + ntrcaer = size(aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) + call read_aerdata (me, master, iflip, idate) endif else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .false., then ntrcaer == 1 - ntrcaer = size(Tbd%aer_nm, dim=3) + ! If aero_in is .false., then ntrcaer == 1 + ntrcaer = size(aer_nm, dim=3) endif - if (Model%iccn) then - call read_cidata ( Model%me, Model%master) + if (iccn) then + call read_cidata (me, master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif ! Update values of oz_pres in Interstitial data type for all threads - if (Model%ntoz > 0) then - Interstitial%oz_pres = oz_pres + if (ntoz > 0) then + oz_pres_int = oz_pres end if ! Update values of h2o_pres in Interstitial data type for all threads - if (Model%h2o_phys) then - Interstitial%h2o_pres = h2o_pres + if (h2o_phys) then + h2o_pres_int = h2o_pres end if !--- read in and initialize ozone - if (Model%ntoz > 0) then - call setindxoz (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_o3, & - Grid%jindx2_o3, Grid%ddy_o3) + if (ntoz > 0) then + call setindxoz (blksz(nb), xlat_d, jindx1_o3, & + jindx2_o3, ddy_o3) endif !--- read in and initialize stratospheric water - if (Model%h2o_phys) then - call setindxh2o (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_h, & - Grid%jindx2_h, Grid%ddy_h) + if (h2o_phys) then + call setindxh2o (blksz(nb), xlat_d, jindx1_h, & + jindx2_h, ddy_h) endif !--- read in and initialize aerosols - if (Model%aero_in) then - call setindxaer (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_aer, & - Grid%jindx2_aer, Grid%ddy_aer, Grid%xlon_d, & - Grid%iindx1_aer, Grid%iindx2_aer, Grid%ddx_aer, & - Model%me, Model%master) + if (aero_in) then + call setindxaer (blksz(nb), xlat_d, jindx1_aer, & + jindx2_aer, ddy_aer, xlon_d, & + iindx1_aer, iindx2_aer, ddx_aer, & + me, master) endif !--- read in and initialize IN and CCN - if (Model%iccn) then - call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & - Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & - Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) + if (iccn) then + call setindxci (blksz(nb), xlat_d, jindx1_ci, & + jindx2_ci, ddy_ci, xlon_d, & + iindx1_ci, iindx2_ci, ddx_ci) endif !--- initial calculation of maps local ix -> global i and j, store in Tbd ix = 0 nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx + do j = 1, ny + do i = 1, nx ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then + if (ix .gt. blksz(nb)) then ix = 1 nb = nb + 1 endif - Tbd%jmap(ix) = j - Tbd%imap(ix) = i + jmap(ix) = j + imap(ix) = i enddo enddo diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 57a82ecb0..30b8bce46 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1,38 +1,355 @@ [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index dimensions = () - type = GFS_grid_type - intent = inout + type = integer + intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Interstitial] - standard_name = GFS_interstitial_type_instance - long_name = Fortran DDT containing FV3-GFS interstitial data - units = DDT +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index dimensions = () - type = GFS_interstitial_type - intent = inout + type = integer + intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS miscellaneous data - units = DDT +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag dimensions = () - type = GFS_tbd_type + type = logical + intent = in + optional = F +[aero_in] + standard_name = flag_for_aerosol_input_MG + long_name = flag for using aerosols in Morrison-Gettelman MP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = iflip - is not the same as flipv + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer intent = in optional = F +[nblks] + standard_name = number_of_blocks + long_name = for explicit data blocking: number of blocks + units = count + dimensions = () + type = integer + intent = in + optional = F +[blksz] + standard_name = horizontal_block_size + long_name = for explicit data blocking: block sizes of all blocks + units = count + dimensions = (number_of_blocks) + type = integer + intent = in + optional = F +[nx] + standard_name = number_of_points_in_x_direction_for_this_MPI_rank + long_name = number of points in x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[ny] + standard_name = number_of_points_in_y_direction_for_this_MPI_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[xlat_d] + standard_name = latitude_degree + long_name = latitude in degrees + units = degree + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon_d] + standard_name = longitude_degree + long_name = longitude in degrees + units = degree + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[levh2o_int] + standard_name = vertical_dimension_of_h2o_forcing_data + long_name = number of vertical layers in h2o forcing data + units = count + dimensions = () + type = integer + intent = in + optional = F +[levozp_int] + standard_name = vertical_dimension_of_ozone_forcing_data + long_name = number of vertical layers in ozone forcing data + units = count + dimensions = () + type = integer + intent = in + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[oz_pres_int] + standard_name = natural_log_of_ozone_forcing_data_pressure_levels + long_name = natural log of ozone forcing data pressure levels + units = log(Pa) + dimensions = (vertical_dimension_of_ozone_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[h2o_pres_int] + standard_name = natural_log_of_h2o_forcing_data_pressure_levels + long_name = natural log of h2o forcing data pressure levels + units = log(Pa) + dimensions = (vertical_dimension_of_h2o_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_suite_init_finalize_test.F90 b/physics/GFS_suite_init_finalize_test.F90 index 0a958d2fc..bdd1d2939 100644 --- a/physics/GFS_suite_init_finalize_test.F90 +++ b/physics/GFS_suite_init_finalize_test.F90 @@ -43,8 +43,6 @@ end subroutine GFS_suite_ini_fini_test_finalize !! subroutine GFS_suite_ini_fini_test_run (errmsg, errflg) - use GFS_typedefs, only: GFS_interstitial_type - implicit none ! interface variables From 8ba1c3c74ef8e19e8652480a626cd05ba2b03515 Mon Sep 17 00:00:00 2001 From: "andrew.hazelton" Date: Wed, 4 Mar 2020 21:45:58 +0000 Subject: [PATCH 006/274] Changes to EDMF-HAFS and EDMF-TKE to OutputEddy Diffusivity --- physics/moninedmf_hafs.f | 11 +++++++++-- physics/moninedmf_hafs.meta | 9 +++++++++ physics/satmedmfvdifq.F | 11 +++++++++-- physics/satmedmfvdifq.meta | 9 +++++++++ 4 files changed, 36 insertions(+), 4 deletions(-) diff --git a/physics/moninedmf_hafs.f b/physics/moninedmf_hafs.f index 5c6ff85a8..2bc682909 100644 --- a/physics/moninedmf_hafs.f +++ b/physics/moninedmf_hafs.f @@ -64,7 +64,7 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & - & xkzminv,moninq_fac,islimsk,errmsg,errflg) + & xkzminv,moninq_fac,islimsk,dkudiagnostic,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -144,7 +144,7 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & ti(im,km-1), shr2(im,km-1), & & al(im,km-1), ad(im,km), & & au(im,km-1), a1(im,km), & - & a2(im,km*ntrac) + & a2(im,km*ntrac), dkudiagnostic(im,km-1) ! real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), & & ucko(im,km), vcko(im,km), xmf(im,km) @@ -1395,6 +1395,13 @@ subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! enddo enddo + + do k = 1,km1 + do i=1,im + dkudiagnostic(i,k) = dku(i,k) + enddo + enddo + ! ! solve tridiagonal problem for momentum ! diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index bc1461ada..f22ccbb25 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -507,6 +507,15 @@ type = integer intent = in optional = F +[dkudiagnostic] + standard_name = atmosphere_momentum_diffusivity + long_name = diffusivity for momentum + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 546cefca6..0fd44ac0b 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -65,7 +65,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & prsi,del,prsl,prslk,phii,phil,delt, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & - & errmsg,errflg) + & dkudiagnostic,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -123,7 +123,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & slx(im,km), svx(im,km), qtx(im,km), & tvx(im,km), pix(im,km), radx(im,km-1), & dku(im,km-1),dkt(im,km-1), dkq(im,km-1), - & cku(im,km-1),ckt(im,km-1) + & cku(im,km-1),ckt(im,km-1), + & dkudiagnostic(im,km-1) ! real(kind=kind_phys) plyr(im,km), rhly(im,km), cfly(im,km), & qstl(im,km) @@ -1383,6 +1384,12 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! enddo enddo + + do k = 1,km1 + do i=1,im + dkudiagnostic(i,k) = dku(i,k) + enddo + enddo c c solve tridiagonal problem for momentum c diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index ec679faec..b63e3ae40 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -578,6 +578,15 @@ kind = kind_phys intent = in optional = F +[dkudiagnostic] + standard_name = atmosphere_momentum_diffusivity + long_name = diffusivity for momentum + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 1df7376ed7293b29495f1b2b089cd6eb2862708b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 3 Apr 2020 09:44:51 -0600 Subject: [PATCH 007/274] Update CODEOWNERS for HWRF physics development --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 0d5230f89..a419f106a 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl @JulieSchramm +* @climbfuji @llpcarson @grantfirl @mzhangw # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From 10867d1b84eea12e8a9effef712965249830b9f5 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 10 Dec 2019 11:58:48 -0700 Subject: [PATCH 008/274] add hurricane-specific code to moninedmf.f --- physics/moninedmf.f | 366 ++++++++++++++++++++++++++++++++++------- physics/moninedmf.meta | 43 +++++ 2 files changed, 348 insertions(+), 61 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 1084aa426..a9532857c 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -64,7 +64,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & - & xkzminv,moninq_fac,errmsg,errflg) + & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & + & coef_ric_l,coef_ric_s,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -74,14 +75,15 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ! arguments ! - logical, intent(in) :: lprnt - integer, intent(in) :: ipr + logical, intent(in) :: lprnt, hurr_pbl + integer, intent(in) :: ipr, islimsk(im) integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) integer, intent(out) :: kpbl(im) ! real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s - real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac + real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac, var_ric, & + & coef_ric_l, coef_ric_s real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & & tau(im,km), rtg(im,km,ntrac) real(kind=kind_phys), intent(in) :: & @@ -180,7 +182,15 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & ptem, ptem1, ptem2, tx1(im), tx2(im) ! real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, - & cldtime + & cldtime, ttend_fac + + !! for hurricane application + real(kind=kind_phys) wspm(im,km-1) + integer kLOC ! RGF + real :: xDKU ! RGF + + integer, parameter :: useshape=2!0-- no change, original ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) + real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax cc parameter(gravi=1.0/grav) parameter(g=grav) @@ -211,6 +221,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & parameter (zstblmax = 2500., qlcr=3.5e-5) ! parameter (actei = 0.23) parameter (actei = 0.7) + + c c----------------------------------------------------------------------- c @@ -422,23 +434,48 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. ! compute the pbl height ! - do i=1,im - flg(i) = .false. - rbup(i) = rbsoil(i) -! - if(pblflg(i)) then - thermal(i) = thvx(i,1) - crb(i) = crbcon - else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) - tem = sqrt(u10m(i)**2+v10m(i)**2) - tem = max(tem, 1.) - robn = tem / (f0 * z0(i)) - tem1 = 1.e-7 * robn - crb(i) = 0.16 * (tem1 ** (-0.18)) - crb(i) = max(min(crb(i), crbmax), crbmin) - endif - enddo + if (.not. hurr_pbl) then + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + ! + if(pblflg(i)) then + thermal(i) = thvx(i,1) + crb(i) = crbcon + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + enddo + else + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + + ! use variable Ri for all conditions + if(pblflg(i)) then + thermal(i) = thvx(i,1) + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + endif + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = crbcon + if (var_ric .eq. 1.) then + if (islimsk(i) .eq. 1) crb(I) = coef_ric_l*(tem1)**(-0.18) + if (islimsk(i) .eq. 0) crb(I) = coef_ric_s*(tem1)**(-0.18) + endif + crb(i) = max(min(crb(i), crbmax), crbmin) + enddo + endif + !> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): !! \f[ !! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} @@ -719,38 +756,223 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & kpbl(i) = 1 endif enddo -! + + +!!! 20150915 WeiguoWang added alpha (moninq_fac) and wind-dependent modification of K by RGF +! ------------------------------------------------------------------------------------- +! begin RGF modifications +! this is version MOD05 + +! RGF determine wspd at roughly 500 m above surface, or as close as possible, +! reuse SPDK2 +! zi(i,k) is AGL, right? May not matter if applied only to water grid points + if(hurr_pbl .and. moninq_fac .lt. 0.0) then + do i=1,im + spdk2 = 0. + wspm(i,1) = 0. + do k = 1, kmpbl ! kmpbl is like a max possible pbl height + if (zi(i,k) .le. 500. .and. zi(i,k+1) .gt. 500.) then ! find level bracketing 500 m + spdk2 = SQRT(u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)) ! wspd near 500 m + wspm(i,1) = spdkw/0.6 ! now the Km limit for 500 m. just store in K=1 + wspm(i,2) = float(k) ! height of level at gridpoint i. store in K=2 + endif + enddo !k + enddo ! i + endif ! hurr_pbl and moninq_fac < 0 + + ! compute diffusion coefficients below pbl !> ## Compute diffusion coefficients below the PBL top !! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. - do k = 1, kmpbl - do i=1,im - if(k < kpbl(i)) then -! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ -! 1 (hpbl(i)-zl(i,1))), zfmin) - zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) - tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg - if(pblflg(i)) then - tem1 = vk * wscaleu(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - else - tem1 = vk * wscale(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) + if (.not. hurr_pbl) then + do k = 1, kmpbl + do i=1,im + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) endif - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) - dktx(i,k)= dkt(i,k) - endif - enddo - enddo + enddo !i + enddo !k + else + !hurricane PBL case (note that the i and k loop order has been switched) + do i=1, im + do k=1, kmpbl + if (k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * ABS(moninq_fac) + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if (useshape .ge. 1) then + sz2h=(zi(i,k+1)-zl(i,1))/(hpbl(i)-zl(i,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac +! smax=0.148 !! max value of this shape function + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(zi(i,2)/hpbl(i),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(ABS(moninq_fac),0.2) ! should not be smaller than 0.2, otherwise too much adjustment(?) + if (useshape == 1) then + ashape=(1.0 - ((sz2h*zfac/smax)**0.25) *(1.0 - ashape)) + tem = zi(i,k+1) * (zfac) * ashape + elseif (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) then + ashape1=(skmax*ashape-sksfc)/(skmax-sksfc) + endif + skminusk0 = zi(i,k+1)*zfac - hpbl(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + hpbl(i)*sksfc + endif + endif ! useshape == 1 or 2 + endif ! endif useshape>1 +!!!! END OF CHANGES , WANG W + +!!If alpha >= 0, this is the only modification of K +! if alpha = -1, the above provides the first guess for DKU, based on assumption +! alpha = +1 +! (other values of alpha < 0 can also be applied) +! if alpha > 0, the above applies the alpha suppression factor and we are +! finished + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif !k < kpbl(i) + enddo !K loop + +! possible modification of first guess DKU, under certain conditions +! (1) this applies only to columns over water + if (islimsk(i) .eq. 0) then ! sea only +! (2) alpha test +! if alpha < 0, find alpha for each column and do the loop again +! if alpha > 0, we are finished + if (moninq_fac .lt. 0.) then ! variable alpha test +! k-level of layer around 500 m + kLOC = INT(wspm(i,2)) +! print *,' kLOC ',kLOC,' KPBL ',KPBL(I) + +! (3) only do this IF KPBL(I) >= kLOC. Otherwise, we are finished, with DKU as +! if alpha = +1 + if(kpbl(i) .gt. kLOC) then + xDKU = DKU(i,kLOC) ! Km at k-level +! (4) DKU check. +! WSPM(i,1) is the KM cap for the 500-m level. +! if DKU at 500-m level < WSPM(i,1), do not limit Km ANYWHERE. Alpha = +! abs(alpha). No need to recalc. +! if DKU at 500-m level > WSPM(i,1), then alpha = WSPM(i,1)/xDKU for entire +! column + if(xDKU .ge. wspm(i,1)) then ! ONLY if DKU at 500-m exceeds cap, otherwise already done + wspm(i,3) = wspm(i,1)/xDKU ! ratio of cap to Km at k-level, store in WSPM(i,3) + !WSPM(i,4) = amin1(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + wspm(i,4) = min(wspm(i,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + !! recalculate K capped by WSPM(i,1) + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * wspm(i,4) +!!! wang use different K shape, options!!!!!!!!!!!!!!!!!!!!!!!!! +!!!! HANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(zi(i,k+1)-zl(i,1))/(hpbl(i)-zl(i,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(zi(i,2)/hpbl(i),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(wspm(i,4),0.2) !! adjustment coef should not smaller than 0.2 + if(useshape ==1) then + ashape=(1.0 - ((sz2h*zfac/smax)**0.25)* + & (1.0 - ashape)) + tem = zi(i,k+1) * (zfac) * ashape + elseif (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) then + ashape1=(skmax*ashape-sksfc)/(skmax-sksfc) + endif + skminusk0=zi(i,k+1)*zfac - hpbl(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif + endif ! endif useshape=1 or 2 + endif ! endif useshape>1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif !pblflg + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif ! k < kpbl(i) + enddo ! K loop + endif ! xDKU .ge. wspm(i,1) + endif ! kpbl(i) .ge. kLOC + endif ! moninq_fac < 0 + endif ! islimsk == 0 + enddo ! I loop + endif ! not hurr_pbl ! ! compute diffusion coefficients based on local scheme above pbl !> ## Compute diffusion coefficients above the PBL top @@ -916,16 +1138,32 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. - do k = 1, kmpbl - do i=1,im - if(scuflg(i)) then - dkt(i,k) = dkt(i,k)+ckt(i,k) - dku(i,k) = dku(i,k)+cku(i,k) - dkt(i,k) = min(dkt(i,k),dkmax) - dku(i,k) = min(dku(i,k),dkmax) - endif + if (.not. hurr_pbl) then + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + dkt(i,k) = dkt(i,k)+ckt(i,k) + dku(i,k) = dku(i,k)+cku(i,k) + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo enddo - enddo + else + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + !! if K needs to be adjusted by alpha, then no need to add this term + if (moninq_fac == 1.0) then + dkt(i,k) = dkt(i,k)+ckt(i,k) + dku(i,k) = dku(i,k)+cku(i,k) + end if + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo + enddo + endif ! ! compute tridiagonal matrix elements for heat and moisture ! @@ -1067,13 +1305,19 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! add dissipative heating at the first model layer ! !> Next, the temperature tendency is updated following equation 14. + if (hurr_pbl) then + ttend_fac = 0.7 + else + ttend_fac = 0.5 + endif + do i = 1,im tem = govrth(i)*sflux(i) tem1 = tem + stress(i)*spd1(i)/zl(i,1) tem2 = 0.5 * (tem1+diss(i,1)) tem2 = max(tem2, 0.) ttend = tem2 / cp - tau(i,1) = tau(i,1)+0.5*ttend + tau(i,1) = tau(i,1)+ttend_fac*ttend enddo ! ! add dissipative heating above the first model layer @@ -1083,7 +1327,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & tem = 0.5 * (diss(i,k-1)+diss(i,k)) tem = max(tem, 0.) ttend = tem / cp - tau(i,k) = tau(i,k) + 0.5*ttend + tau(i,k) = tau(i,k) + ttend_fac*ttend enddo enddo ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 6a6ccd183..43af9877d 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -499,6 +499,49 @@ kind = kind_phys intent = in optional = F +[hurr_pbl] + standard_name = flag_hurricane_PBL + long_name = flag for hurricane-specific options in PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[islmsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[var_ric] + standard_name = flag_variable_bulk_richardson_number + long_name = flag for calculating variable bulk richardson number for hurricane PBL + units = flag + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[coef_ric_l] + standard_name = coefficient_for_variable_bulk_richardson_number_over_land + long_name = coefficient for calculating variable bulk richardson number for hurricane PBL over land + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[coef_ric_s] + standard_name = coefficient_for_variable_bulk_richardson_number_over_ocean + long_name = coefficient for calculating variable bulk richardson number for hurricane PBL over ocean + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From cce995ddd369ccb4f3d4f36e7c7ef6cb6a66ae4d Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 3 Feb 2020 15:47:12 -0700 Subject: [PATCH 009/274] clean up logic to better align with HAFS version from Bin Liu, Chunxi Zhang, Weiguo Wang, and Qingfu Liu --- physics/moninedmf.f | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index a9532857c..72cb15f35 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -434,7 +434,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & !! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. ! compute the pbl height ! - if (.not. hurr_pbl) then + if (.not. (hurr_pbl .and. moninq_fac < 0.0)) then do i=1,im flg(i) = .false. rbup(i) = rbsoil(i) @@ -766,7 +766,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! RGF determine wspd at roughly 500 m above surface, or as close as possible, ! reuse SPDK2 ! zi(i,k) is AGL, right? May not matter if applied only to water grid points - if(hurr_pbl .and. moninq_fac .lt. 0.0) then + if(hurr_pbl .and. moninq_fac < 0.0) then do i=1,im spdk2 = 0. wspm(i,1) = 0. @@ -784,7 +784,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! compute diffusion coefficients below pbl !> ## Compute diffusion coefficients below the PBL top !! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. - if (.not. hurr_pbl) then + if (.not. (hurr_pbl .and. moninq_fac < 0.0)) then do k = 1, kmpbl do i=1,im if(k < kpbl(i)) then @@ -814,7 +814,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo !i enddo !k else - !hurricane PBL case (note that the i and k loop order has been switched) + !hurricane PBL case and moninq_fac < 0 (note that the i and k loop order has been switched) do i=1, im do k=1, kmpbl if (k < kpbl(i)) then @@ -889,6 +889,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! (2) alpha test ! if alpha < 0, find alpha for each column and do the loop again ! if alpha > 0, we are finished + +!GJF: redundant check for moninq_fac < 0? if (moninq_fac .lt. 0.) then ! variable alpha test ! k-level of layer around 500 m kLOC = INT(wspm(i,2)) @@ -969,10 +971,10 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo ! K loop endif ! xDKU .ge. wspm(i,1) endif ! kpbl(i) .ge. kLOC - endif ! moninq_fac < 0 + endif ! moninq_fac < 0 (GJF: redundant?) endif ! islimsk == 0 enddo ! I loop - endif ! not hurr_pbl + endif ! not (hurr_pbl and moninq_fac < 0) ! ! compute diffusion coefficients based on local scheme above pbl !> ## Compute diffusion coefficients above the PBL top @@ -1154,7 +1156,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & do i=1,im if(scuflg(i)) then !! if K needs to be adjusted by alpha, then no need to add this term - if (moninq_fac == 1.0) then + if (.not. (hurr_pbl .and. moninq_fac < 0.0)) then dkt(i,k) = dkt(i,k)+ckt(i,k) dku(i,k) = dku(i,k)+cku(i,k) end if @@ -1305,7 +1307,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! add dissipative heating at the first model layer ! !> Next, the temperature tendency is updated following equation 14. - if (hurr_pbl) then + if (hurr_pbl .and. moninq_fac < 0.0) then ttend_fac = 0.7 else ttend_fac = 0.5 From e839247d49d50f6bb7211d80e6fe285e14ce438f Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 6 Feb 2020 11:31:27 -0700 Subject: [PATCH 010/274] send constants through the argument list --- physics/moninedmf.f | 35 +++++++++++++++++------------------ physics/moninedmf.meta | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+), 18 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 72cb15f35..f6b405df1 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -65,12 +65,11 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & - & coef_ric_l,coef_ric_s,errmsg,errflg) + & coef_ric_l,coef_ric_s,grav,cp,hvap,fv,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs - use physcons, grav => con_g, rd => con_rd, cp => con_cp - &, hvap => con_hvap, fv => con_fvirt + implicit none ! ! arguments @@ -82,6 +81,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: grav, cp, hvap, fv real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac, var_ric, & & coef_ric_l, coef_ric_s real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & @@ -158,12 +158,12 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ublflg: true for unstable but not convective(strongly unstable) pbl ! real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, - & cfac, conq, cont, conw, + & cfac, conq, cont, & dk, dkmax, dkmin, & dq1, dsdz2, dsdzq, dsdzt, & dsdzu, dsdzv, & dsig, dt2, dthe1, dtodsd, - & dtodsu, dw2, dw2min, g, + & dtodsu, dw2, dw2min, & gamcrq, gamcrt, gocp, & gravi, f0, & prnum, prmax, prmin, pfac, crbcon, @@ -192,11 +192,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & integer, parameter :: useshape=2!0-- no change, original ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax cc - parameter(gravi=1.0/grav) - parameter(g=grav) - parameter(gocp=g/cp) - parameter(cont=cp/g,conq=hvap/g,conw=1.0/g) ! for del in pa -! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) ! for del in kpa +! parameter(cont=1000.*cp/grav,conq=1000.*hvap/grav,conw=1000./grav) ! for del in kpa parameter(rlam=30.0,vk=0.4,vk2=vk*vk) parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) parameter(dw2min=0.0001,dkmin=0.0,dkmax=1000.,rimin=-100.) @@ -247,7 +243,10 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & errflg = 0 !> ## Compute preliminary variables from input arguments - + gravi=1.0/grav + gocp=grav/cp + cont=cp/grav + conq=hvap/grav ! compute preliminary variables ! if (ix .lt. im) stop @@ -413,7 +412,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & enddo !> - Calculate \f$\frac{g}{\theta}\f$ (govrth), \f$\beta = \frac{\Delta t}{\Delta z}\f$ (beta), \f$u_*\f$ (ustar), total surface flux (sflux), and set pblflag to false if the total surface energy flux is into the surface do i = 1,im - govrth(i) = g/theta(i,1) + govrth(i) = grav/theta(i,1) enddo ! do i=1,im @@ -490,7 +489,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & rbdn(i) = rbup(i) spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) rbup(i) = (thvx(i,k)-thermal(i))* - & (g*zl(i,k)/thvx(i,1))/spdk2 + & (grav*zl(i,k)/thvx(i,1))/spdk2 kpbl(i) = k flg(i) = rbup(i) > crb(i) endif @@ -600,7 +599,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & rbdn(i) = rbup(i) spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) rbup(i) = (thvx(i,k)-thermal(i))* - & (g*zl(i,k)/thvx(i,1))/spdk2 + & (grav*zl(i,k)/thvx(i,1))/spdk2 kpbl(i) = k flg(i) = rbup(i) > crb(i) endif @@ -1014,7 +1013,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & do k = 1, km1 do i=1,im if(k >= kpbl(i)) then - bvf2 = g*bf(i,k)*ti(i,k) + bvf2 = grav*bf(i,k)*ti(i,k) ri = max(bvf2/shr2(i,k),rimin) zk = vk*zi(i,k+1) if(ri < 0.) then ! unstable regime @@ -1299,7 +1298,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! do k = 1,km1 do i = 1,im - diss(i,k) = dku(i,k)*shr2(i,k)-g*ti(i,k)*dkt(i,k)*bf(i,k) + diss(i,k) = dku(i,k)*shr2(i,k)-grav*ti(i,k)*dkt(i,k)*bf(i,k) ! diss(i,k) = dku(i,k)*shr2(i,k) enddo enddo @@ -1394,8 +1393,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & vtend = (a2(i,k)-v1(i,k))*rdt du(i,k) = du(i,k) + utend dv(i,k) = dv(i,k) + vtend - dusfc(i) = dusfc(i) + conw*del(i,k)*utend - dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend + dusfc(i) = dusfc(i) + gravi*del(i,k)*utend + dvsfc(i) = dvsfc(i) + gravi*del(i,k)*vtend ! ! for dissipative heating for ecmwf model ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 43af9877d..5791262a4 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -542,6 +542,42 @@ kind = kind_phys intent = in optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fv] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 78c03e0bb3c43f737cbd9f7e0171164a32c2def2 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 26 Mar 2020 11:53:59 -0600 Subject: [PATCH 011/274] send constants through physcons module; sending constants through the argument list (specifically grav and cp) causes regression test failures in PROD mode --- physics/moninedmf.f | 27 +++++++++++++++------------ physics/moninedmf.meta | 36 ------------------------------------ 2 files changed, 15 insertions(+), 48 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index f6b405df1..66495d91f 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -65,10 +65,15 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & - & coef_ric_l,coef_ric_s,grav,cp,hvap,fv,errmsg,errflg) + & coef_ric_l,coef_ric_s,errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs + !GJF: Note that sending these constants through the argument list + !results in regression test failures with "PROD" mode compilation + !flags (specifically, grav and cp) + use physcons, grav => con_g, cp => con_cp, + & hvap => con_hvap, fv => con_fvirt implicit none ! @@ -81,7 +86,6 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s - real(kind=kind_phys), intent(in) :: grav, cp, hvap, fv real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac, var_ric, & & coef_ric_l, coef_ric_s real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & @@ -158,7 +162,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & ! ublflg: true for unstable but not convective(strongly unstable) pbl ! real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, - & cfac, conq, cont, + & cfac, conq, cont, conw, & dk, dkmax, dkmin, & dq1, dsdz2, dsdzq, dsdzt, & dsdzu, dsdzv, @@ -182,8 +186,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & & ptem, ptem1, ptem2, tx1(im), tx2(im) ! real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, - & cldtime, ttend_fac - + & cldtime + real :: ttend_fac + !! for hurricane application real(kind=kind_phys) wspm(im,km-1) integer kLOC ! RGF @@ -192,6 +197,9 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & integer, parameter :: useshape=2!0-- no change, original ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax cc + parameter(gravi=1.0/grav) + parameter(gocp=grav/cp) + parameter(cont=cp/grav,conq=hvap/grav,conw=1.0/grav) ! for del in pa ! parameter(cont=1000.*cp/grav,conq=1000.*hvap/grav,conw=1000./grav) ! for del in kpa parameter(rlam=30.0,vk=0.4,vk2=vk*vk) parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) @@ -242,11 +250,6 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & errmsg = '' errflg = 0 -!> ## Compute preliminary variables from input arguments - gravi=1.0/grav - gocp=grav/cp - cont=cp/grav - conq=hvap/grav ! compute preliminary variables ! if (ix .lt. im) stop @@ -1393,8 +1396,8 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & vtend = (a2(i,k)-v1(i,k))*rdt du(i,k) = du(i,k) + utend dv(i,k) = dv(i,k) + vtend - dusfc(i) = dusfc(i) + gravi*del(i,k)*utend - dvsfc(i) = dvsfc(i) + gravi*del(i,k)*vtend + dusfc(i) = dusfc(i) + conw*del(i,k)*utend + dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend ! ! for dissipative heating for ecmwf model ! diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 5791262a4..43af9877d 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -542,42 +542,6 @@ kind = kind_phys intent = in optional = F -[grav] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[hvap] - standard_name = latent_heat_of_vaporization_of_water_at_0C - long_name = latent heat of evaporation/sublimation - units = J kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[fv] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From b492f726db97a45a68baf5311a74ed10d882001a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 6 Apr 2020 15:11:46 -0600 Subject: [PATCH 012/274] physics/moninedmf.{f,meta}: apply missing updates that were hidden in a update-from-dtc-develop commit --- physics/moninedmf.f | 2 +- physics/moninedmf.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 66495d91f..2d93eb5a7 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -775,7 +775,7 @@ subroutine hedmf_run (ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & do k = 1, kmpbl ! kmpbl is like a max possible pbl height if (zi(i,k) .le. 500. .and. zi(i,k+1) .gt. 500.) then ! find level bracketing 500 m spdk2 = SQRT(u1(i,k)*u1(i,k)+v1(i,k)*v1(i,k)) ! wspd near 500 m - wspm(i,1) = spdkw/0.6 ! now the Km limit for 500 m. just store in K=1 + wspm(i,1) = spdk2/0.6 ! now the Km limit for 500 m. just store in K=1 wspm(i,2) = float(k) ! height of level at gridpoint i. store in K=2 endif enddo !k diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 43af9877d..b5297b63f 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -507,7 +507,7 @@ type = logical intent = in optional = F -[islmsk] +[islimsk] standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag From a8a2ab870489fc180a4daa8474a735521ab1203f Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 11 Feb 2020 10:31:58 -0700 Subject: [PATCH 013/274] enable icloud=3 capability --- physics/GFS_rrtmg_pre.F90 | 117 +++++++- physics/GFS_rrtmg_pre.meta | 26 ++ physics/radiation_clouds.f | 596 ++++++++++++++++++++++++++++++++++++- 3 files changed, 719 insertions(+), 20 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index aa1ea039e..165411a33 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -20,7 +20,7 @@ end subroutine GFS_rrtmg_pre_init ! in the CCPP version - they are defined in the interstitial_create routine subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & - Radtend, & ! input/output + Radtend,dx, & ! input/output f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output @@ -32,7 +32,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & clouds7, clouds8, clouds9, cldsa, & - mtopa, mbota, de_lgth, alb1d, errmsg, errflg) + mtopa, mbota, de_lgth, alb1d, errmsg, errflg, & + mpirank, mpiroot) use machine, only: kind_phys use GFS_typedefs, only: GFS_statein_type, & @@ -63,7 +64,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & progcld1, progcld3, & & progcld2, & & progcld4, progcld5, & - & progclduni + & progclduni, & + & cal_cldfra3, find_cloudLayers,adjust_cloudIce,adjust_cloudH2O, & + & adjust_cloudFinal + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, & @@ -91,8 +95,9 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin real(kind=kind_phys), intent(out) :: raddt - - + + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: dx + INTEGER, INTENT(IN) :: mpirank,mpiroot real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: plvl @@ -146,18 +151,19 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya, lyb - real(kind=kind_phys) :: es, qs, delt, tem0d + real(kind=kind_phys) :: es, qs, delt, tem0d, gridkm - real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn + real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn, xland real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & cldcov, deltaq, cnvc, cnvw, & - effrl, effri, effrr, effrs + effrl, effri, effrr, effrs,rho,plyrpa real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db -! real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: hz + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qc_save, qi_save + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qs_save real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,min(4,Model%ncnd)) :: ccnd real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 @@ -165,6 +171,12 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw +!mz *temporary + real(kind=kind_phys),parameter:: con_rd =2.8705e+2_kind_phys + INTEGER :: ids, ide, jds, jde, kds, kde, & + & ims, ime, jms, jme, kms, kme, & + & its, ite, jts, jte, kts, kte + ! !===> ... begin here ! @@ -529,7 +541,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water/ice enddo enddo - elseif (Model%ncnd == 2) then ! MG or F-A + elseif (Model%ncnd == 2) then ! MG or do k=1,LMK do i=1,IM ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water @@ -545,7 +557,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,4) = tracer1(i,k,ntsw) ! snow water enddo enddo - elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3 + elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3, FA do k=1,LMK do i=1,IM ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water @@ -638,6 +650,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input cldcov = 0.0 endif + ! ! --- add suspended convective cloud water to grid-scale cloud water ! only for cloud fraction & radiation computation @@ -673,6 +686,84 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo endif +!mz HWRF physics: icloud=3 + ! Set internal dimensions + ids = 1 + ims = 1 + its = 1 + ide = size(Grid%xlon,1) + ime = size(Grid%xlon,1) + ite = size(Grid%xlon,1) + jds = 1 + jms = 1 + jts = 1 + jde = 1 + jme = 1 + jte = 1 + kds = 1 + kms = 1 + kts = 1 + kde = Model%levr+LTP + kme = Model%levr+LTP + kte = Model%levr+LTP + + do k = 1, LMK + do i = 1, IM + rho(i,k)=plyr(i,k)*100./(con_rd*tlyr(i,k)) + plyrpa(i,k)=plyr(i,k)*100. !hPa->Pa + end do + end do + + do i=1,im + if (Sfcprop%slmsk(i)==1. .or. Sfcprop%slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 + xland(i)=1.0 !but land/water = (1/2) in HWRF + else + xland(i)=2.0 + endif + enddo + + + gridkm = 1.414*SQRT(dx(1)*0.001*dx(1)*0.001 ) + ! if(mpirank == mpiroot) then + ! write(0,*)'cldfra3: max/min(plyrpa) = ', maxval(plyrpa), minval(plyrpa) + ! write(0,*)'cldfra3: max/min(rho) = ', maxval(rho), minval(rho) + ! endif + + + if(Model%icloud == 3) then + do i =1, im + do k =1, lmk + qc_save(i,k) = ccnd(i,k,1) + qi_save(i,k) = ccnd(i,k,2) + qs_save(i,k) = ccnd(i,k,4) + enddo + enddo + + + CALL cal_cldfra3(cldcov,qlyr,ccnd(:,:,1),ccnd(:,:,2), & + & ccnd(:,:,4),plyrpa,tlyr, RHO,XLAND,GRIDKM, & + & ids,ide, jds,jde, kds,kde, & + & ims,ime, jms,jme, kms,kme, & + & its,ite, jts,jte, kts,kte) +! if(mpirank == mpiroot) then +! write(0,*)'cal_cldfra3::max/min(cldcov) =', maxval(cldcov), & +! & minval(cldcov) +! endif + + !mz* back to micro-only qc qi,qs + do i =1, im + do k =1, lmk + ccnd(i,k,1) = qc_save(i,k) + ccnd(i,k,2) = qi_save(i,k) + ccnd(i,k,4) = qs_save(i,k) + enddo + enddo + + endif + + +!mz*end + if (lextop) then do i=1,im cldcov(i,lyb) = cldcov(i,lya) @@ -756,11 +847,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd%phy_f3d(:,:,Model%nseffr) = 250. endif - call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + call progcld5 (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,tracer1,& ! --- inputs Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & + im, lmk, lmp, Model%icloud,Model%uni_cld, & Model%lmfshal,Model%lmfdeep2, & cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 7b40e2c1d..198cd0a5a 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -70,6 +70,15 @@ type = GFS_radtend_type intent = inout optional = F +[dx] + standard_name = cell_size + long_name = relative dx for the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [f_ice] standard_name = fraction_of_ice_water_cloud long_name = fraction of ice water cloud @@ -564,6 +573,23 @@ type = integer intent = out optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F + ######################################################################## [ccpp-arg-table] diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 49b394fe1..585ff01df 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -243,7 +243,9 @@ module module_radiation_clouds integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld4o + & cld_init, progcld5, progcld4o, & + & cal_cldfra3, find_cloudLayers,adjust_cloudIce,adjust_cloudH2O, & + & adjust_cloudFinal ! ================= @@ -2339,10 +2341,10 @@ end subroutine progcld4o !! This subroutine computes cloud related quantities using Thompson/WSM6 cloud !! microphysics scheme. subroutine progcld5 & - & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: + & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & - & IX, NLAY, NLP1, & + & IX, NLAY, NLP1,icloud, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: @@ -2428,13 +2430,13 @@ subroutine progcld5 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: IX, NLAY, NLP1,ICLOUD integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, & + & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz, & & re_cloud, re_ice, re_snow real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -2546,7 +2548,9 @@ subroutine progcld5 & enddo enddo - if (uni_cld) then ! use unified sgs clouds generated outside +!mz* if (uni_cld) then ! use unified sgs clouds generated outside +!mz* use unified sgs or thompson clouds generated outside + if (uni_cld .or. icloud == 3) then do k = 1, NLAY do i = 1, IX cldtot(i,k) = cldcov(i,k) @@ -2634,8 +2638,76 @@ subroutine progcld5 & enddo enddo endif +!mz + if (icloud .ne.0) then +! assign/calculate efective radii for cloud water, ice, rain, snow -! +! if (effr_in) then +! do k = 1, NLAY +! do i = 1, IX +! rew(i,k) = effrl (i,k) +! rei(i,k) = max(10.0, min(150.0,effri (i,k))) +! rer(i,k) = effrr (i,k) +! res(i,k) = effrs (i,k) +! enddo +! enddo +! else + do k = 1, NLAY + do i = 1, IX + rew(i,k) = reliq_def ! default liq radius to 10 micron + rei(i,k) = reice_def ! default ice radius to 50 micron + rer(i,k) = rrain_def ! default rain radius to 1000 micron + res(i,k) = rsnow_def ! default snow radius to 250 micron + enddo + enddo +!> -# Compute effective liquid cloud droplet radius over land. + do i = 1, IX + if (nint(slmsk(i)) == 1) then + do k = 1, NLAY + tem1 = min(1.0, max(0.0, (con_ttp-tlyr(i,k))*0.05)) + rew(i,k) = 5.0 + 5.0 * tem1 + enddo + endif + enddo + +!> -# Compute effective ice cloud droplet radius following Heymsfield +!! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. + + do k = 1, NLAY + do i = 1, IX + tem2 = tlyr(i,k) - con_ttp + + if (cip(i,k) > 0.0) then + tem3 = gord * cip(i,k) * plyr(i,k) / (delp(i,k)*tvly(i,k)) + + if (tem2 < -50.0) then + rei(i,k) = (1250.0/9.917) * tem3 ** 0.109 + elseif (tem2 < -40.0) then + rei(i,k) = (1250.0/9.337) * tem3 ** 0.08 + elseif (tem2 < -30.0) then + rei(i,k) = (1250.0/9.208) * tem3 ** 0.055 + else + rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 + endif + rei(i,k) = max(25.,rei(i,k)) !mz* HWRF +!mz GFDL +! rei(i,k) = max(10.0, min(rei(i,k), 150.0)) + endif + rei(i,k) = min(rei(i,k), 135.72) !- 1.0315*rei<= 140 microns + enddo + enddo + +!mz +!> -# Compute effective snow cloud droplet radius + do k = 1, NLAY + do i = 1, IX + res(i,k) = 10.0 + enddo + enddo +! endif +! + endif ! end icloud +!mz end do k = 1, NLAY do i = 1, IX clouds(i,k,1) = cldtot(i,k) @@ -3452,6 +3524,516 @@ end subroutine gethml !----------------------------------- !! @} +!+---+-----------------------------------------------------------------+ +!..Cloud fraction scheme by G. Thompson (NCAR-RAL), not intended for +!.. combining with any cumulus or shallow cumulus parameterization +!.. scheme cloud fractions. This is intended as a stand-alone for +!.. cloud fraction and is relatively good at getting widespread stratus +!.. and stratoCu without caring whether any deep/shallow Cu param schemes +!.. is making sub-grid-spacing clouds/precip. Under the hood, this +!.. scheme follows Mocko and Cotton (1995) in applicaiton of the +!.. Sundqvist et al (1989) scheme but using a grid-scale dependent +!.. RH threshold, one each for land v. ocean points based on +!.. experiences with HWRF testing. +!+---+-----------------------------------------------------------------+ +! +!+---+-----------------------------------------------------------------+ + + SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, & + & p,t,rho, XLAND, gridkm, & +! & rand_perturb_on, kme_stoch, rand_pert, & + & ids,ide, jds,jde, kds,kde, & + & ims,ime, jms,jme, kms,kme, & + & its,ite, jts,jte, kts,kte) +! + USE module_mp_thompson , ONLY : rsif, rslf + IMPLICIT NONE +! + INTEGER, INTENT(IN):: ids,ide, jds,jde, kds,kde, & + & ims,ime, jms,jme, kms,kme, & +! & kme_stoch, & + & its,ite, jts,jte, kts,kte + +! INTEGER, INTENT(IN):: rand_perturb_on + REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN):: qv,p,t,rho + REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT):: qc,qi,qs +! REAL, DIMENSION(ims:ime,kms:kme_stoch,jms:jme), INTENT(IN):: rand_pert + REAL, DIMENSION(ims:ime,jms:jme), INTENT(IN):: XLAND + + REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT):: cldfra + REAL, INTENT(IN):: gridkm + +!..Local vars. + REAL:: RH_00L, RH_00O, RH_00, RHI_max, entrmnt + REAL, DIMENSION(ims:ime,kms:kme,jms:jme):: qvsat + INTEGER:: i,j,k + REAL:: TK, TC, qvsi, qvsw, RHUM, xx, yy + REAL, DIMENSION(kts:kte):: qvs1d, cfr1d, T1d, & + & P1d, R1d, qc1d, qi1d, qs1d + + character*512 dbg_msg + LOGICAL:: debug_flag + +!+---+ + +!..First cut scale-aware. Higher resolution should require closer to +!.. saturated grid box for higher cloud fraction. Simple functions +!.. chosen based on Mocko and Cotton (1995) starting point and desire +!.. to get near 100% RH as grid spacing moves toward 1.0km, but higher +!.. RH over ocean required as compared to over land. + + RH_00L = 0.7 + SQRT(1./(25.0+gridkm*gridkm*gridkm)) + RH_00O = 0.81 + SQRT(1./(50.0+gridkm*gridkm*gridkm)) + + DO j = jts,jte + DO k = kts,kte + DO i = its,ite + RHI_max = 0.0 + CLDFRA(I,K,J) = 0.0 + + if (qc(i,k,j).gt.1.E-6 .or. qi(i,k,j).ge.1.E-7 .or.qs(i,k,j) & + & .gt.1.E-5) then + CLDFRA(I,K,J) = 1.0 + qvsat(i,k,j) = qv(i,k,j) + else + TK = t(i,k,j) + TC = TK - 273.16 + + qvsw = rslf(P(i,k,j), TK) + qvsi = rsif(P(i,k,j), TK) + + if (tc .ge. -12.0) then + qvsat(i,k,j) = qvsw + elseif (tc .lt. -20.0) then + qvsat(i,k,j) = qvsi + else + qvsat(i,k,j) = qvsw - (qvsw-qvsi)*(-12.0-tc)/(-12.0+20.) + endif + RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 0.9999)) + + IF ((XLAND(I,J)-1.5).GT.0.) THEN !--- Ocean + RH_00 = RH_00O + ELSE !--- Land + RH_00 = RH_00L + ENDIF + + if (tc .ge. -12.0) then + RHUM = MIN(0.999, RHUM) + CLDFRA(I,K,J) = MAX(0.0, 1.0-SQRT((1.0-RHUM)/(1.-RH_00))) + elseif (tc.lt.-12..and.tc.gt.-70. .and. RHUM.gt.RH_00L) then + RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 1.0 - 1.E-6)) + CLDFRA(I,K,J) = MAX(0., 1.0-SQRT((1.0-RHUM)/(1.0-RH_00L))) + endif + CLDFRA(I,K,J) = MIN(0.90, CLDFRA(I,K,J)) + + endif + ENDDO + ENDDO + ENDDO + + +!..Prepare for a 1-D column to find various cloud layers. + + DO j = jts,jte + DO i = its,ite +! if (i.gt.10.and.i.le.20 .and. j.gt.10.and.j.le.20) then +! debug_flag = .true. +! else +! debug_flag = .false. +! endif + +! if (rand_perturb_on .eq. 1) then +! entrmnt = MAX(0.01, MIN(0.99, 0.5 + rand_pert(i,1,j)*0.5)) +! else + entrmnt = 0.5 +! endif + + DO k = kts,kte + qvs1d(k) = qvsat(i,k,j) + cfr1d(k) = cldfra(i,k,j) + T1d(k) = t(i,k,j) + P1d(k) = p(i,k,j) + R1d(k) = rho(i,k,j) + qc1d(k) = qc(i,k,j) + qi1d(k) = qi(i,k,j) + qs1d(k) = qs(i,k,j) + ENDDO + +! if (debug_flag) then +! WRITE (dbg_msg,*) 'DEBUG-GT: finding cloud layers at point (', i, ', ', j, ')' +! CALL wrf_debug (150, dbg_msg) +! endif + call find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & + & debug_flag, qc1d, qi1d, qs1d, kts,kte) + + DO k = kts,kte + cldfra(i,k,j) = cfr1d(k) + qc(i,k,j) = qc1d(k) + qi(i,k,j) = qi1d(k) + ENDDO + ENDDO + ENDDO + + + END SUBROUTINE cal_cldfra3 + + +!+---+-----------------------------------------------------------------+ +!..From cloud fraction array, find clouds of multi-level depth and +!compute +!.. a reasonable value of LWP or IWP that might be contained in that +!depth, +!.. unless existing LWC/IWC is already there. + + SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & + & debugfl, qc1d, qi1d, qs1d, kts,kte) +! + IMPLICIT NONE +! + INTEGER, INTENT(IN):: kts, kte + LOGICAL, INTENT(IN):: debugfl + REAL, INTENT(IN):: entrmnt + REAL, DIMENSION(kts:kte), INTENT(IN):: qvs1d,T1d,P1d,R1d + REAL, DIMENSION(kts:kte), INTENT(INOUT):: cfr1d + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc1d, qi1d, qs1d + +!..Local vars. + REAL, DIMENSION(kts:kte):: theta, dz + REAL:: Z1, Z2, theta1, theta2, ht1, ht2 + INTEGER:: k, k2, k_tropo, k_m12C, k_m40C, k_cldb, k_cldt, kbot + LOGICAL:: in_cloud + character*512 dbg_msg + +!+---+ + + k_m12C = 0 + k_m40C = 0 + DO k = kte, kts, -1 + theta(k) = T1d(k)*((100000.0/P1d(k))**(287.05/1004.)) + if (T1d(k)-273.16 .gt. -40.0 .and. P1d(k).gt.7000.0) k_m40C = & + & MAX(k_m40C, k) + if (T1d(k)-273.16 .gt. -12.0 .and. P1d(k).gt.10000.0) k_m12C = & + & MAX(k_m12C, k) + ENDDO + if (k_m40C .le. kts) k_m40C = kts + if (k_m12C .le. kts) k_m12C = kts + + Z2 = 44307.692 * (1.0 - (P1d(kte)/101325.)**0.190) + DO k = kte-1, kts, -1 + Z1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) + dz(k+1) = Z2 - Z1 + Z2 = Z1 + ENDDO + dz(kts) = dz(kts+1) + +!..Find tropopause height, best surrogate, because we would not really +!.. wish to put fake clouds into the stratosphere. The 10/1500 ratio +!.. d(Theta)/d(Z) approximates a vertical line on typical SkewT chart +!.. near typical (mid-latitude) tropopause height. Since messy data +!.. could give us a false signal of such a transition, do the check over +!.. three K-level change, not just a level-to-level check. This method +!.. has potential failure in arctic-like conditions with extremely low +!.. tropopause height, as would any other diagnostic, so ensure resulting +!.. k_tropo level is above 4km. + + DO k = kte-3, kts, -1 + theta1 = theta(k) + theta2 = theta(k+2) + ht1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) + ht2 = 44307.692 * (1.0 - (P1d(k+2)/101325.)**0.190) + if ( (((theta2-theta1)/(ht2-ht1)) .lt. 10./1500. ) .AND. & + & (ht1.lt.19000.) .and. (ht1.gt.4000.) ) then + goto 86 + endif + ENDDO + 86 continue + k_tropo = MAX(kts+2, k+2) + +! if (debugfl) then +! print*, ' FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' +! WRITE (dbg_msg,*) 'DEBUG-GT: FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' +! CALL wrf_debug (150, dbg_msg) +! endif + +!..Eliminate possible fractional clouds above supposed tropopause. + DO k = k_tropo+1, kte + if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) then + cfr1d(k) = 0. + endif + ENDDO + +!..We would like to prevent fractional clouds below LCL in idealized +!.. situation with deep well-mixed convective PBL, that otherwise is +!.. likely to get clouds in more realistic capping inversion layer. + + kbot = kts+2 + DO k = kbot, k_m12C + if ( (theta(k)-theta(k-1)) .gt. 0.05E-3*dz(k)) EXIT + ENDDO + kbot = MAX(kts+1, k-2) + DO k = kts, kbot + if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) cfr1d(k) = 0. + ENDDO + + +!..Starting below tropo height, if cloud fraction greater than 1 +!percent, +!.. compute an approximate total layer depth of cloud, determine a total +!.. liquid water/ice path (LWP/IWP), then reduce that amount with tuning +!.. parameter to represent entrainment factor, then divide up LWP/IWP +!.. into delta-Z weighted amounts for individual levels per cloud layer. + + + k_cldb = k_tropo + in_cloud = .false. + k = k_tropo + DO WHILE (.not. in_cloud .AND. k.gt.k_m12C) + k_cldt = 0 + if (cfr1d(k).ge.0.01) then + in_cloud = .true. + k_cldt = MAX(k_cldt, k) + endif + if (in_cloud) then + DO k2 = k_cldt-1, k_m12C, -1 + if (cfr1d(k2).lt.0.01 .or. k2.eq.k_m12C) then + k_cldb = k2+1 + goto 87 + endif + ENDDO + 87 continue + in_cloud = .false. + endif + if ((k_cldt - k_cldb + 1) .ge. 2) then +! if (debugfl) then +! print*, 'An ice cloud layer is found between ', k_cldt, +! k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 +! WRITE (dbg_msg,*) 'DEBUG-GT: An ice cloud layer is found between +! ', k_cldt, k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 +! CALL wrf_debug (150, dbg_msg) +! endif + call adjust_cloudIce(cfr1d, qi1d, qs1d, qvs1d, T1d,R1d,dz, & + & entrmnt, k_cldb,k_cldt,kts,kte) + k = k_cldb + else + if (cfr1d(k_cldb).gt.0.and.qi1d(k_cldb).lt.1.E-6) & + & qi1d(k_cldb)=1.E-5*cfr1d(k_cldb) + endif + + + k = k - 1 + ENDDO + + + + k_cldb = k_tropo + in_cloud = .false. + k = k_m12C + 2 + DO WHILE (.not. in_cloud .AND. k.gt.kbot) + k_cldt = 0 + if (cfr1d(k).ge.0.01) then + in_cloud = .true. + k_cldt = MAX(k_cldt, k) + endif + if (in_cloud) then + DO k2 = k_cldt-1, kbot, -1 + if (cfr1d(k2).lt.0.01 .or. k2.eq.kbot) then + k_cldb = k2+1 + goto 88 + endif + ENDDO + 88 continue + in_cloud = .false. + endif + if ((k_cldt - k_cldb + 1) .ge. 2) then +! if (debugfl) then +! print*, 'A water cloud layer is found between ', k_cldt, +! k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 +! WRITE (dbg_msg,*) 'DEBUG-GT: A water cloud layer is found +! between ', k_cldt, k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 +! CALL wrf_debug (150, dbg_msg) +! endif + call adjust_cloudH2O(cfr1d, qc1d, qvs1d, T1d,R1d,dz, & + & entrmnt, k_cldb,k_cldt,kts,kte) + k = k_cldb + else + if (cfr1d(k_cldb).gt.0.and.qc1d(k_cldb).lt.1.E-6) & + & qc1d(k_cldb)=1.E-5*cfr1d(k_cldb) + endif + k = k - 1 + ENDDO + +!..Do a final total column adjustment since we may have added more than +!1mm +!.. LWP/IWP for multiple cloud decks. + + call adjust_cloudFinal(cfr1d, qc1d, qi1d, R1d,dz, kts,kte,k_tropo) + +! if (debugfl) then +! print*, ' Made-up fake profile of clouds' +! do k = kte, kts, -1 +! write(*,'(i3, 2x, f8.2, 2x, f9.2, 2x, f6.2, 2x, f15.7, 2x, +! f15.7)') & +! & K, T1d(k)-273.15, P1d(k)*0.01, cfr1d(k)*100., +! qc1d(k)*1000.,qi1d(k)*1000. +! enddo +! WRITE (dbg_msg,*) 'DEBUG-GT: Made-up fake profile of clouds' +! CALL wrf_debug (150, dbg_msg) +! do k = kte, kts, -1 +! write(dbg_msg,'(f8.2, 2x, f9.2, 2x, f6.2, 2x, f15.7, 2x, +! f15.7)') & +! & T1d(k)-273.15, P1d(k)*0.01, cfr1d(k)*100., +! qc1d(k)*1000.,qi1d(k)*1000. +! CALL wrf_debug (150, dbg_msg) +! enddo +! endif + + + END SUBROUTINE find_cloudLayers + +!+---+-----------------------------------------------------------------+ + + SUBROUTINE adjust_cloudIce(cfr,qi,qs,qvs, T,Rho,dz, entr, k1,k2, & + & kts,kte) +! + IMPLICIT NONE +! + INTEGER, INTENT(IN):: k1,k2, kts,kte + REAL, INTENT(IN):: entr + REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qvs, T, Rho, dz + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qi, qs + REAL:: iwc, max_iwc, tdz, this_iwc, this_dz, iwp_exists + INTEGER:: k, kmid + + tdz = 0. + do k = k1, k2 + tdz = tdz + dz(k) + enddo + kmid = NINT(0.5*(k1+k2)) + max_iwc = ABS(qvs(k2-1)-qvs(k1)) +! print*, ' max_iwc = ', max_iwc, ' over DZ=',tdz + + iwp_exists = 0. + do k = k1, k2 + iwp_exists = iwp_exists + (qi(k)+qs(k))*Rho(k)*dz(k) + enddo + if (iwp_exists .gt. 1.0) RETURN + + this_dz = 0.0 + do k = k1, k2 + if (k.eq.k1) then + this_dz = this_dz + 0.5*dz(k) + else + this_dz = this_dz + dz(k) + endif + this_iwc = max_iwc*this_dz/tdz + iwc = MAX(1.E-6, this_iwc*(1.-entr)) + if (cfr(k).gt.0.01.and.cfr(k).lt.0.99.and.T(k).ge.203.16) then + qi(k) = qi(k) + 0.1*cfr(k)*iwc + elseif (qi(k).lt.1.E-5.and.cfr(k).ge.0.99.and.T(k).ge.203.16) & + & then + qi(k) = qi(k) + 0.01*iwc + endif + enddo + + END SUBROUTINE adjust_cloudIce + +!+---+-----------------------------------------------------------------+ + + SUBROUTINE adjust_cloudH2O(cfr, qc, qvs, T,Rho,dz, entr, k1,k2, & + & kts,kte) +! + IMPLICIT NONE +! + INTEGER, INTENT(IN):: k1,k2, kts,kte + REAL, INTENT(IN):: entr + REAL, DIMENSION(kts:kte):: cfr, qc, qvs, T, Rho, dz + REAL:: lwc, max_lwc, tdz, this_lwc, this_dz, lwp_exists + INTEGER:: k, kmid + + tdz = 0. + do k = k1, k2 + tdz = tdz + dz(k) + enddo + kmid = NINT(0.5*(k1+k2)) + max_lwc = ABS(qvs(k2-1)-qvs(k1)) +! print*, ' max_lwc = ', max_lwc, ' over DZ=',tdz + + lwp_exists = 0. + do k = k1, k2 + lwp_exists = lwp_exists + qc(k)*Rho(k)*dz(k) + enddo + if (lwp_exists .gt. 1.0) RETURN + + this_dz = 0.0 + do k = k1, k2 + if (k.eq.k1) then + this_dz = this_dz + 0.5*dz(k) + else + this_dz = this_dz + dz(k) + endif + this_lwc = max_lwc*this_dz/tdz + lwc = MAX(1.E-6, this_lwc*(1.-entr)) + if (cfr(k).gt.0.01.and.cfr(k).lt.0.99.and.T(k).lt.298.16.and. & + & T(k).ge.253.16) then + qc(k) = qc(k) + cfr(k)*cfr(k)*lwc + elseif (cfr(k).ge.0.99.and.qc(k).lt.1.E-5.and.T(k).lt.298.16 & + & .and.T(k).ge.253.16) then + qc(k) = qc(k) + 0.1*lwc + endif + enddo + + END SUBROUTINE adjust_cloudH2O + + +!+---+-----------------------------------------------------------------+ + +!..Do not alter any grid-explicitly resolved hydrometeors, rather only +!.. the supposed amounts due to the cloud fraction scheme. + + SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte,k_tropo) +! + IMPLICIT NONE +! + INTEGER, INTENT(IN):: kts,kte,k_tropo + REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, Rho, dz + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc, qi + REAL:: lwp, iwp, xfac + INTEGER:: k + + lwp = 0. + do k = kts, k_tropo + if (cfr(k).gt.0.0) then + lwp = lwp + qc(k)*Rho(k)*dz(k) + endif + enddo + + iwp = 0. + do k = kts, k_tropo + if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + iwp = iwp + qi(k)*Rho(k)*dz(k) + endif + enddo + + if (lwp .gt. 1.5) then + xfac = 1./lwp + do k = kts, k_tropo + if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + qc(k) = qc(k)*xfac + endif + enddo + endif + + if (iwp .gt. 1.5) then + xfac = 1./iwp + do k = kts, k_tropo + if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + qi(k) = qi(k)*xfac + endif + enddo + endif + + END SUBROUTINE adjust_cloudFinal + ! !........................................! end module module_radiation_clouds ! From 9309fc60a936d1463cdb1689bcd820ae70e2f50a Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 13 Feb 2020 13:14:43 -0700 Subject: [PATCH 014/274] add exponential cloud overlapping for LW component --- physics/HWRF_mcica_random_numbers.F90 | 109 ++++ physics/HWRF_mersenne_twister.F90 | 304 +++++++++++ physics/radiation_clouds.f | 52 +- physics/radlw_main.f | 746 +++++++++++++++++++++++++- 4 files changed, 1178 insertions(+), 33 deletions(-) create mode 100644 physics/HWRF_mcica_random_numbers.F90 create mode 100644 physics/HWRF_mersenne_twister.F90 diff --git a/physics/HWRF_mcica_random_numbers.F90 b/physics/HWRF_mcica_random_numbers.F90 new file mode 100644 index 000000000..b2f2d20dd --- /dev/null +++ b/physics/HWRF_mcica_random_numbers.F90 @@ -0,0 +1,109 @@ + module mcica_random_numbers + + ! Generic module to wrap random number generators. + ! The module defines a type that identifies the particular stream of random + ! numbers, and has procedures for initializing it and getting real numbers + ! in the range 0 to 1. + ! This version uses the Mersenne Twister to generate random numbers on [0, 1]. + ! + use MersenneTwister, only: randomNumberSequence, & ! The random number engine. + new_RandomNumberSequence, getRandomReal +!! mji +!! use time_manager_mod, only: time_type, get_date + +!mz use parkind, only : im => kind_im, rb => kind_rb + use machine, only: im => kind_io4, rb => kind_phys + + implicit none + private + + type randomNumberStream + type(randomNumberSequence) :: theNumbers + end type randomNumberStream + + interface getRandomNumbers + module procedure getRandomNumber_Scalar, getRandomNumber_1D, getRandomNumber_2D + end interface getRandomNumbers + + interface initializeRandomNumberStream + module procedure initializeRandomNumberStream_S, initializeRandomNumberStream_V + end interface initializeRandomNumberStream + + public :: randomNumberStream, & + initializeRandomNumberStream, getRandomNumbers +!! mji +!! initializeRandomNumberStream, getRandomNumbers, & +!! constructSeed +contains + ! --------------------------------------------------------- + ! Initialization + ! --------------------------------------------------------- + function initializeRandomNumberStream_S(seed) result(new) + integer(kind=im), intent( in) :: seed + type(randomNumberStream) :: new + + new%theNumbers = new_RandomNumberSequence(seed) + + end function initializeRandomNumberStream_S + ! --------------------------------------------------------- + function initializeRandomNumberStream_V(seed) result(new) + integer(kind=im), dimension(:), intent( in) :: seed + type(randomNumberStream) :: new + + new%theNumbers = new_RandomNumberSequence(seed) + + end function initializeRandomNumberStream_V + + ! --------------------------------------------------------- + ! Procedures for drawing random numbers + ! --------------------------------------------------------- + subroutine getRandomNumber_Scalar(stream, number) + type(randomNumberStream), intent(inout) :: stream + real(kind=rb), intent( out) :: number + + number = getRandomReal(stream%theNumbers) + end subroutine getRandomNumber_Scalar + ! --------------------------------------------------------- + subroutine getRandomNumber_1D(stream, numbers) + type(randomNumberStream), intent(inout) :: stream + real(kind=rb), dimension(:), intent( out) :: numbers + + ! Local variables + integer(kind=im) :: i + + do i = 1, size(numbers) + numbers(i) = getRandomReal(stream%theNumbers) + end do + end subroutine getRandomNumber_1D + ! --------------------------------------------------------- + subroutine getRandomNumber_2D(stream, numbers) + type(randomNumberStream), intent(inout) :: stream + real(kind=rb), dimension(:, :), intent( out) :: numbers + + ! Local variables + integer(kind=im) :: i + + do i = 1, size(numbers, 2) + call getRandomNumber_1D(stream, numbers(:, i)) + end do + end subroutine getRandomNumber_2D + +! mji +! ! --------------------------------------------------------- +! ! Constructing a unique seed from grid cell index and model date/time +! ! Once we have the GFDL stuff we'll add the year, month, day, hour, minute +! ! --------------------------------------------------------- +! function constructSeed(i, j, time) result(seed) +! integer(kind=im), intent( in) :: i, j +! type(time_type), intent( in) :: time +! integer(kind=im), dimension(8) :: seed +! +! ! Local variables +! integer(kind=im) :: year, month, day, hour, minute, second +! +! +! call get_date(time, year, month, day, hour, minute, second) +! seed = (/ i, j, year, month, day, hour, minute, second /) +! end function constructSeed + + end module mcica_random_numbers diff --git a/physics/HWRF_mersenne_twister.F90 b/physics/HWRF_mersenne_twister.F90 new file mode 100644 index 000000000..f9e3b0b0a --- /dev/null +++ b/physics/HWRF_mersenne_twister.F90 @@ -0,0 +1,304 @@ +! Fortran-95 implementation of the Mersenne Twister 19937, following +! the C implementation described below (code mt19937ar-cok.c, dated 2002/2/10), +! adapted cosmetically by making the names more general. +! Users must declare one or more variables of type randomNumberSequence in the calling +! procedure which are then initialized using a required seed. If the +! variable is not initialized the random numbers will all be 0. +! For example: +! program testRandoms +! use RandomNumbers +! type(randomNumberSequence) :: randomNumbers +! integer :: i +! +! randomNumbers = new_RandomNumberSequence(seed = 100) +! do i = 1, 10 +! print ('(f12.10, 2x)'), getRandomReal(randomNumbers) +! end do +! end program testRandoms +! +! Fortran-95 implementation by +! Robert Pincus +! NOAA-CIRES Climate Diagnostics Center +! Boulder, CO 80305 +! email: Robert.Pincus@colorado.edu +! +! This documentation in the original C program reads: +! ------------------------------------------------------------- +! A C-program for MT19937, with initialization improved 2002/2/10. +! Coded by Takuji Nishimura and Makoto Matsumoto. +! This is a faster version by taking Shawn Cokus's optimization, +! Matthe Bellew's simplification, Isaku Wada's real version. +! +! Before using, initialize the state by using init_genrand(seed) +! or init_by_array(init_key, key_length). +! +! Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura, +! All rights reserved. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! +! 3. The names of its contributors may not be used to endorse or promote +! products derived from this software without specific prior written +! permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR +! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +! +! +! Any feedback is very welcome. +! http://www.math.keio.ac.jp/matumoto/emt.html +! email: matumoto@math.keio.ac.jp +! ------------------------------------------------------------- + + module MersenneTwister +! ------------------------------------------------------------- + +!mz use parkind, only : im => kind_im, rb => kind_rb + use machine, only: im => kind_io4, rb => kind_phys + + implicit none + private + + ! Algorithm parameters + ! ------- + ! Period parameters + integer(kind=im), parameter :: blockSize = 624, & + M = 397, & + MATRIX_A = -1727483681, & ! constant vector a (0x9908b0dfUL) + UMASK = -2147483647-1, & ! most significant w-r bits (0x80000000UL) + LMASK = 2147483647 ! least significant r bits (0x7fffffffUL) + ! Tempering parameters + integer(kind=im), parameter :: TMASKB= -1658038656, & ! (0x9d2c5680UL) + TMASKC= -272236544 ! (0xefc60000UL) + ! ------- + + ! The type containing the state variable + type randomNumberSequence + integer(kind=im) :: currentElement ! = blockSize + integer(kind=im), dimension(0:blockSize -1) :: state ! = 0 + end type randomNumberSequence + + interface new_RandomNumberSequence + module procedure initialize_scalar, initialize_vector + end interface new_RandomNumberSequence + + + public :: randomNumberSequence + public :: new_RandomNumberSequence, finalize_RandomNumberSequence, & + getRandomInt, getRandomPositiveInt, getRandomReal +! ------------------------------------------------------------- +contains + ! ------------------------------------------------------------- + ! Private functions + ! --------------------------- + function mixbits(u, v) + integer(kind=im), intent( in) :: u, v + integer(kind=im) :: mixbits + + mixbits = ior(iand(u, UMASK), iand(v, LMASK)) + end function mixbits + ! --------------------------- + function twist(u, v) + integer(kind=im), intent( in) :: u, v + integer(kind=im) :: twist + + ! Local variable + integer(kind=im), parameter, dimension(0:1) :: t_matrix = (/ 0_im, MATRIX_A /) + + twist = ieor(ishft(mixbits(u, v), -1_im), t_matrix(iand(v, 1_im))) + twist = ieor(ishft(mixbits(u, v), -1_im), t_matrix(iand(v, 1_im))) + end function twist + ! --------------------------- + subroutine nextState(twister) + type(randomNumberSequence), intent(inout) :: twister + + ! Local variables + integer(kind=im) :: k + + do k = 0, blockSize - M - 1 + twister%state(k) = ieor(twister%state(k + M), & + twist(twister%state(k), twister%state(k + 1_im))) + end do + do k = blockSize - M, blockSize - 2 + twister%state(k) = ieor(twister%state(k + M - blockSize), & + twist(twister%state(k), twister%state(k + 1_im))) + end do + twister%state(blockSize - 1_im) = ieor(twister%state(M - 1_im), & + twist(twister%state(blockSize - 1_im), twister%state(0_im))) + twister%currentElement = 0_im + + end subroutine nextState + ! --------------------------- + elemental function temper(y) + integer(kind=im), intent(in) :: y + integer(kind=im) :: temper + + integer(kind=im) :: x + + ! Tempering + x = ieor(y, ishft(y, -11)) + x = ieor(x, iand(ishft(x, 7), TMASKB)) + x = ieor(x, iand(ishft(x, 15), TMASKC)) + temper = ieor(x, ishft(x, -18)) + end function temper + ! ------------------------------------------------------------- + ! Public (but hidden) functions + ! -------------------- + function initialize_scalar(seed) result(twister) + integer(kind=im), intent(in ) :: seed + type(randomNumberSequence) :: twister + + integer(kind=im) :: i + ! See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. In the previous versions, + ! MSBs of the seed affect only MSBs of the array state[]. + ! 2002/01/09 modified by Makoto Matsumoto + + twister%state(0) = iand(seed, -1_im) + do i = 1, blockSize - 1 ! ubound(twister%state) + twister%state(i) = 1812433253_im * ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30_im)) + i + twister%state(i) = iand(twister%state(i), -1_im) ! for >32 bit machines + end do + twister%currentElement = blockSize + end function initialize_scalar + ! ------------------------------------------------------------- + function initialize_vector(seed) result(twister) + integer(kind=im), dimension(0:), intent(in) :: seed + type(randomNumberSequence) :: twister + + integer(kind=im) :: i, j, k, nFirstLoop, nWraps + + nWraps = 0 + twister = initialize_scalar(19650218_im) + + nFirstLoop = max(blockSize, size(seed)) + do k = 1, nFirstLoop + i = mod(k + nWraps, blockSize) + j = mod(k - 1, size(seed)) + if(i == 0) then + twister%state(i) = twister%state(blockSize - 1) + twister%state(1) = ieor(twister%state(1), & + ieor(twister%state(1-1), & + ishft(twister%state(1-1), -30_im)) * 1664525_im) + & + seed(j) + j ! Non-linear + twister%state(i) = iand(twister%state(i), -1_im) ! for >32 bit machines + nWraps = nWraps + 1 + else + twister%state(i) = ieor(twister%state(i), & + ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30_im)) * 1664525_im) + & + seed(j) + j ! Non-linear + twister%state(i) = iand(twister%state(i), -1_im) ! for >32 bit machines + end if + end do + + ! + ! Walk through the state array, beginning where we left off in the block above + ! + do i = mod(nFirstLoop, blockSize) + nWraps + 1, blockSize - 1 + twister%state(i) = ieor(twister%state(i), & + ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30_im)) * 1566083941_im) - i ! Non-linear + twister%state(i) = iand(twister%state(i), -1_im) ! for >32 bit machines + end do + + twister%state(0) = twister%state(blockSize - 1) + + do i = 1, mod(nFirstLoop, blockSize) + nWraps + twister%state(i) = ieor(twister%state(i), & + ieor(twister%state(i-1), & + ishft(twister%state(i-1), -30_im)) * 1566083941_im) - i ! Non-linear + twister%state(i) = iand(twister%state(i), -1_im) ! for >32 bit machines + end do + + twister%state(0) = UMASK + twister%currentElement = blockSize + + end function initialize_vector + ! ------------------------------------------------------------- + ! Public functions + ! -------------------- + function getRandomInt(twister) + type(randomNumberSequence), intent(inout) :: twister + integer(kind=im) :: getRandomInt + ! Generate a random integer on the interval [0,0xffffffff] + ! Equivalent to genrand_int32 in the C code. + ! Fortran doesn't have a type that's unsigned like C does, + ! so this is integers in the range -2**31 - 2**31 + ! All functions for getting random numbers call this one, + ! then manipulate the result + + if(twister%currentElement >= blockSize) call nextState(twister) + + getRandomInt = temper(twister%state(twister%currentElement)) + twister%currentElement = twister%currentElement + 1 + + end function getRandomInt + ! -------------------- + function getRandomPositiveInt(twister) + type(randomNumberSequence), intent(inout) :: twister + integer(kind=im) :: getRandomPositiveInt + ! Generate a random integer on the interval [0,0x7fffffff] + ! or [0,2**31] + ! Equivalent to genrand_int31 in the C code. + + ! Local integers + integer(kind=im) :: localInt + + localInt = getRandomInt(twister) + getRandomPositiveInt = ishft(localInt, -1) + + end function getRandomPositiveInt + ! -------------------- + ! -------------------- +!! mji - modified Jan 2007, double converted to rrtmg real kind type + function getRandomReal(twister) + type(randomNumberSequence), intent(inout) :: twister +! double precision :: getRandomReal + real(kind=rb) :: getRandomReal + ! Generate a random number on [0,1] + ! Equivalent to genrand_real1 in the C code + ! The result is stored as double precision but has 32 bit resolution + + integer(kind=im) :: localInt + + localInt = getRandomInt(twister) + if(localInt < 0) then +! getRandomReal = dble(localInt + 2.0d0**32)/(2.0d0**32 - 1.0d0) + getRandomReal = (localInt + 2.0**32_rb)/(2.0**32_rb - 1.0_rb) + else +! getRandomReal = dble(localInt )/(2.0d0**32 - 1.0d0) + getRandomReal = (localInt )/(2.0**32_rb - 1.0_rb) + end if + + end function getRandomReal + ! -------------------- + subroutine finalize_RandomNumberSequence(twister) + type(randomNumberSequence), intent(inout) :: twister + + twister%currentElement = blockSize + twister%state(:) = 0_im + end subroutine finalize_RandomNumberSequence + + ! -------------------- + + end module MersenneTwister + diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 585ff01df..74aaf6903 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -3584,33 +3584,33 @@ SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, & RH_00L = 0.7 + SQRT(1./(25.0+gridkm*gridkm*gridkm)) RH_00O = 0.81 + SQRT(1./(50.0+gridkm*gridkm*gridkm)) - - DO j = jts,jte - DO k = kts,kte - DO i = its,ite - RHI_max = 0.0 - CLDFRA(I,K,J) = 0.0 - + + DO j = jts,jte + DO k = kts,kte + DO i = its,ite + RHI_max = 0.0 + CLDFRA(I,K,J) = 0.0 + if (qc(i,k,j).gt.1.E-6 .or. qi(i,k,j).ge.1.E-7 .or.qs(i,k,j) & - & .gt.1.E-5) then - CLDFRA(I,K,J) = 1.0 - qvsat(i,k,j) = qv(i,k,j) - else - TK = t(i,k,j) - TC = TK - 273.16 - - qvsw = rslf(P(i,k,j), TK) - qvsi = rsif(P(i,k,j), TK) - - if (tc .ge. -12.0) then - qvsat(i,k,j) = qvsw - elseif (tc .lt. -20.0) then - qvsat(i,k,j) = qvsi - else - qvsat(i,k,j) = qvsw - (qvsw-qvsi)*(-12.0-tc)/(-12.0+20.) - endif - RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 0.9999)) - + & .gt.1.E-5) then + CLDFRA(I,K,J) = 1.0 + qvsat(i,k,j) = qv(i,k,j) + else + TK = t(i,k,j) + TC = TK - 273.16 + + qvsw = rslf(P(i,k,j), TK) + qvsi = rsif(P(i,k,j), TK) + + if (tc .ge. -12.0) then + qvsat(i,k,j) = qvsw + elseif (tc .lt. -20.0) then + qvsat(i,k,j) = qvsi + else + qvsat(i,k,j) = qvsw - (qvsw-qvsi)*(-12.0-tc)/(-12.0+20.) + endif + RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 0.9999)) + IF ((XLAND(I,J)-1.5).GT.0.) THEN !--- Ocean RH_00 = RH_00O ELSE !--- Land diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 7b029f8b0..55f864f9b 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -243,12 +243,15 @@ module rrtmg_lw ! use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & - & isubclw, icldflg, iovrlw, ivflip, & - & kind_phys + & isubclw, icldflg, iovrlw, ivflip +!mz & kind_phys use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 use mersenne_twister, only : random_setseed, random_number, & & random_stat +!mz + use machine, only : kind_phys, & + & im => kind_io4, rb => kind_phys use module_radlw_parameters ! @@ -593,6 +596,28 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(npts,nlay,nbands),intent(in):: & & aeraod, aerssa +!mz* HWRF -- INPUT from mcica_subcol_lw + real(kind=kind_phys),dimension(ngptlw,npts,nlay) :: cldfmcl ! Cloud fraction + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(in) :: ciwpmcl(:,:,:) ! In-cloud ice water path (g/m2) +! ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(in) :: clwpmcl(:,:,:) ! In-cloud liquid water path (g/m2) +! ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(in) :: cswpmcl(:,:,:) ! In-cloud snow water path (g/m2) +! ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns) +! ! Dimensions: (ncol,nlay) +! real(kind=rb), intent(in) :: reicmcl(:,:) ! Cloud ice effective size (microns) +! ! Dimensions: (ncol,nlay) +! real(kind=rb), intent(in) :: resnmcl(:,:) ! Snow effective size (microns) +! ! Dimensions: (ncol,nlay) +! real(kind=rb), intent(in) :: taucmcl(:,:,:) ! In-cloud optical depth +! ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth +! ! Dimensions: (ncol,nlay,nbndlw) + +!mz + ! --- outputs: real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hlwc real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & @@ -614,6 +639,11 @@ subroutine rrtmg_lw_run & logical, intent(in) :: lslwr ! --- locals: +! mz* - Add height of each layer for exponential-random cloud overlap +! This will be derived below from the dzlyr in each layer + real (kind=kind_phys), dimension( npts,nlay ) :: hgt + real (kind=kind_phys):: dzsum + real (kind=kind_phys), dimension(0:nlp1) :: cldfrc real (kind=kind_phys), dimension(0:nlay) :: totuflux, totdflux, & @@ -631,6 +661,7 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(nlay,nbands) :: htrb real (kind=kind_phys), dimension(nbands,nlay) :: taucld, tauaer + real (kind=kind_phys), dimension(nbands,1,nlay) :: taucld3 real (kind=kind_phys), dimension(ngptlw,nlay) :: fracs, tautot, & & cldfmc @@ -654,6 +685,9 @@ subroutine rrtmg_lw_run & integer, dimension(npts) :: ipseed integer, dimension(nlay) :: jp, jt, jt1, indself, indfor, indminor integer :: laytrop, iplon, i, j, k, k1 + ! mz* added local arrays for RRTMG + integer :: irng, permuteseed,ig + integer :: inflglw, iceflglw, liqflglw logical :: lcf1 ! @@ -662,6 +696,14 @@ subroutine rrtmg_lw_run & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + +!mz* +! For passing in cloud physical properties; cloud optics parameterized +! in RRTMG: + inflglw = 2 + iceflglw = 3 + liqflglw = 1 + ! if (.not. lslwr) return @@ -734,6 +776,52 @@ subroutine rrtmg_lw_run & stemp = sfgtmp(iplon) ! surface ground temp if (iovrlw == 3) delgth= de_lgth(iplon) ! clouds decorr-length +! mz*: HWRF practice + if (iovrlw == 4 ) then + + +!Add layer height needed for exponential (icld=4) and +! exponential-random (icld=5) overlap options + + !iplon = 1 + irng = 0 + permuteseed = 150 + +!mz* Derive height + dzsum =0.0 + do k = 1,nlay + hgt(iplon,k)= dzsum+0.5*dzlyr(iplon,k)*1000. !km->m + dzsum = dzsum+ dzlyr(iplon,k)*1000. + enddo + +! Zero out cloud optical properties here; not used when passing physical properties +! to radiation and taucld is calculated in radiation + do k = 1, nlay + do j = 1, nbands + taucld3(j,iplon,k) = 0.0 + enddo + enddo + + +! call mcica_subcol_lw(iplon, ncol, nlay, iovrlw, permuteseed, & +! & irng, play, hgt, & +! & cldfrac, ciwpth, clwpth, cswpth, rei, rel, res, & +! & taucld, & +! & cldfmcl, & !--output +! & ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, & +! & resnmcl, taucmcl) + +!mz* calculate cldfmcl for mcica first, *temporary + call mcica_subcol_lw(1, iplon, nlay, iovrlw, permuteseed, & + & irng, plyr, hgt, & + & cld_cf, cld_iwp, cld_lwp,cld_swp, & + & cld_ref_ice, cld_ref_liq, & + & cld_ref_snow, taucld3, & + & cldfmcl ) !--output + + endif +!mz* end + !> -# Prepare atmospheric profile for use in rrtm. ! the vertical index of internal array is from surface to top @@ -821,6 +909,8 @@ subroutine rrtmg_lw_run & !> -# Read cloud optical properties. if (ilwcliq > 0) then ! use prognostic cloud method +!mz: GFS operational + if (iovrlw .ne. 4 ) then do k = 1, nlay k1 = nlp1 - k cldfrc(k)= cld_cf(iplon,k1) @@ -828,11 +918,40 @@ subroutine rrtmg_lw_run & relw(k) = cld_ref_liq(iplon,k1) ciwp(k) = cld_iwp(iplon,k1) reiw(k) = cld_ref_ice(iplon,k1) + !mz*: Limit upper bound of reice for Fu ice + !parameterization and convert from effective radius + !to generalized effective size (*1.0315; Fu, 1996) + if (iovrlw .eq. 4 .and. iceflglw.eq.3) then + reiw(k) = cld_ref_ice(iplon,k1) *1.0315 + reiw(k) = min(140.0, reiw(k)) + endif cda1(k) = cld_rwp(iplon,k1) cda2(k) = cld_ref_rain(iplon,k1) cda3(k) = cld_swp(iplon,k1) cda4(k) = cld_ref_snow(iplon,k1) + !mz + if (iovrlw .eq. 4 .and. inflglw .ne.5) then + cda3(k) = 0. + cda4(k) = 10. + endif enddo + ! transfer + else if (iovrlw .eq. 4) then !mz HWRF + do k = 1, nlay + k1 = nlp1 - k + do ig = 1, ngptlw + cldfmc(ig,k) = cldfmcl(ig,iplon,k1) +!mz* not activate +! taucmc(ig,k) = taucmcl(ig,iplon,k1) +! ciwpmc(ig,k) = ciwpmcl(ig,iplon,k1) +! clwpmc(ig,k) = clwpmcl(ig,iplon,k1) +! cswpmc(ig,k) = cswpmcl(ig,iplon,k1) + enddo +! reicmc(k) = reicmcl(iplon,k1) +! relqmc(k) = relqmcl(iplon,k1) +! resnmc(k) = resnmcl(iplon,k1) + enddo + endif else ! use diagnostic cloud method do k = 1, nlay k1 = nlp1 - k @@ -928,17 +1047,45 @@ subroutine rrtmg_lw_run & enddo if (ilwcliq > 0) then ! use prognostic cloud method +!mz* + if (iovrlw .ne. 4) then do k = 1, nlay cldfrc(k)= cld_cf(iplon,k) clwp(k) = cld_lwp(iplon,k) relw(k) = cld_ref_liq(iplon,k) ciwp(k) = cld_iwp(iplon,k) reiw(k) = cld_ref_ice(iplon,k) + !mz*: Limit upper bound of reice for Fu ice + !parameterization and convert from effective radius + !to generalized effective size (*1.0315; Fu, 1996) + if (iovrlw .eq. 4 .and. iceflglw.eq.3) then + reiw(k) = cld_ref_ice(iplon,k1) *1.0315 + reiw(k) = min(140.0, reiw(k)) + endif cda1(k) = cld_rwp(iplon,k) cda2(k) = cld_ref_rain(iplon,k) cda3(k) = cld_swp(iplon,k) cda4(k) = cld_ref_snow(iplon,k) + !mz* + if (iovrlw .eq. 4 .and. inflglw .ne.5) then + cda3(k) = 0. + cda4(k) = 10. + endif + enddo + else if (iovrlw .eq. 4) then + do k = 1, nlay + do ig = 1, ngptlw + cldfmc(ig,k) = cldfmcl(ig,iplon,k) +! taucmc(ig,k) = taucmcl(ig,iplon,k) +! ciwpmc(ig,k) = ciwpmcl(ig,iplon,k) +! clwpmc(ig,k) = clwpmcl(ig,iplon,k) +! cswpmc(ig,k) = cswpmcl(ig,iplon,k) + enddo +! reicmc(k) = reicmcl(iplon,k) +! relqmc(k) = relqmcl(iplon,k) +! resnmc(k) = resnmcl(iplon,k) enddo + endif else ! use diagnostic cloud method do k = 1, nlay cldfrc(k)= cld_cf(iplon,k) @@ -1004,6 +1151,9 @@ subroutine rrtmg_lw_run & !> -# For cloudy atmosphere, call cldprop() to set cloud optical !! properties. +!mz* + if (iovrlw .ne. 4 ) then !mz:GFS oprational + lcf1 = .false. lab_do_k0 : do k = 1, nlay if ( cldfrc(k) > eps ) then @@ -1040,6 +1190,26 @@ subroutine rrtmg_lw_run & cldfmc = f_zero taucld = f_zero endif + endif !mz iovrlw.ne.4 + +! else if (iovrlw .eq. 4) then !mz*:HWRF for cldovrlp=4 + +!mz* call CLDPRMC to set cloud optical depth for McICA based on input cloud +! properties (inflglw) + +! For cloudy atmosphere, use cldprop to set cloud optical properties based on +! input cloud physical properties. Select method based on choices described +! in cldprop. Cloud fraction, water path, liquid droplet and ice particle +! effective radius must be passed into cldprop. Cloud fraction and cloud +! optical depth are transferred to rrtmg_lw arrays in cldprop. +! +! ncbands(im): number of cloud spectral bands +! taucmc(ngptlw,nlayers): cloud optical depth [mcica] + +! call cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, ciwpmc,& +! clwpmc, cswpmc, reicmc, relqmc, resnmc, & +! ncbands, taucmc) + ! if (lprnt) then ! print *,' after cldprop' @@ -1344,11 +1514,13 @@ subroutine rlwinit & ! !===> ... begin here ! - if ( iovrlw<0 .or. iovrlw>3 ) then + if ( iovrlw<0 .or. iovrlw>4 ) then print *,' *** Error in specification of cloud overlap flag', & & ' IOVRLW=',iovrlw,' in RLWINIT !!' stop - elseif ( iovrlw>=2 .and. isubclw==0 ) then +!mz +! elseif ( iovrlw>=2 .and. isubclw==0 ) then + elseif ( (iovrlw.eq.2 .or. iovrlw.eq.3).and. isubclw==0 ) then if (me == 0) then print *,' *** IOVRLW=',iovrlw,' is not available for', & & ' ISUBCLW=0 setting!!' @@ -6762,9 +6934,569 @@ end subroutine taumol !! @} !----------------------------------- +!mz* exponential cloud overlapping subroutines +!------------------------------------------------------------------ +! Public subroutines +!------------------------------------------------------------------ +! mz* - Add height needed for exponential and exponential-random cloud overlap methods (icld=4 and 5, respectively) +! mz* - cldfmcl only *temporary + subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, & + & irng, play, hgt, & + & cldfrac, ciwp, clwp, cswp, rei, rel, res, tauc, & + & cldfmcl) +!mz* the below output need to be compatible with cldprop() +!mz ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, resnmcl, taucmcl) + + use machine, only : im => kind_io4, rb => kind_phys +! ----- Input ----- +! Control + integer(kind=im), intent(in) :: iplon ! column/longitude index + integer(kind=im), intent(in) :: ncol ! number of columns + integer(kind=im), intent(in) :: nlay ! number of model layers + integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag + integer(kind=im), intent(in) :: permuteseed ! if the cloud generator is called multiple times, + ! permute the seed between each call. + ! between calls for LW and SW, recommended + ! permuteseed differes by 'ngpt' + integer(kind=im), intent(inout) :: irng ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne + ! Twister + +! Atmosphere + real(kind=rb), intent(in) :: play(:,:) ! layer pressures (mb) + ! Dimensions: (ncol,nlay) + +! mji - Add height + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) + +! Atmosphere/clouds - cldprop + real(kind=rb), intent(in) :: cldfrac(:,:) ! layer cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth + ! Dimensions: (nbndlw,ncol,nlay) +! real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo + ! Dimensions: (nbndlw,ncol,nlay) +! real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter + ! Dimensions: (nbndlw,ncol,nlay) + real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: rei(:,:) ! cloud ice particle size + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: rel(:,:) ! cloud liquid particle size + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: res(:,:) ! snow particle size + ! Dimensions: (ncol,nlay) + +! ----- Output ----- +! Atmosphere/clouds - cldprmc [mcica] + real(kind=rb), intent(out) :: cldfmcl(:,:,:) ! cloud fraction [mcica] + ! Dimensions: (ngptlw,ncol,nlay) +!mz* not activate, temporary local vars + real(kind=rb),dimension(ngptlw,ncol,nlay) :: ciwpmcl ! in-cloud ice water path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb),dimension(ngptlw,ncol,nlay) :: clwpmcl ! in-cloud liquid water path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb),dimension(ngptlw,ncol,nlay) :: cswpmcl ! in-cloud snow path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb),dimension(ncol,nlay) :: relqmcl ! liquid particle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb),dimension(ncol,nlay) :: reicmcl ! ice partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb),dimension(ncol,nlay) :: resnmcl ! snow partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb),dimension(ngptlw,ncol,nlay) :: taucmcl ! in-cloud optical depth [mcica] +!mz* + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(out) :: ssacmcl(:,:,:) ! in-cloud single scattering albedo [mcica] + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(out) :: asmcmcl(:,:,:) ! in-cloud asymmetry parameter [mcica] + ! Dimensions: (ngptlw,ncol,nlay) +! ----- Local ----- + +! Stochastic cloud generator variables [mcica] + integer(kind=im), parameter :: nsubclw = ngptlw ! number of sub-columns (g-point intervals) + integer(kind=im) :: ilev ! loop index + + real(kind=rb) :: pmid(ncol, nlay) ! layer pressures (Pa) +! real(kind=rb) :: pdel(ncol, nlay) ! layer pressure thickness (Pa) +! real(kind=rb) :: qi(ncol, nlay) ! ice water (specific humidity) +! real(kind=rb) :: ql(ncol, nlay) ! liq water (specific humidity) + +! Return if clear sky + if (icld.eq.0) return + +! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at least the number of subcolumns + + +! Pass particle sizes to new arrays, no subcolumns for these properties yet +! Convert pressures from mb to Pa + + reicmcl(:ncol,:nlay) = rei(:ncol,:nlay) + relqmcl(:ncol,:nlay) = rel(:ncol,:nlay) + resnmcl(:ncol,:nlay) = res(:ncol,:nlay) + pmid(:ncol,:nlay) = play(:ncol,:nlay)*1.e2_rb + +! Generate the stochastic subcolumns of cloud optical properties for +! the longwave + call generate_stochastic_clouds (ncol, nlay, nsubclw, icld, irng, & + & pmid, hgt, cldfrac, clwp, ciwp, cswp, tauc, & + & cldfmcl, clwpmcl, ciwpmcl, cswpmcl, & + & taucmcl, permuteseed) + + end subroutine mcica_subcol_lw +!------------------------------------------------------------------------------------------------- + subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, & + & irng, pmid, hgt, cld, clwp, ciwp, cswp, tauc, & + & cld_stoch, clwp_stoch, ciwp_stoch, & + & cswp_stoch, tauc_stoch, changeSeed) +!------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- +! Contact: Cecile Hannay (hannay@ucar.edu) +! +! Original code: Based on Raisanen et al., QJRMS, 2004. +! +! Modifications: +! 1) Generalized for use with RRTMG and added Mersenne Twister as the default +! random number generator, which can be changed to the optional kissvec random number generator +! with flag 'irng'. Some extra functionality has been commented or removed. +! Michael J. Iacono, AER, Inc., February 2007 +! 2) Activated exponential and exponential/random cloud overlap method +! Michael J. Iacono, AER, November 2017 +! +! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns. +! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one +! and uniform cloud liquid and cloud ice concentration. +! The ensemble as a whole reproduces the probability function of cloud liquid and ice within each layer +! and obeys an overlap assumption in the vertical. +! +! Overlap assumption: +! The cloud are consistent with 5 overlap assumptions: random, maximum, maximum-random, exponential and exponential random. +! The default option is maximum-random (option 2) +! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap, 5=exp/random +! This is set with the variable "overlap" +! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) +! +! Seed: +! If the stochastic cloud generator is called several times during the same timestep, +! one should change the seed between the call to insure that the +! subcolumns are different. +! This is done by changing the argument 'changeSeed' +! For example, if one wants to create a set of columns for the +! shortwave and another set for the longwave , +! use 'changeSeed = 1' for the first call and'changeSeed = 2' for the second call + +! PDF assumption: +! We can use arbitrary complicated PDFS. +! In the present version, we produce homogeneuous clouds (the simplest case). +! Future developments include using the PDF scheme of Ben Johnson. +! +! History file: +! Option to add diagnostics variables in the history file. (using FINCL in the namelist) +! nsubcol = number of subcolumns +! overlap = overlap type (1-3) +! Zo = length scale +! CLOUD_S = mean of the subcolumn cloud fraction ('_S" means Stochastic) +! CLDLIQ_S = mean of the subcolumn cloud water +! CLDICE_S = mean of the subcolumn cloud ice +! +! Note: +! Here: we force that the cloud condensate to be consistent with the cloud fraction +! i.e we only have cloud condensate when the cell is cloudy. +! In CAM: The cloud condensate and the cloud fraction are obtained from 2 different equations +! and the 2 quantities can be inconsistent (i.e. CAM can produce cloud fraction +! without cloud condensate or the opposite). +!----------------------------------------------------------------- + + use mcica_random_numbers +! The Mersenne Twister random number engine + use MersenneTwister, only: randomNumberSequence, & + & new_RandomNumberSequence, getRandomReal + use machine ,only : im => kind_io4, rb => kind_phys + + type(randomNumberSequence) :: randomNumbers + +! -- Arguments + + integer(kind=im), intent(in) :: ncol ! number of columns + integer(kind=im), intent(in) :: nlay ! number of layers + integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag + integer(kind=im), intent(inout) :: irng ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne Twister + integer(kind=im), intent(in) :: nsubcol ! number of sub-columns (g-point intervals) + integer(kind=im), optional, intent(in) :: changeSeed ! allows permuting seed + +! Column state (cloud fraction, cloud water, cloud ice) + variables needed to read physics state + real(kind=rb), intent(in) :: pmid(:,:) ! layer pressure (Pa) + ! Dimensions: (ncol,nlay) + + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cld(:,:) ! cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth + ! Dimensions:(nbndlw,ncol,nlay) +! real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo + ! Dimensions: (nbndlw,ncol,nlay) + ! inactive - for future expansion +! real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter + ! Dimensions: (nbndlw,ncol,nlay) + ! inactive - for future expansion + + real(kind=rb), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: clwp_stoch(:,:,:) ! subcolumn in-cloud liquid water path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: ciwp_stoch(:,:,:) ! subcolumn in-cloud ice water path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: cswp_stoch(:,:,:) ! subcolumn in-cloud snow path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: tauc_stoch(:,:,:) ! subcolumn in-cloud optical depth + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(out) :: ssac_stoch(:,:,:)! subcolumn in-cloud single scattering albedo + ! Dimensions: (ngptlw,ncol,nlay) + ! inactive - for future expansion +! real(kind=rb), intent(out) :: asmc_stoch(:,:,:)! subcolumn in-cloud asymmetry parameter + ! Dimensions: (ngptlw,ncol,nlay) + ! inactive - for future expansion + +! -- Local variables + real(kind=rb) :: cldf(ncol,nlay) ! cloud fraction + +! Mean over the subcolumns (cloud fraction, cloud water , cloud ice) - inactive +! real(kind=rb) :: mean_cld_stoch(ncol, nlay) ! cloud fraction +! real(kind=rb) :: mean_clwp_stoch(ncol, nlay) ! cloud water +! real(kind=rb) :: mean_ciwp_stoch(ncol, nlay) ! cloud ice +! real(kind=rb) :: mean_tauc_stoch(ncol, nlay) ! cloud optical depth +! real(kind=rb) :: mean_ssac_stoch(ncol, nlay) ! cloud single scattering albedo +! real(kind=rb) :: mean_asmc_stoch(ncol, nlay) ! cloud asymmetry parameter + +! Set overlap + integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum-random, + ! 3 = maximum overlap, 4 = exponential, + ! 5 = exponential-random + real(kind=rb), parameter :: Zo = 2500._rb ! length scale (m) + real(kind=rb), dimension(ncol,nlay) :: alpha ! overlap parameter + +! Constants (min value for cloud fraction and cloud water and ice) + real(kind=rb), parameter :: cldmin = 1.0e-20_rb ! min cloud fraction +! real(kind=rb), parameter :: qmin = 1.0e-10_rb ! min cloud water and cloud ice (not used) + +! Variables related to random number and seed + real(kind=rb), dimension(nsubcol, ncol, nlay) :: CDF, CDF2 !random numbers + integer(kind=im), dimension(ncol) :: seed1, seed2, seed3, seed4 !seed to create random number (kissvec) + real(kind=rb), dimension(ncol) :: rand_num ! random number (kissvec) + integer(kind=im) :: iseed ! seed to create random number (Mersenne Teister) + real(kind=rb) :: rand_num_mt ! random number (Mersenne Twister) + +! Flag to identify cloud fraction in subcolumns + logical, dimension(nsubcol, ncol, nlay) :: iscloudy ! flag that says whether a gridbox is cloudy + +! Indices + integer(kind=im) :: ilev, isubcol, i, n ! indices + +!------------------------------------------------------------------- + +! Check that irng is in bounds; if not, set to default + if (irng .ne. 0) irng = 1 + +! Pass input cloud overlap setting to local variable + overlap = icld + +! Ensure that cloud fractions are in bounds + do ilev = 1, nlay + do i = 1, ncol + cldf(i,ilev) = cld(i,ilev) + if (cldf(i,ilev) < cldmin) then + cldf(i,ilev) = 0._rb + endif + enddo + enddo + +! ----- Create seed -------- + +! Advance randum number generator by changeseed values + if (irng.eq.0) then +! For kissvec, create a seed that depends on the state of the columns. Maybe not the best way, but it works. +! Must use pmid from bottom four layers. + do i=1,ncol + if (pmid(i,1).lt.pmid(i,2)) then + stop 'MCICA_SUBCOL: KISSVEC SEED GENERATOR REQUIRES PMID & + & FROM BOTTOM FOUR LAYERS.' + endif + seed1(i) = (pmid(i,1) - int(pmid(i,1))) * 1000000000_im + seed2(i) = (pmid(i,2) - int(pmid(i,2))) * 1000000000_im + seed3(i) = (pmid(i,3) - int(pmid(i,3))) * 1000000000_im + seed4(i) = (pmid(i,4) - int(pmid(i,4))) * 1000000000_im + enddo + do i=1,changeSeed + call kissvec(seed1, seed2, seed3, seed4, rand_num) + enddo + elseif (irng.eq.1) then + randomNumbers = new_RandomNumberSequence(seed = changeSeed) + endif + +! ------ Apply overlap assumption -------- + +! generate the random numbers + + select case (overlap) + + case(1) +! Random overlap +! i) pick a random value at every level + + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) ! we get different random number for each level + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + case(2) +! Maximum-Random overlap +! i) pick a random number for top layer. +! ii) walk down the column: +! - if the layer above is cloudy, we use the same random number than in the layer above +! - if the layer above is clear, we use a new random number + + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + do ilev = 2,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (CDF(isubcol, i, ilev-1) > 1._rb - cldf(i,ilev-1) )& + & then + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev-1) + else + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev) * (1._rb & + & - cldf(i,ilev-1)) + endif + enddo + enddo + enddo + + case(3) +! Maximum overlap +! i) pick the same random numebr at every level + + if (irng.eq.0) then + do isubcol = 1,nsubcol + call kissvec(seed1, seed2, seed3, seed4, rand_num) + do ilev = 1,nlay + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + rand_num_mt = getRandomReal(randomNumbers) + do ilev = 1, nlay + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + +! mji - Activate exponential cloud overlap option + case(4) + ! Exponential overlap: weighting between maximum and random overlap increases with the distance. + ! The random numbers for exponential overlap verify: + ! j=1 RAN(j)=RND1 + ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) + ! RAN(j) = RND2 + ! alpha is obtained from the equation + ! alpha = exp(-(Z(j)-Z(j-1))/Zo) where Zo is a characteristic length scale + + ! compute alpha + do i = 1, ncol + alpha(i, 1) = 0._rb + do ilev = 2,nlay + alpha(i, ilev) = exp( -( hgt (i, ilev) - & + & hgt (i, ilev-1)) / Zo) + enddo + enddo + + ! generate 2 streams of random numbers + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol, :, ilev) = rand_num + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF2(isubcol, :, ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + rand_num_mt = getRandomReal(randomNumbers) + CDF2(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + ! generate random numbers + do ilev = 2,nlay + where (CDF2(:, :, ilev) < spread(alpha (:,ilev), & + & dim=1,nCopies=nsubcol) ) + CDF(:,:,ilev) = CDF(:,:,ilev-1) + end where + end do + +! Activate exponential-random cloud overlap option + case(5) + ! Exponential-random overlap: +!mz* call wrf_error_fatal("Cloud Overlap case 5: ER has not yet & +! been implemented. Stopping...") + + end select + +! -- generate subcolumns for homogeneous clouds ----- + do ilev = 1,nlay + iscloudy(:,:,ilev) = (CDF(:,:,ilev) >= 1._rb - & + & spread(cldf(:,ilev), dim=1, nCopies=nsubcol) ) + enddo + +! where the subcolumn is cloudy, the subcolumn cloud fraction is 1; +! where the subcolumn is not cloudy, the subcolumn cloud fraction is 0; +! where there is a cloud, define the subcolumn cloud properties, +! otherwise set these to zero + + do ilev = 1,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (iscloudy(isubcol,i,ilev) ) then + cld_stoch(isubcol,i,ilev) = 1._rb + clwp_stoch(isubcol,i,ilev) = clwp(i,ilev) + ciwp_stoch(isubcol,i,ilev) = ciwp(i,ilev) + cswp_stoch(isubcol,i,ilev) = cswp(i,ilev) + n = ngb(isubcol) + tauc_stoch(isubcol,i,ilev) = tauc(n,i,ilev) +! ssac_stoch(isubcol,i,ilev) = ssac(n,i,ilev) +! asmc_stoch(isubcol,i,ilev) = asmc(n,i,ilev) + else + cld_stoch(isubcol,i,ilev) = 0._rb + clwp_stoch(isubcol,i,ilev) = 0._rb + ciwp_stoch(isubcol,i,ilev) = 0._rb + cswp_stoch(isubcol,i,ilev) = 0._rb + tauc_stoch(isubcol,i,ilev) = 0._rb +! ssac_stoch(isubcol,i,ilev) = 1._rb +! asmc_stoch(isubcol,i,ilev) = 1._rb + endif + enddo + enddo + enddo +! -- compute the means of the subcolumns --- +! mean_cld_stoch(:,:) = 0._rb +! mean_clwp_stoch(:,:) = 0._rb +! mean_ciwp_stoch(:,:) = 0._rb +! mean_tauc_stoch(:,:) = 0._rb +! mean_ssac_stoch(:,:) = 0._rb +! mean_asmc_stoch(:,:) = 0._rb +! do i = 1, nsubcol +! mean_cld_stoch(:,:) = cld_stoch(i,:,:) + mean_cld_stoch(:,:) +! mean_clwp_stoch(:,:) = clwp_stoch( i,:,:) + mean_clwp_stoch(:,:) +! mean_ciwp_stoch(:,:) = ciwp_stoch( i,:,:) + mean_ciwp_stoch(:,:) +! mean_tauc_stoch(:,:) = tauc_stoch( i,:,:) + mean_tauc_stoch(:,:) +! mean_ssac_stoch(:,:) = ssac_stoch( i,:,:) + mean_ssac_stoch(:,:) +! mean_asmc_stoch(:,:) = asmc_stoch( i,:,:) + mean_asmc_stoch(:,:) +! end do +! mean_cld_stoch(:,:) = mean_cld_stoch(:,:) / nsubcol +! mean_clwp_stoch(:,:) = mean_clwp_stoch(:,:) / nsubcol +! mean_ciwp_stoch(:,:) = mean_ciwp_stoch(:,:) / nsubcol +! mean_tauc_stoch(:,:) = mean_tauc_stoch(:,:) / nsubcol +! mean_ssac_stoch(:,:) = mean_ssac_stoch(:,:) / nsubcol +! mean_asmc_stoch(:,:) = mean_asmc_stoch(:,:) / nsubcol + + end subroutine generate_stochastic_clouds + +!------------------------------------------------------------------ +! Private subroutines +!------------------------------------------------------------------ + +!----------------------------------------------------------------- + subroutine kissvec(seed1,seed2,seed3,seed4,ran_arr) +!---------------------------------------------------------------- + +! public domain code +! made available from http://www.fortran.com/ +! downloaded by pjr on 03/16/04 for NCAR CAM +! converted to vector form, functions inlined by pjr,mvr on 05/10/2004 + +! The KISS (Keep It Simple Stupid) random number generator. Combines: +! (1) The congruential generator x(n)=69069*x(n-1)+1327217885, period 2^32. +! (2) A 3-shift shift-register generator, period 2^32-1, +! (3) Two 16-bit multiply-with-carry generators, period 597273182964842497>2^59 +! Overall period>2^123; + real(kind=rb), dimension(:), intent(inout) :: ran_arr + integer(kind=im), dimension(:), intent(inout) :: seed1,seed2,seed3& + & ,seed4 + integer(kind=im) :: i,sz,kiss + integer(kind=im) :: m, k, n + +! inline function + m(k, n) = ieor (k, ishft (k, n) ) + + sz = size(ran_arr) + do i = 1, sz + seed1(i) = 69069_im * seed1(i) + 1327217885_im + seed2(i) = m (m (m (seed2(i), 13_im), - 17_im), 5_im) + seed3(i) = 18000_im * iand (seed3(i), 65535_im) + & + & ishft (seed3(i), - 16_im) + seed4(i) = 30903_im * iand (seed4(i), 65535_im) + & + & ishft (seed4(i), - 16_im) + kiss = seed1(i) + seed2(i) + ishft (seed3(i), 16_im) + seed4(i) + ran_arr(i) = kiss*2.328306e-10_rb + 0.5_rb + end do + + end subroutine kissvec ! -!........................................! - end module rrtmg_lw ! -!========================================! +!........................................!$ + end module rrtmg_lw !$ +!========================================!$ From 5597b2c5b3add78dc569c29135caf1fffe5e5410 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Sun, 16 Feb 2020 11:26:53 -0700 Subject: [PATCH 015/274] finalize HWRF RRTMG LW capability --- physics/radiation_clouds.f | 183 +- physics/radlw_main.f | 7502 ------------------------------------ physics/radlw_main.meta | 16 + 3 files changed, 105 insertions(+), 7596 deletions(-) delete mode 100644 physics/radlw_main.f diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 74aaf6903..c259fc22e 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -3610,104 +3610,99 @@ SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, & qvsat(i,k,j) = qvsw - (qvsw-qvsi)*(-12.0-tc)/(-12.0+20.) endif RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 0.9999)) - - IF ((XLAND(I,J)-1.5).GT.0.) THEN !--- Ocean - RH_00 = RH_00O - ELSE !--- Land - RH_00 = RH_00L - ENDIF - - if (tc .ge. -12.0) then - RHUM = MIN(0.999, RHUM) - CLDFRA(I,K,J) = MAX(0.0, 1.0-SQRT((1.0-RHUM)/(1.-RH_00))) - elseif (tc.lt.-12..and.tc.gt.-70. .and. RHUM.gt.RH_00L) then - RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 1.0 - 1.E-6)) - CLDFRA(I,K,J) = MAX(0., 1.0-SQRT((1.0-RHUM)/(1.0-RH_00L))) - endif - CLDFRA(I,K,J) = MIN(0.90, CLDFRA(I,K,J)) - - endif - ENDDO - ENDDO - ENDDO - - -!..Prepare for a 1-D column to find various cloud layers. - - DO j = jts,jte - DO i = its,ite -! if (i.gt.10.and.i.le.20 .and. j.gt.10.and.j.le.20) then -! debug_flag = .true. -! else -! debug_flag = .false. -! endif - -! if (rand_perturb_on .eq. 1) then -! entrmnt = MAX(0.01, MIN(0.99, 0.5 + rand_pert(i,1,j)*0.5)) -! else - entrmnt = 0.5 -! endif - - DO k = kts,kte - qvs1d(k) = qvsat(i,k,j) - cfr1d(k) = cldfra(i,k,j) - T1d(k) = t(i,k,j) - P1d(k) = p(i,k,j) - R1d(k) = rho(i,k,j) - qc1d(k) = qc(i,k,j) - qi1d(k) = qi(i,k,j) - qs1d(k) = qs(i,k,j) - ENDDO - -! if (debug_flag) then -! WRITE (dbg_msg,*) 'DEBUG-GT: finding cloud layers at point (', i, ', ', j, ')' -! CALL wrf_debug (150, dbg_msg) -! endif + + IF ((XLAND(I,J)-1.5).GT.0.) THEN !--- Ocean + RH_00 = RH_00O + ELSE !--- Land + RH_00 = RH_00L + ENDIF + + if (tc .ge. -12.0) then + RHUM = MIN(0.999, RHUM) + CLDFRA(I,K,J) = MAX(0.0, 1.0-SQRT((1.0-RHUM)/(1.-RH_00))) + elseif (tc.lt.-12..and.tc.gt.-70. .and. RHUM.gt.RH_00L) then + RHUM = MAX(0.01, MIN(qv(i,k,j)/qvsat(i,k,j), 1.0 - 1.E-6)) + CLDFRA(I,K,J) = MAX(0., 1.0-SQRT((1.0-RHUM)/(1.0-RH_00L))) + endif + CLDFRA(I,K,J) = MIN(0.90, CLDFRA(I,K,J)) + + endif + ENDDO + ENDDO + ENDDO + + +!..Prepare for a 1-D column to find various cloud layers. + + DO j = jts,jte + DO i = its,ite +! if (i.gt.10.and.i.le.20 .and. j.gt.10.and.j.le.20) then +! debug_flag = .true. +! else +! debug_flag = .false. +! endif + +! if (rand_perturb_on .eq. 1) then +! entrmnt = MAX(0.01, MIN(0.99, 0.5 + rand_pert(i,1,j)*0.5)) +! else + entrmnt = 0.5 +! endif + + DO k = kts,kte + qvs1d(k) = qvsat(i,k,j) + cfr1d(k) = cldfra(i,k,j) + T1d(k) = t(i,k,j) + P1d(k) = p(i,k,j) + R1d(k) = rho(i,k,j) + qc1d(k) = qc(i,k,j) + qi1d(k) = qi(i,k,j) + qs1d(k) = qs(i,k,j) + ENDDO + +! if (debug_flag) then +! WRITE (dbg_msg,*) 'DEBUG-GT: finding cloud layers at point (', i, ', ', j, ')' +! CALL wrf_debug (150, dbg_msg) +! endif call find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & & debug_flag, qc1d, qi1d, qs1d, kts,kte) - - DO k = kts,kte - cldfra(i,k,j) = cfr1d(k) - qc(i,k,j) = qc1d(k) - qi(i,k,j) = qi1d(k) - ENDDO - ENDDO - ENDDO - - - END SUBROUTINE cal_cldfra3 - - -!+---+-----------------------------------------------------------------+ -!..From cloud fraction array, find clouds of multi-level depth and -!compute -!.. a reasonable value of LWP or IWP that might be contained in that -!depth, -!.. unless existing LWC/IWC is already there. - + + DO k = kts,kte + cldfra(i,k,j) = cfr1d(k) + qc(i,k,j) = qc1d(k) + qi(i,k,j) = qi1d(k) + ENDDO + ENDDO + ENDDO + + + END SUBROUTINE cal_cldfra3 +!+---+-----------------------------------------------------------------+ +!..From cloud fraction array, find clouds of multi-level depth and compute +!.. a reasonable value of LWP or IWP that might be contained in that depth, +!.. unless existing LWC/IWC is already there. + SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & & debugfl, qc1d, qi1d, qs1d, kts,kte) -! - IMPLICIT NONE -! - INTEGER, INTENT(IN):: kts, kte - LOGICAL, INTENT(IN):: debugfl - REAL, INTENT(IN):: entrmnt - REAL, DIMENSION(kts:kte), INTENT(IN):: qvs1d,T1d,P1d,R1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: cfr1d - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc1d, qi1d, qs1d - -!..Local vars. - REAL, DIMENSION(kts:kte):: theta, dz - REAL:: Z1, Z2, theta1, theta2, ht1, ht2 - INTEGER:: k, k2, k_tropo, k_m12C, k_m40C, k_cldb, k_cldt, kbot - LOGICAL:: in_cloud - character*512 dbg_msg - -!+---+ - - k_m12C = 0 - k_m40C = 0 +! + IMPLICIT NONE + + INTEGER, INTENT(IN):: kts, kte + LOGICAL, INTENT(IN):: debugfl + REAL, INTENT(IN):: entrmnt + REAL, DIMENSION(kts:kte), INTENT(IN):: qvs1d,T1d,P1d,R1d + REAL, DIMENSION(kts:kte), INTENT(INOUT):: cfr1d + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc1d, qi1d, qs1d + +!..Local vars. + REAL, DIMENSION(kts:kte):: theta, dz + REAL:: Z1, Z2, theta1, theta2, ht1, ht2 + INTEGER:: k, k2, k_tropo, k_m12C, k_m40C, k_cldb, k_cldt, kbot + LOGICAL:: in_cloud + character*512 dbg_msg + + + k_m12C = 0 + k_m40C = 0 DO k = kte, kts, -1 theta(k) = T1d(k)*((100000.0/P1d(k))**(287.05/1004.)) if (T1d(k)-273.16 .gt. -40.0 .and. P1d(k).gt.7000.0) k_m40C = & diff --git a/physics/radlw_main.f b/physics/radlw_main.f deleted file mode 100644 index 55f864f9b..000000000 --- a/physics/radlw_main.f +++ /dev/null @@ -1,7502 +0,0 @@ -!> \file radlw_main.f -!! This file contains NCEP's modifications of the rrtmg-lw radiation -!! code from AER. - -!!!!! ============================================================== !!!!! -!!!!! lw-rrtm3 radiation package description !!!!! -!!!!! ============================================================== !!!!! -! ! -! this package includes ncep's modifications of the rrtm-lw radiation ! -! code from aer inc. ! -! ! -! the lw-rrtm3 package includes these parts: ! -! ! -! 'radlw_rrtm3_param.f' ! -! 'radlw_rrtm3_datatb.f' ! -! 'radlw_rrtm3_main.f' ! -! ! -! the 'radlw_rrtm3_param.f' contains: ! -! ! -! 'module_radlw_parameters' -- band parameters set up ! -! ! -! the 'radlw_rrtm3_datatb.f' contains: ! -! ! -! 'module_radlw_avplank' -- plank flux data ! -! 'module_radlw_ref' -- reference temperature and pressure ! -! 'module_radlw_cldprlw' -- cloud property coefficients ! -! 'module_radlw_kgbnn' -- absorption coeffients for 16 ! -! bands, where nn = 01-16 ! -! ! -! the 'radlw_rrtm3_main.f' contains: ! -! ! -! 'rrtmg_lw' -- main lw radiation transfer ! -! ! -! in the main module 'rrtmg_lw' there are only two ! -! externally callable subroutines: ! -! ! -! ! -! 'lwrad' -- main lw radiation routine ! -! inputs: ! -! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! -! clouds,icseed,aerosols,sfemis,sfgtmp, ! -! dzlyr,delpin,de_lgth, ! -! npts, nlay, nlp1, lprnt, ! -! outputs: ! -! hlwc,topflx,sfcflx,cldtau, ! -!! optional outputs: ! -! HLW0,HLWB,FLXPRF) ! -! ! -! 'rlwinit' -- initialization routine ! -! inputs: ! -! ( me ) ! -! outputs: ! -! (none) ! -! ! -! all the lw radiation subprograms become contained subprograms ! -! in module 'rrtmg_lw' and many of them are not directly ! -! accessable from places outside the module. ! -! ! -! derived data type constructs used: ! -! ! -! 1. radiation flux at toa: (from module 'module_radlw_parameters') ! -! topflw_type - derived data type for toa rad fluxes ! -! upfxc total sky upward flux at toa ! -! upfx0 clear sky upward flux at toa ! -! ! -! 2. radiation flux at sfc: (from module 'module_radlw_parameters') ! -! sfcflw_type - derived data type for sfc rad fluxes ! -! upfxc total sky upward flux at sfc ! -! upfx0 clear sky upward flux at sfc ! -! dnfxc total sky downward flux at sfc ! -! dnfx0 clear sky downward flux at sfc ! -! ! -! 3. radiation flux profiles(from module 'module_radlw_parameters') ! -! proflw_type - derived data type for rad vertical prof ! -! upfxc level upward flux for total sky ! -! dnfxc level downward flux for total sky ! -! upfx0 level upward flux for clear sky ! -! dnfx0 level downward flux for clear sky ! -! ! -! external modules referenced: ! -! ! -! 'module physparam' ! -! 'module physcons' ! -! 'mersenne_twister' ! -! ! -! compilation sequence is: ! -! ! -! 'radlw_rrtm3_param.f' ! -! 'radlw_rrtm3_datatb.f' ! -! 'radlw_rrtm3_main.f' ! -! ! -! and all should be put in front of routines that use lw modules ! -! ! -!==========================================================================! -! ! -! the original aer's program declarations: ! -! ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! | -! Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | -! This software may be used, copied, or redistributed as long as it is | -! not sold and this copyright notice is reproduced on each copy made. | -! This model is provided as is without any express or implied warranties. | -! (http://www.rtweb.aer.com/) | -! | -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! ! -! ************************************************************************ ! -! ! -! rrtmg_lw ! -! ! -! ! -! a rapid radiative transfer model ! -! for the longwave region ! -! for application to general circulation models ! -! ! -! ! -! atmospheric and environmental research, inc. ! -! 131 hartwell avenue ! -! lexington, ma 02421 ! -! ! -! eli j. mlawer ! -! jennifer s. delamere ! -! michael j. iacono ! -! shepard a. clough ! -! ! -! ! -! email: miacono@aer.com ! -! email: emlawer@aer.com ! -! email: jdelamer@aer.com ! -! ! -! the authors wish to acknowledge the contributions of the ! -! following people: steven j. taubman, karen cady-pereira, ! -! patrick d. brown, ronald e. farren, luke chen, robert bergstrom. ! -! ! -! ************************************************************************ ! -! ! -! references: ! -! (rrtm_lw/rrtmg_lw): ! -! clough, s.A., m.w. shephard, e.j. mlawer, j.s. delamere, ! -! m.j. iacono, k. cady-pereira, s. boukabara, and p.d. brown: ! -! atmospheric radiative transfer modeling: a summary of the aer ! -! codes, j. quant. spectrosc. radiat. transfer, 91, 233-244, 2005. ! -! ! -! mlawer, e.j., s.j. taubman, p.d. brown, m.j. iacono, and s.a. ! -! clough: radiative transfer for inhomogeneous atmospheres: rrtm, ! -! a validated correlated-k model for the longwave. j. geophys. res., ! -! 102, 16663-16682, 1997. ! -! ! -! (mcica): ! -! pincus, r., h. w. barker, and j.-j. morcrette: a fast, flexible, ! -! approximation technique for computing radiative transfer in ! -! inhomogeneous cloud fields, j. geophys. res., 108(d13), 4376, ! -! doi:10.1029/2002JD003322, 2003. ! -! ! -! ************************************************************************ ! -! ! -! aer's revision history: ! -! this version of rrtmg_lw has been modified from rrtm_lw to use a ! -! reduced set of g-points for application to gcms. ! -! ! -! -- original version (derived from rrtm_lw), reduction of g-points, ! -! other revisions for use with gcms. ! -! 1999: m. j. iacono, aer, inc. ! -! -- adapted for use with ncar/cam3. ! -! may 2004: m. j. iacono, aer, inc. ! -! -- revised to add mcica capability. ! -! nov 2005: m. j. iacono, aer, inc. ! -! -- conversion to f90 formatting for consistency with rrtmg_sw. ! -! feb 2007: m. j. iacono, aer, inc. ! -! -- modifications to formatting to use assumed-shape arrays. ! -! aug 2007: m. j. iacono, aer, inc. ! -! ! -! ************************************************************************ ! -! ! -! ncep modifications history log: ! -! ! -! nov 1999, ken campana -- received the original code from ! -! aer (1998 ncar ccm version), updated to link up with ! -! ncep mrf model ! -! jun 2000, ken campana -- added option to switch random and ! -! maximum/random cloud overlap ! -! 2001, shrinivas moorthi -- further updates for mrf model ! -! may 2001, yu-tai hou -- updated on trace gases and cloud ! -! property based on rrtm_v3.0 codes. ! -! dec 2001, yu-tai hou -- rewritten code into fortran 90 std ! -! set ncep radiation structure standard that contains ! -! three plug-in compatable fortran program files: ! -! 'radlw_param.f', 'radlw_datatb.f', 'radlw_main.f' ! -! fixed bugs in subprograms taugb14, taugb2, etc. added ! -! out-of-bounds protections. (a detailed note of ! -! up_to_date modifications/corrections by ncep was sent ! -! to aer in 2002) ! -! jun 2004, yu-tai hou -- added mike iacono's apr 2004 ! -! modification of variable diffusivity angles. ! -! apr 2005, yu-tai hou -- minor modifications on module ! -! structures include rain/snow effect (this version of ! -! code was given back to aer in jun 2006) ! -! mar 2007, yu-tai hou -- added aerosol effect for ncep ! -! models using the generallized aerosol optical property! -! scheme for gfs model. ! -! apr 2007, yu-tai hou -- added spectral band heating as an ! -! optional output to support the 500 km gfs model's ! -! upper stratospheric radiation calculations. and ! -! restructure optional outputs for easy access by ! -! different models. ! -! oct 2008, yu-tai hou -- modified to include new features ! -! from aer's newer release v4.4-v4.7, including the ! -! mcica sub-grid cloud option. add rain/snow optical ! -! properties support to cloudy sky calculations. ! -! correct errors in mcica cloud optical properties for ! -! ebert & curry scheme (ilwcice=1) that needs band ! -! index conversion. simplified and unified sw and lw ! -! sub-column cloud subroutines into one module by using ! -! optional parameters. ! -! mar 2009, yu-tai hou -- replaced the original random number! -! generator coming from the original code with ncep w3 ! -! library to simplify the program and moved sub-column ! -! cloud subroutines inside the main module. added ! -! option of user provided permutation seeds that could ! -! be randomly generated from forecast time stamp. ! -! oct 2009, yu-tai hou -- modified subrtines "cldprop" and ! -! "rlwinit" according updats from aer's rrtmg_lw v4.8. ! -! nov 2009, yu-tai hou -- modified subrtine "taumol" according -! updats from aer's rrtmg_lw version 4.82. notice the ! -! cloud ice/liquid are assumed as in-cloud quantities, ! -! not as grid averaged quantities. ! -! jun 2010, yu-tai hou -- optimized code to improve efficiency -! apr 2012, b. ferrier and y. hou -- added conversion factor to fu's! -! cloud-snow optical property scheme. ! -! nov 2012, yu-tai hou -- modified control parameters thru ! -! module 'physparam'. ! -! FEB 2017 A.Cheng - add odpth output, effective radius input ! -! jun 2018, h-m lin/y-t hou -- added new option of cloud overlap ! -! method 'de-correlation-length' for mcica application ! -! ! -!!!!! ============================================================== !!!!! -!!!!! end descriptions !!!!! -!!!!! ============================================================== !!!!! - -!> This module contains the CCPP-compliant NCEP's modifications of the -!! rrtm-lw radiation code from aer inc. - module rrtmg_lw -! - use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & - & isubclw, icldflg, iovrlw, ivflip -!mz & kind_phys - use physcons, only : con_g, con_cp, con_avgd, con_amd, & - & con_amw, con_amo3 - use mersenne_twister, only : random_setseed, random_number, & - & random_stat -!mz - use machine, only : kind_phys, & - & im => kind_io4, rb => kind_phys - - use module_radlw_parameters -! - use module_radlw_avplank, only : totplnk - use module_radlw_ref, only : preflog, tref, chi_mls -! - implicit none -! - private -! -! ... version tag and last revision date - character(40), parameter :: & - & VTAGLW='NCEP LW v5.1 Nov 2012 -RRTMG-LW v4.82 ' -! & VTAGLW='NCEP LW v5.0 Aug 2012 -RRTMG-LW v4.82 ' -! & VTAGLW='RRTMG-LW v4.82 Nov 2009 ' -! & VTAGLW='RRTMG-LW v4.8 Oct 2009 ' -! & VTAGLW='RRTMG-LW v4.71 Mar 2009 ' -! & VTAGLW='RRTMG-LW v4.4 Oct 2008 ' -! & VTAGLW='RRTM-LW v2.3g Mar 2007 ' -! & VTAGLW='RRTM-LW v2.3g Apr 2004 ' - -! --- constant values - real (kind=kind_phys), parameter :: eps = 1.0e-6 - real (kind=kind_phys), parameter :: oneminus= 1.0-eps - real (kind=kind_phys), parameter :: cldmin = tiny(cldmin) - real (kind=kind_phys), parameter :: bpade = 1.0/0.278 ! pade approx constant - real (kind=kind_phys), parameter :: stpfac = 296.0/1013.0 - real (kind=kind_phys), parameter :: wtdiff = 0.5 ! weight for radiance to flux conversion - real (kind=kind_phys), parameter :: tblint = ntbl ! lookup table conversion factor - real (kind=kind_phys), parameter :: f_zero = 0.0 - real (kind=kind_phys), parameter :: f_one = 1.0 - -! ... atomic weights for conversion from mass to volume mixing ratios - real (kind=kind_phys), parameter :: amdw = con_amd/con_amw - real (kind=kind_phys), parameter :: amdo3 = con_amd/con_amo3 - -! ... band indices - integer, dimension(nbands) :: nspa, nspb - - data nspa / 1, 1, 9, 9, 9, 1, 9, 1, 9, 1, 1, 9, 9, 1, 9, 9 / - data nspb / 1, 1, 5, 5, 5, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0 / - -! ... band wavenumber intervals -! real (kind=kind_phys) :: wavenum1(nbands), wavenum2(nbands) -! data wavenum1/ & -! & 10., 350., 500., 630., 700., 820., 980., 1080., & -!err & 1180., 1390., 1480., 1800., 2080., 2250., 2390., 2600. / -! & 1180., 1390., 1480., 1800., 2080., 2250., 2380., 2600. / -! data wavenum2/ & -! & 350., 500., 630., 700., 820., 980., 1080., 1180., & -!err & 1390., 1480., 1800., 2080., 2250., 2390., 2600., 3250. / -! & 1390., 1480., 1800., 2080., 2250., 2380., 2600., 3250. / -! real (kind=kind_phys) :: delwave(nbands) -! data delwave / 340., 150., 130., 70., 120., 160., 100., 100., & -! & 210., 90., 320., 280., 170., 130., 220., 650. / - -! --- reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 -! and 1.80) as a function of total column water vapor. the function -! has been defined to minimize flux and cooling rate errors in these bands -! over a wide range of precipitable water values. - real (kind=kind_phys), dimension(nbands) :: a0, a1, a2 - - data a0 / 1.66, 1.55, 1.58, 1.66, 1.54, 1.454, 1.89, 1.33, & - & 1.668, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66 / - data a1 / 0.00, 0.25, 0.22, 0.00, 0.13, 0.446, -0.10, 0.40, & - & -0.006, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / - data a2 / 0.00, -12.0, -11.7, 0.00, -0.72,-0.243, 0.19,-0.062, & - & 0.414, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / - -!! --- logical flags for optional output fields - - logical :: lhlwb = .false. - logical :: lhlw0 = .false. - logical :: lflxprf= .false. - -! --- those data will be set up only once by "rlwinit" - -! ... fluxfac, heatfac are factors for fluxes (in w/m**2) and heating -! rates (in k/day, or k/sec set by subroutine 'rlwinit') -! semiss0 are default surface emissivity for each bands - - real (kind=kind_phys) :: fluxfac, heatfac, semiss0(nbands) - data semiss0(:) / nbands*1.0 / - - real (kind=kind_phys) :: tau_tbl(0:ntbl) !< clr-sky opt dep (for cldy transfer) - real (kind=kind_phys) :: exp_tbl(0:ntbl) !< transmittance lookup table - real (kind=kind_phys) :: tfn_tbl(0:ntbl) !< tau transition function; i.e. the - !< transition of planck func from mean lyr - !< temp to lyr boundary temp as a func of - !< opt dep. "linear in tau" method is used. - -! --- the following variables are used for sub-column cloud scheme - - integer, parameter :: ipsdlw0 = ngptlw ! initial permutation seed - -! --- public accessable subprograms - - public rrtmg_lw_init, rrtmg_lw_run, rrtmg_lw_finalize, rlwinit - - -! ================ - contains -! ================ - - subroutine rrtmg_lw_init () - 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 -!! code from AER. -!! -!! The RRTM-LW package includes three files: -!! - radlw_param.f, which contains: -!! - module_radlw_parameters: band parameters set up -!! - radlw_datatb.f, which contains modules: -!! - module_radlw_avplank: plank flux data -!! - module_radlw_ref: reference temperature and pressure -!! - module_radlw_cldprlw: cloud property coefficients -!! - module_radlw_kgbnn: absorption coeffients for 16 bands, where nn = 01-16 -!! - radlw_main.f, which contains: -!! - rrtmg_lw_run(): the main LW radiation routine -!! - rlwinit(): the initialization routine -!! -!!\version NCEP LW v5.1 Nov 2012 -RRTMG-LW v4.82 -!! -!!\copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). -!! This software may be used, copied, or redistributed as long as it is -!! not sold and this copyright notice is reproduced on each copy made. -!! This model is provided as is without any express or implied warranties. -!! (http://www.rtweb.aer.com/) -!! \section arg_table_rrtmg_lw_run Argument Table -!! \htmlinclude rrtmg_lw_run.html -!! -!> \section gen_lwrad RRTMG Longwave Radiation Scheme General Algorithm -!> @{ - subroutine rrtmg_lw_run & - & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs - & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & - & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & - & icseed,aeraod,aerssa,sfemis,sfgtmp, & - & dzlyr,delpin,de_lgth, & - & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & - & hlwc,topflx,sfcflx,cldtau, & ! --- outputs - & HLW0,HLWB,FLXPRF, & ! --- optional - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, errmsg, errflg & - & ) - -! ==================== defination of variables ==================== ! -! ! -! input variables: ! -! plyr (npts,nlay) : layer mean pressures (mb) ! -! plvl (npts,nlp1) : interface pressures (mb) ! -! tlyr (npts,nlay) : layer mean temperature (k) ! -! tlvl (npts,nlp1) : interface temperatures (k) ! -! qlyr (npts,nlay) : layer specific humidity (gm/gm) *see inside ! -! olyr (npts,nlay) : layer ozone concentration (gm/gm) *see inside ! -! gasvmr(npts,nlay,:): atmospheric gases amount: ! -! (check module_radiation_gases for definition) ! -! gasvmr(:,:,1) - co2 volume mixing ratio ! -! gasvmr(:,:,2) - n2o volume mixing ratio ! -! gasvmr(:,:,3) - ch4 volume mixing ratio ! -! gasvmr(:,:,4) - o2 volume mixing ratio ! -! gasvmr(:,:,5) - co volume mixing ratio ! -! gasvmr(:,:,6) - cfc11 volume mixing ratio ! -! gasvmr(:,:,7) - cfc12 volume mixing ratio ! -! gasvmr(:,:,8) - cfc22 volume mixing ratio ! -! gasvmr(:,:,9) - ccl4 volume mixing ratio ! -! clouds(npts,nlay,:): layer cloud profiles: ! -! (check module_radiation_clouds for definition) ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer in-cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer in-cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path (g/m**2) ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! clouds(:,:,8) - layer snow flake water path (g/m**2) ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! icseed(npts) : auxiliary special cloud related array ! -! when module variable isubclw=2, it provides ! -! permutation seed for each column profile that ! -! are used for generating random numbers. ! -! when isubclw /=2, it will not be used. ! -! aerosols(npts,nlay,nbands,:) : aerosol optical properties ! -! (check module_radiation_aerosols for definition)! -! (:,:,:,1) - optical depth ! -! (:,:,:,2) - single scattering albedo ! -! (:,:,:,3) - asymmetry parameter ! -! sfemis (npts) : surface emissivity ! -! sfgtmp (npts) : surface ground temperature (k) ! -! dzlyr(npts,nlay) : layer thickness (km) ! -! delpin(npts,nlay): layer pressure thickness (mb) ! -! de_lgth(npts) : cloud decorrelation length (km) ! -! npts : total number of horizontal points ! -! nlay, nlp1 : total number of vertical layers, levels ! -! lprnt : cntl flag for diagnostic print out ! -! ! -! output variables: ! -! hlwc (npts,nlay): total sky heating rate (k/day or k/sec) ! -! topflx(npts) : radiation fluxes at top, component: ! -! (check module_radlw_paramters for definition) ! -! upfxc - total sky upward flux at top (w/m2) ! -! upfx0 - clear sky upward flux at top (w/m2) ! -! sfcflx(npts) : radiation fluxes at sfc, component: ! -! (check module_radlw_paramters for definition) ! -! upfxc - total sky upward flux at sfc (w/m2) ! -! upfx0 - clear sky upward flux at sfc (w/m2) ! -! dnfxc - total sky downward flux at sfc (w/m2) ! -! dnfx0 - clear sky downward flux at sfc (w/m2) ! -! cldtau(npts,nlay): approx 10mu band layer cloud optical depth ! -! ! -!! optional output variables: ! -! hlwb(npts,nlay,nbands): spectral band total sky heating rates ! -! hlw0 (npts,nlay): clear sky heating rate (k/day or k/sec) ! -! flxprf(npts,nlp1): level radiative fluxes (w/m2), components: ! -! (check module_radlw_paramters for definition) ! -! upfxc - total sky upward flux ! -! dnfxc - total sky dnward flux ! -! upfx0 - clear sky upward flux ! -! dnfx0 - clear sky dnward flux ! -! ! -! external module variables: (in physparam) ! -! ilwrgas - control flag for rare gases (ch4,n2o,o2,cfcs, etc.) ! -! =0: do not include rare gases ! -! >0: include all rare gases ! -! ilwcliq - control flag for liq-cloud optical properties ! -! =1: input cld liqp & reliq, hu & stamnes (1993) ! -! =2: not used ! -! ilwcice - control flag for ice-cloud optical properties ! -! =1: input cld icep & reice, ebert & curry (1997) ! -! =2: input cld icep & reice, streamer (1996) ! -! =3: input cld icep & reice, fu (1998) ! -! isubclw - sub-column cloud approximation control flag ! -! =0: no sub-col cld treatment, use grid-mean cld quantities ! -! =1: mcica sub-col, prescribed seeds to get random numbers ! -! =2: mcica sub-col, providing array icseed for random numbers! -! iovrlw - cloud overlapping control flag ! -! =0: random overlapping clouds ! -! =1: maximum/random overlapping clouds ! -! =2: maximum overlap cloud (used for isubclw>0 only) ! -! =3: decorrelation-length overlap (for isubclw>0 only) ! -! ivflip - control flag for vertical index direction ! -! =0: vertical index from toa to surface ! -! =1: vertical index from surface to toa ! -! ! -! module parameters, control variables: ! -! nbands - number of longwave spectral bands ! -! maxgas - maximum number of absorbing gaseous ! -! maxxsec - maximum number of cross-sections ! -! ngptlw - total number of g-point subintervals ! -! ng## - number of g-points in band (##=1-16) ! -! ngb(ngptlw) - band indices for each g-point ! -! bpade - pade approximation constant (1/0.278) ! -! nspa,nspb(nbands)- number of lower/upper ref atm's per band ! -! delwave(nbands) - longwave band width (wavenumbers) ! -! ipsdlw0 - permutation seed for mcica sub-col clds ! -! ! -! major local variables: ! -! pavel (nlay) - layer pressures (mb) ! -! delp (nlay) - layer pressure thickness (mb) ! -! tavel (nlay) - layer temperatures (k) ! -! tz (0:nlay) - level (interface) temperatures (k) ! -! semiss (nbands) - surface emissivity for each band ! -! wx (nlay,maxxsec) - cross-section molecules concentration ! -! coldry (nlay) - dry air column amount ! -! (1.e-20*molecules/cm**2) ! -! cldfrc (0:nlp1) - layer cloud fraction ! -! taucld (nbands,nlay) - layer cloud optical depth for each band ! -! cldfmc (ngptlw,nlay) - layer cloud fraction for each g-point ! -! tauaer (nbands,nlay) - aerosol optical depths ! -! fracs (ngptlw,nlay) - planck fractions ! -! tautot (ngptlw,nlay) - total optical depths (gaseous+aerosols) ! -! colamt (nlay,maxgas) - column amounts of absorbing gases ! -! 1-maxgas are for watervapor, carbon ! -! dioxide, ozone, nitrous oxide, methane, ! -! oxigen, carbon monoxide, respectively ! -! (molecules/cm**2) ! -! pwvcm - column precipitable water vapor (cm) ! -! secdiff(nbands) - variable diffusivity angle defined as ! -! an exponential function of the column ! -! water amount in bands 2-3 and 5-9. ! -! this reduces the bias of several w/m2 in ! -! downward surface flux in high water ! -! profiles caused by using the constant ! -! diffusivity angle of 1.66. (mji) ! -! facij (nlay) - indicator of interpolation factors ! -! =0/1: indicate lower/higher temp & height ! -! selffac(nlay) - scale factor for self-continuum, equals ! -! (w.v. density)/(atm density at 296K,1013 mb) ! -! selffrac(nlay) - factor for temp interpolation of ref ! -! self-continuum data ! -! indself(nlay) - index of the lower two appropriate ref ! -! temp for the self-continuum interpolation ! -! forfac (nlay) - scale factor for w.v. foreign-continuum ! -! forfrac(nlay) - factor for temp interpolation of ref ! -! w.v. foreign-continuum data ! -! indfor (nlay) - index of the lower two appropriate ref ! -! temp for the foreign-continuum interp ! -! laytrop - tropopause layer index at which switch is ! -! made from one conbination kew species to ! -! another. ! -! jp(nlay),jt(nlay),jt1(nlay) ! -! - lookup table indexes ! -! totuflux(0:nlay) - total-sky upward longwave flux (w/m2) ! -! totdflux(0:nlay) - total-sky downward longwave flux (w/m2) ! -! htr(nlay) - total-sky heating rate (k/day or k/sec) ! -! totuclfl(0:nlay) - clear-sky upward longwave flux (w/m2) ! -! totdclfl(0:nlay) - clear-sky downward longwave flux (w/m2) ! -! htrcl(nlay) - clear-sky heating rate (k/day or k/sec) ! -! fnet (0:nlay) - net longwave flux (w/m2) ! -! fnetc (0:nlay) - clear-sky net longwave flux (w/m2) ! -! ! -! ! -! ====================== end of definitions =================== ! - -! --- inputs: - integer, intent(in) :: npts, nlay, nlp1 - integer, intent(in) :: icseed(npts) - - logical, intent(in) :: lprnt - - real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: plvl, & - & tlvl - real (kind=kind_phys), dimension(npts,nlay), intent(in) :: plyr, & - & tlyr, qlyr, olyr, dzlyr, delpin - - real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2,& - & gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & - & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4 - - real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf - real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od - - real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & - & sfgtmp, de_lgth - - real (kind=kind_phys), dimension(npts,nlay,nbands),intent(in):: & - & aeraod, aerssa - -!mz* HWRF -- INPUT from mcica_subcol_lw - real(kind=kind_phys),dimension(ngptlw,npts,nlay) :: cldfmcl ! Cloud fraction - ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(in) :: ciwpmcl(:,:,:) ! In-cloud ice water path (g/m2) -! ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(in) :: clwpmcl(:,:,:) ! In-cloud liquid water path (g/m2) -! ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(in) :: cswpmcl(:,:,:) ! In-cloud snow water path (g/m2) -! ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(in) :: relqmcl(:,:) ! Cloud water drop effective radius (microns) -! ! Dimensions: (ncol,nlay) -! real(kind=rb), intent(in) :: reicmcl(:,:) ! Cloud ice effective size (microns) -! ! Dimensions: (ncol,nlay) -! real(kind=rb), intent(in) :: resnmcl(:,:) ! Snow effective size (microns) -! ! Dimensions: (ncol,nlay) -! real(kind=rb), intent(in) :: taucmcl(:,:,:) ! In-cloud optical depth -! ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(in) :: tauaer(:,:,:) ! Aerosol optical depth -! ! Dimensions: (ncol,nlay,nbndlw) - -!mz - -! --- outputs: - real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hlwc - real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & - & cldtau - - type (topflw_type), dimension(npts), intent(inout) :: topflx - type (sfcflw_type), dimension(npts), intent(inout) :: sfcflx - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -!! --- optional outputs: - real (kind=kind_phys), dimension(npts,nlay,nbands),optional, & - & intent(inout) :: hlwb - real (kind=kind_phys), dimension(npts,nlay), optional, & - & intent(inout) :: hlw0 - type (proflw_type), dimension(npts,nlp1), optional, & - & intent(inout) :: flxprf - logical, intent(in) :: lslwr - -! --- locals: -! mz* - Add height of each layer for exponential-random cloud overlap -! This will be derived below from the dzlyr in each layer - real (kind=kind_phys), dimension( npts,nlay ) :: hgt - real (kind=kind_phys):: dzsum - - real (kind=kind_phys), dimension(0:nlp1) :: cldfrc - - real (kind=kind_phys), dimension(0:nlay) :: totuflux, totdflux, & - & totuclfl, totdclfl, tz - - real (kind=kind_phys), dimension(nlay) :: htr, htrcl - - real (kind=kind_phys), dimension(nlay) :: pavel, tavel, delp, & - & clwp, ciwp, relw, reiw, cda1, cda2, cda3, cda4, & - & coldry, colbrd, h2ovmr, o3vmr, fac00, fac01, fac10, fac11, & - & selffac, selffrac, forfac, forfrac, minorfrac, scaleminor, & - & scaleminorn2, temcol, dz - - real (kind=kind_phys), dimension(nbands,0:nlay) :: pklev, pklay - - real (kind=kind_phys), dimension(nlay,nbands) :: htrb - real (kind=kind_phys), dimension(nbands,nlay) :: taucld, tauaer - real (kind=kind_phys), dimension(nbands,1,nlay) :: taucld3 - real (kind=kind_phys), dimension(ngptlw,nlay) :: fracs, tautot, & - & cldfmc - - real (kind=kind_phys), dimension(nbands) :: semiss, secdiff - -! --- column amount of absorbing gases: -! (:,m) m = 1-h2o, 2-co2, 3-o3, 4-n2o, 5-ch4, 6-o2, 7-co - real (kind=kind_phys) :: colamt(nlay,maxgas) - -! --- column cfc cross-section amounts: -! (:,m) m = 1-ccl4, 2-cfc11, 3-cfc12, 4-cfc22 - real (kind=kind_phys) :: wx(nlay,maxxsec) - -! --- reference ratios of binary species parameter in lower atmosphere: -! (:,m,:) m = 1-h2o/co2, 2-h2o/o3, 3-h2o/n2o, 4-h2o/ch4, 5-n2o/co2, 6-o3/co2 - real (kind=kind_phys) :: rfrate(nlay,nrates,2) - - real (kind=kind_phys) :: tem0, tem1, tem2, pwvcm, summol, stemp, & - & delgth - - integer, dimension(npts) :: ipseed - integer, dimension(nlay) :: jp, jt, jt1, indself, indfor, indminor - integer :: laytrop, iplon, i, j, k, k1 - ! mz* added local arrays for RRTMG - integer :: irng, permuteseed,ig - integer :: inflglw, iceflglw, liqflglw - logical :: lcf1 - -! -!===> ... begin here -! - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -!mz* -! For passing in cloud physical properties; cloud optics parameterized -! in RRTMG: - inflglw = 2 - iceflglw = 3 - liqflglw = 1 - -! - if (.not. lslwr) return - -! --- ... initialization - - lhlwb = present ( hlwb ) - lhlw0 = present ( hlw0 ) - lflxprf= present ( flxprf ) - - colamt(:,:) = f_zero - cldtau(:,:) = f_zero - -!! --- check for optional input arguments, depending on cloud method - if (ilwcliq > 0) then ! use prognostic cloud method - if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & - & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & - & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & - & .not.present(cld_swp) .or. .not.present(cld_ref_snow)) then - write(errmsg,'(*(a))') & - & 'Logic error: ilwcliq>0 requires the following', & - & ' optional arguments to be present:', & - & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & - & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' - errflg = 1 - return - end if - else ! use diagnostic cloud method - if ( .not.present(cld_od) ) then - write(errmsg,'(*(a))') & - & 'Logic error: ilwcliq<=0 requires the following', & - & ' optional argument to be present: cld_od' - errflg = 1 - return - end if - endif ! end if_ilwcliq - -!> -# Change random number seed value for each radiation invocation -!! (isubclw =1 or 2). - - if ( isubclw == 1 ) then ! advance prescribed permutation seed - do i = 1, npts - ipseed(i) = ipsdlw0 + i - enddo - elseif ( isubclw == 2 ) then ! use input array of permutaion seeds - do i = 1, npts - ipseed(i) = icseed(i) - enddo - endif - -! if ( lprnt ) then -! print *,' In rrtmg_lw, isubclw, ipsdlw0,ipseed =', & -! & isubclw, ipsdlw0, ipseed -! endif - -! --- ... loop over horizontal npts profiles - - lab_do_iplon : do iplon = 1, npts - -!> -# Read surface emissivity. - if (sfemis(iplon) > eps .and. sfemis(iplon) <= 1.0) then ! input surface emissivity - do j = 1, nbands - semiss(j) = sfemis(iplon) - enddo - else ! use default values - do j = 1, nbands - semiss(j) = semiss0(j) - enddo - endif - - stemp = sfgtmp(iplon) ! surface ground temp - if (iovrlw == 3) delgth= de_lgth(iplon) ! clouds decorr-length - -! mz*: HWRF practice - if (iovrlw == 4 ) then - - -!Add layer height needed for exponential (icld=4) and -! exponential-random (icld=5) overlap options - - !iplon = 1 - irng = 0 - permuteseed = 150 - -!mz* Derive height - dzsum =0.0 - do k = 1,nlay - hgt(iplon,k)= dzsum+0.5*dzlyr(iplon,k)*1000. !km->m - dzsum = dzsum+ dzlyr(iplon,k)*1000. - enddo - -! Zero out cloud optical properties here; not used when passing physical properties -! to radiation and taucld is calculated in radiation - do k = 1, nlay - do j = 1, nbands - taucld3(j,iplon,k) = 0.0 - enddo - enddo - - -! call mcica_subcol_lw(iplon, ncol, nlay, iovrlw, permuteseed, & -! & irng, play, hgt, & -! & cldfrac, ciwpth, clwpth, cswpth, rei, rel, res, & -! & taucld, & -! & cldfmcl, & !--output -! & ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, & -! & resnmcl, taucmcl) - -!mz* calculate cldfmcl for mcica first, *temporary - call mcica_subcol_lw(1, iplon, nlay, iovrlw, permuteseed, & - & irng, plyr, hgt, & - & cld_cf, cld_iwp, cld_lwp,cld_swp, & - & cld_ref_ice, cld_ref_liq, & - & cld_ref_snow, taucld3, & - & cldfmcl ) !--output - - endif -!mz* end - -!> -# Prepare atmospheric profile for use in rrtm. -! the vertical index of internal array is from surface to top - -! --- ... molecular amounts are input or converted to volume mixing ratio -! and later then converted to molecular amount (molec/cm2) by the -! dry air column coldry (in molec/cm2) which is calculated from the -! layer pressure thickness (in mb), based on the hydrostatic equation -! --- ... and includes a correction to account for h2o in the layer. - - if (ivflip == 0) then ! input from toa to sfc - - tem1 = 100.0 * con_g - tem2 = 1.0e-20 * 1.0e3 * con_avgd - tz(0) = tlvl(iplon,nlp1) - - do k = 1, nlay - k1 = nlp1 - k - pavel(k)= plyr(iplon,k1) - delp(k) = delpin(iplon,k1) - tavel(k)= tlyr(iplon,k1) - tz(k) = tlvl(iplon,k1) - dz(k) = dzlyr(iplon,k1) - -!> -# Set absorber amount for h2o, co2, and o3. - -!test use -! h2ovmr(k)= max(f_zero,qlyr(iplon,k1)*amdw) ! input mass mixing ratio -! h2ovmr(k)= max(f_zero,qlyr(iplon,k1)) ! input vol mixing ratio -! o3vmr (k)= max(f_zero,olyr(iplon,k1)) ! input vol mixing ratio -!ncep model use - h2ovmr(k)= max(f_zero,qlyr(iplon,k1) & - & *amdw/(f_one-qlyr(iplon,k1))) ! input specific humidity - o3vmr (k)= max(f_zero,olyr(iplon,k1)*amdo3) ! input mass mixing ratio - -! --- ... tem0 is the molecular weight of moist air - tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw - coldry(k) = tem2*delp(k) / (tem1*tem0*(f_one+h2ovmr(k))) - temcol(k) = 1.0e-12 * coldry(k) - - colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(iplon,k1)) ! co2 - colamt(k,3) = max(temcol(k), coldry(k)*o3vmr(k)) ! o3 - enddo - -!> -# Set up column amount for rare gases n2o,ch4,o2,co,ccl4,cf11,cf12, -!! cf22, convert from volume mixing ratio to molec/cm2 based on -!! coldry (scaled to 1.0e-20). - - if (ilwrgas > 0) then - do k = 1, nlay - k1 = nlp1 - k - colamt(k,4)=max(temcol(k), coldry(k)*gasvmr_n2o(iplon,k1)) ! n2o - colamt(k,5)=max(temcol(k), coldry(k)*gasvmr_ch4(iplon,k1)) ! ch4 - colamt(k,6)=max(f_zero, coldry(k)*gasvmr_o2(iplon,k1)) ! o2 - colamt(k,7)=max(f_zero, coldry(k)*gasvmr_co(iplon,k1)) ! co - - wx(k,1) = max( f_zero, coldry(k)*gasvmr_ccl4(iplon,k1) ) ! ccl4 - wx(k,2) = max( f_zero, coldry(k)*gasvmr_cfc11(iplon,k1) ) ! cf11 - wx(k,3) = max( f_zero, coldry(k)*gasvmr_cfc12(iplon,k1) ) ! cf12 - wx(k,4) = max( f_zero, coldry(k)*gasvmr_cfc22(iplon,k1) ) ! cf22 - enddo - else - do k = 1, nlay - colamt(k,4) = f_zero ! n2o - colamt(k,5) = f_zero ! ch4 - colamt(k,6) = f_zero ! o2 - colamt(k,7) = f_zero ! co - - wx(k,1) = f_zero - wx(k,2) = f_zero - wx(k,3) = f_zero - wx(k,4) = f_zero - enddo - endif - -!> -# Set aerosol optical properties. - - do k = 1, nlay - k1 = nlp1 - k - do j = 1, nbands - tauaer(j,k) = aeraod(iplon,k1,j) & - & * (f_one - aerssa(iplon,k1,j)) - enddo - enddo - -!> -# Read cloud optical properties. - if (ilwcliq > 0) then ! use prognostic cloud method -!mz: GFS operational - if (iovrlw .ne. 4 ) then - do k = 1, nlay - k1 = nlp1 - k - cldfrc(k)= cld_cf(iplon,k1) - clwp(k) = cld_lwp(iplon,k1) - relw(k) = cld_ref_liq(iplon,k1) - ciwp(k) = cld_iwp(iplon,k1) - reiw(k) = cld_ref_ice(iplon,k1) - !mz*: Limit upper bound of reice for Fu ice - !parameterization and convert from effective radius - !to generalized effective size (*1.0315; Fu, 1996) - if (iovrlw .eq. 4 .and. iceflglw.eq.3) then - reiw(k) = cld_ref_ice(iplon,k1) *1.0315 - reiw(k) = min(140.0, reiw(k)) - endif - cda1(k) = cld_rwp(iplon,k1) - cda2(k) = cld_ref_rain(iplon,k1) - cda3(k) = cld_swp(iplon,k1) - cda4(k) = cld_ref_snow(iplon,k1) - !mz - if (iovrlw .eq. 4 .and. inflglw .ne.5) then - cda3(k) = 0. - cda4(k) = 10. - endif - enddo - ! transfer - else if (iovrlw .eq. 4) then !mz HWRF - do k = 1, nlay - k1 = nlp1 - k - do ig = 1, ngptlw - cldfmc(ig,k) = cldfmcl(ig,iplon,k1) -!mz* not activate -! taucmc(ig,k) = taucmcl(ig,iplon,k1) -! ciwpmc(ig,k) = ciwpmcl(ig,iplon,k1) -! clwpmc(ig,k) = clwpmcl(ig,iplon,k1) -! cswpmc(ig,k) = cswpmcl(ig,iplon,k1) - enddo -! reicmc(k) = reicmcl(iplon,k1) -! relqmc(k) = relqmcl(iplon,k1) -! resnmc(k) = resnmcl(iplon,k1) - enddo - endif - else ! use diagnostic cloud method - do k = 1, nlay - k1 = nlp1 - k - cldfrc(k)= cld_cf(iplon,k1) - cda1(k) = cld_od(iplon,k1) - enddo - endif ! end if_ilwcliq - - cldfrc(0) = f_one ! padding value only - cldfrc(nlp1) = f_zero ! padding value only - -!> -# Compute precipitable water vapor for diffusivity angle adjustments. - - tem1 = f_zero - tem2 = f_zero - do k = 1, nlay - tem1 = tem1 + coldry(k) + colamt(k,1) - tem2 = tem2 + colamt(k,1) - enddo - - tem0 = 10.0 * tem2 / (amdw * tem1 * con_g) - pwvcm = tem0 * plvl(iplon,nlp1) - - else ! input from sfc to toa - - tem1 = 100.0 * con_g - tem2 = 1.0e-20 * 1.0e3 * con_avgd - tz(0) = tlvl(iplon,1) - - do k = 1, nlay - pavel(k)= plyr(iplon,k) - delp(k) = delpin(iplon,k) - tavel(k)= tlyr(iplon,k) - tz(k) = tlvl(iplon,k+1) - dz(k) = dzlyr(iplon,k) - -! --- ... set absorber amount -!test use -! h2ovmr(k)= max(f_zero,qlyr(iplon,k)*amdw) ! input mass mixing ratio -! h2ovmr(k)= max(f_zero,qlyr(iplon,k)) ! input vol mixing ratio -! o3vmr (k)= max(f_zero,olyr(iplon,k)) ! input vol mixing ratio -!ncep model use - h2ovmr(k)= max(f_zero,qlyr(iplon,k) & - & *amdw/(f_one-qlyr(iplon,k))) ! input specific humidity - o3vmr (k)= max(f_zero,olyr(iplon,k)*amdo3) ! input mass mixing ratio - -! --- ... tem0 is the molecular weight of moist air - tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw - coldry(k) = tem2*delp(k) / (tem1*tem0*(f_one+h2ovmr(k))) - temcol(k) = 1.0e-12 * coldry(k) - - colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(iplon,k))! co2 - colamt(k,3) = max(temcol(k), coldry(k)*o3vmr(k)) ! o3 - enddo - -! --- ... set up col amount for rare gases, convert from volume mixing ratio -! to molec/cm2 based on coldry (scaled to 1.0e-20) - - if (ilwrgas > 0) then - do k = 1, nlay - colamt(k,4)=max(temcol(k), coldry(k)*gasvmr_n2o(iplon,k)) ! n2o - colamt(k,5)=max(temcol(k), coldry(k)*gasvmr_ch4(iplon,k)) ! ch4 - colamt(k,6)=max(f_zero, coldry(k)*gasvmr_o2(iplon,k)) ! o2 - colamt(k,7)=max(f_zero, coldry(k)*gasvmr_co(iplon,k)) ! co - - wx(k,1) = max( f_zero, coldry(k)*gasvmr_ccl4(iplon,k) ) ! ccl4 - wx(k,2) = max( f_zero, coldry(k)*gasvmr_cfc11(iplon,k) ) ! cf11 - wx(k,3) = max( f_zero, coldry(k)*gasvmr_cfc12(iplon,k) ) ! cf12 - wx(k,4) = max( f_zero, coldry(k)*gasvmr_cfc22(iplon,k) ) ! cf22 - enddo - else - do k = 1, nlay - colamt(k,4) = f_zero ! n2o - colamt(k,5) = f_zero ! ch4 - colamt(k,6) = f_zero ! o2 - colamt(k,7) = f_zero ! co - - wx(k,1) = f_zero - wx(k,2) = f_zero - wx(k,3) = f_zero - wx(k,4) = f_zero - enddo - endif - -! --- ... set aerosol optical properties - - do j = 1, nbands - do k = 1, nlay - tauaer(j,k) = aeraod(iplon,k,j) & - & * (f_one - aerssa(iplon,k,j)) - enddo - enddo - - if (ilwcliq > 0) then ! use prognostic cloud method -!mz* - if (iovrlw .ne. 4) then - do k = 1, nlay - cldfrc(k)= cld_cf(iplon,k) - clwp(k) = cld_lwp(iplon,k) - relw(k) = cld_ref_liq(iplon,k) - ciwp(k) = cld_iwp(iplon,k) - reiw(k) = cld_ref_ice(iplon,k) - !mz*: Limit upper bound of reice for Fu ice - !parameterization and convert from effective radius - !to generalized effective size (*1.0315; Fu, 1996) - if (iovrlw .eq. 4 .and. iceflglw.eq.3) then - reiw(k) = cld_ref_ice(iplon,k1) *1.0315 - reiw(k) = min(140.0, reiw(k)) - endif - cda1(k) = cld_rwp(iplon,k) - cda2(k) = cld_ref_rain(iplon,k) - cda3(k) = cld_swp(iplon,k) - cda4(k) = cld_ref_snow(iplon,k) - !mz* - if (iovrlw .eq. 4 .and. inflglw .ne.5) then - cda3(k) = 0. - cda4(k) = 10. - endif - enddo - else if (iovrlw .eq. 4) then - do k = 1, nlay - do ig = 1, ngptlw - cldfmc(ig,k) = cldfmcl(ig,iplon,k) -! taucmc(ig,k) = taucmcl(ig,iplon,k) -! ciwpmc(ig,k) = ciwpmcl(ig,iplon,k) -! clwpmc(ig,k) = clwpmcl(ig,iplon,k) -! cswpmc(ig,k) = cswpmcl(ig,iplon,k) - enddo -! reicmc(k) = reicmcl(iplon,k) -! relqmc(k) = relqmcl(iplon,k) -! resnmc(k) = resnmcl(iplon,k) - enddo - endif - else ! use diagnostic cloud method - do k = 1, nlay - cldfrc(k)= cld_cf(iplon,k) - cda1(k) = cld_od(iplon,k) - enddo - endif ! end if_ilwcliq - - cldfrc(0) = f_one ! padding value only - cldfrc(nlp1) = f_zero ! padding value only - -! --- ... compute precipitable water vapor for diffusivity angle adjustments - - tem1 = f_zero - tem2 = f_zero - do k = 1, nlay - tem1 = tem1 + coldry(k) + colamt(k,1) - tem2 = tem2 + colamt(k,1) - enddo - - tem0 = 10.0 * tem2 / (amdw * tem1 * con_g) - pwvcm = tem0 * plvl(iplon,1) - - endif ! if_ivflip - -!> -# Compute column amount for broadening gases. - - do k = 1, nlay - summol = f_zero - do i = 2, maxgas - summol = summol + colamt(k,i) - enddo - colbrd(k) = coldry(k) - summol - enddo - -!> -# Compute diffusivity angle adjustments. - - tem1 = 1.80 - tem2 = 1.50 - do j = 1, nbands - if (j==1 .or. j==4 .or. j==10) then - secdiff(j) = 1.66 - else - secdiff(j) = min( tem1, max( tem2, & - & a0(j)+a1(j)*exp(a2(j)*pwvcm) )) - endif - enddo - -! if (lprnt) then -! print *,' coldry',coldry -! print *,' wx(*,1) ',(wx(k,1),k=1,NLAY) -! print *,' wx(*,2) ',(wx(k,2),k=1,NLAY) -! print *,' wx(*,3) ',(wx(k,3),k=1,NLAY) -! print *,' wx(*,4) ',(wx(k,4),k=1,NLAY) -! print *,' iplon ',iplon -! print *,' pavel ',pavel -! print *,' delp ',delp -! print *,' tavel ',tavel -! print *,' tz ',tz -! print *,' h2ovmr ',h2ovmr -! print *,' o3vmr ',o3vmr -! endif - -!> -# For cloudy atmosphere, call cldprop() to set cloud optical -!! properties. - -!mz* - if (iovrlw .ne. 4 ) then !mz:GFS oprational - - lcf1 = .false. - lab_do_k0 : do k = 1, nlay - if ( cldfrc(k) > eps ) then - lcf1 = .true. - exit lab_do_k0 - endif - enddo lab_do_k0 - - if ( lcf1 ) then - - call cldprop & -! --- inputs: - & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & nlay, nlp1, ipseed(iplon), dz, delgth, & -! --- outputs: - & cldfmc, taucld & - & ) - -! --- ... save computed layer cloud optical depth for output -! rrtm band-7 is apprx 10mu channel (or use spectral mean of bands 6-8) - - if (ivflip == 0) then ! input from toa to sfc - do k = 1, nlay - k1 = nlp1 - k - cldtau(iplon,k1) = taucld( 7,k) - enddo - else ! input from sfc to toa - do k = 1, nlay - cldtau(iplon,k) = taucld( 7,k) - enddo - endif ! end if_ivflip_block - - else - cldfmc = f_zero - taucld = f_zero - endif - endif !mz iovrlw.ne.4 - -! else if (iovrlw .eq. 4) then !mz*:HWRF for cldovrlp=4 - -!mz* call CLDPRMC to set cloud optical depth for McICA based on input cloud -! properties (inflglw) - -! For cloudy atmosphere, use cldprop to set cloud optical properties based on -! input cloud physical properties. Select method based on choices described -! in cldprop. Cloud fraction, water path, liquid droplet and ice particle -! effective radius must be passed into cldprop. Cloud fraction and cloud -! optical depth are transferred to rrtmg_lw arrays in cldprop. -! -! ncbands(im): number of cloud spectral bands -! taucmc(ngptlw,nlayers): cloud optical depth [mcica] - -! call cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, ciwpmc,& -! clwpmc, cswpmc, reicmc, relqmc, resnmc, & -! ncbands, taucmc) - - -! if (lprnt) then -! print *,' after cldprop' -! print *,' clwp',clwp -! print *,' ciwp',ciwp -! print *,' relw',relw -! print *,' reiw',reiw -! print *,' taucl',cda1 -! print *,' cldfrac',cldfrc -! endif - -!> -# Calling setcoef() to compute various coefficients needed in -!! radiative transfer calculations. - call setcoef & -! --- inputs: - & ( pavel,tavel,tz,stemp,h2ovmr,colamt,coldry,colbrd, & - & nlay, nlp1, & -! --- outputs: - & laytrop,pklay,pklev,jp,jt,jt1, & - & rfrate,fac00,fac01,fac10,fac11, & - & selffac,selffrac,indself,forfac,forfrac,indfor, & - & minorfrac,scaleminor,scaleminorn2,indminor & - & ) - -! if (lprnt) then -! print *,'laytrop',laytrop -! print *,'colh2o',(colamt(k,1),k=1,NLAY) -! print *,'colco2',(colamt(k,2),k=1,NLAY) -! print *,'colo3', (colamt(k,3),k=1,NLAY) -! print *,'coln2o',(colamt(k,4),k=1,NLAY) -! print *,'colch4',(colamt(k,5),k=1,NLAY) -! print *,'fac00',fac00 -! print *,'fac01',fac01 -! print *,'fac10',fac10 -! print *,'fac11',fac11 -! print *,'jp',jp -! print *,'jt',jt -! print *,'jt1',jt1 -! print *,'selffac',selffac -! print *,'selffrac',selffrac -! print *,'indself',indself -! print *,'forfac',forfac -! print *,'forfrac',forfrac -! print *,'indfor',indfor -! endif - -!> -# Call taumol() to calculte the gaseous optical depths and Plank -!! fractions for each longwave spectral band. - - call taumol & -! --- inputs: - & ( laytrop,pavel,coldry,colamt,colbrd,wx,tauaer, & - & rfrate,fac00,fac01,fac10,fac11,jp,jt,jt1, & - & selffac,selffrac,indself,forfac,forfrac,indfor, & - & minorfrac,scaleminor,scaleminorn2,indminor, & - & nlay, & -! --- outputs: - & fracs, tautot & - & ) - -! if (lprnt) then -! print *,' after taumol' -! do k = 1, nlay -! write(6,121) k -!121 format(' k =',i3,5x,'FRACS') -! write(6,122) (fracs(j,k),j=1,ngptlw) -!122 format(10e14.7) -! write(6,123) k -!123 format(' k =',i3,5x,'TAUTOT') -! write(6,122) (tautot(j,k),j=1,ngptlw) -! enddo -! endif - -!> -# Call the radiative transfer routine based on cloud scheme -!! selection. Compute the upward/downward radiative fluxes, and -!! heating rates for both clear or cloudy atmosphere. -!!\n - call rtrn(): clouds are assumed as randomly overlaping in a -!! vertical column -!!\n - call rtrnmr(): clouds are assumed as in maximum-randomly -!! overlaping in a vertical column; -!!\n - call rtrnmc(): clouds are treated with the mcica stochastic -!! approach. - - if (isubclw <= 0) then - - if (iovrlw <= 0) then - - call rtrn & -! --- inputs: - & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, & - & fracs,secdiff,nlay,nlp1, & -! --- outputs: - & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & - & ) - - else - - call rtrnmr & -! --- inputs: - & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, & - & fracs,secdiff,nlay,nlp1, & -! --- outputs: - & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & - & ) - - endif ! end if_iovrlw_block - - else - - call rtrnmc & -! --- inputs: - & ( semiss,delp,cldfmc,taucld,tautot,pklay,pklev, & - & fracs,secdiff,nlay,nlp1, & -! --- outputs: - & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & - & ) - - endif ! end if_isubclw_block - -!> -# Save outputs. - - topflx(iplon)%upfxc = totuflux(nlay) - topflx(iplon)%upfx0 = totuclfl(nlay) - - sfcflx(iplon)%upfxc = totuflux(0) - sfcflx(iplon)%upfx0 = totuclfl(0) - sfcflx(iplon)%dnfxc = totdflux(0) - sfcflx(iplon)%dnfx0 = totdclfl(0) - - if (ivflip == 0) then ! output from toa to sfc - -!! --- ... optional fluxes - if ( lflxprf ) then - do k = 0, nlay - k1 = nlp1 - k - flxprf(iplon,k1)%upfxc = totuflux(k) - flxprf(iplon,k1)%dnfxc = totdflux(k) - flxprf(iplon,k1)%upfx0 = totuclfl(k) - flxprf(iplon,k1)%dnfx0 = totdclfl(k) - enddo - endif - - do k = 1, nlay - k1 = nlp1 - k - hlwc(iplon,k1) = htr(k) - enddo - -!! --- ... optional clear sky heating rate - if ( lhlw0 ) then - do k = 1, nlay - k1 = nlp1 - k - hlw0(iplon,k1) = htrcl(k) - enddo - endif - -!! --- ... optional spectral band heating rate - if ( lhlwb ) then - do j = 1, nbands - do k = 1, nlay - k1 = nlp1 - k - hlwb(iplon,k1,j) = htrb(k,j) - enddo - enddo - endif - - else ! output from sfc to toa - -!! --- ... optional fluxes - if ( lflxprf ) then - do k = 0, nlay - flxprf(iplon,k+1)%upfxc = totuflux(k) - flxprf(iplon,k+1)%dnfxc = totdflux(k) - flxprf(iplon,k+1)%upfx0 = totuclfl(k) - flxprf(iplon,k+1)%dnfx0 = totdclfl(k) - enddo - endif - - do k = 1, nlay - hlwc(iplon,k) = htr(k) - enddo - -!! --- ... optional clear sky heating rate - if ( lhlw0 ) then - do k = 1, nlay - hlw0(iplon,k) = htrcl(k) - enddo - endif - -!! --- ... optional spectral band heating rate - if ( lhlwb ) then - do j = 1, nbands - do k = 1, nlay - hlwb(iplon,k,j) = htrb(k,j) - enddo - enddo - endif - - endif ! if_ivflip - - enddo lab_do_iplon - -!................................... - end subroutine rrtmg_lw_run -!----------------------------------- -!> @} - subroutine rrtmg_lw_finalize () - end subroutine rrtmg_lw_finalize - - - -!> \ingroup module_radlw_main -!> \brief This subroutine performs calculations necessary for the initialization -!! of the longwave model, which includes non-varying model variables, conversion -!! factors, and look-up tables -!! -!! Lookup tables are computed for use in the lw -!! radiative transfer, and input absorption coefficient data for each -!! spectral band are reduced from 256 g-point intervals to 140. -!!\param me print control for parallel process -!!\section rlwinit_gen rlwinit General Algorithm -!! @{ - subroutine rlwinit & - & ( me ) ! --- inputs -! --- outputs: (none) - -! =================== program usage description =================== ! -! ! -! purpose: initialize non-varying module variables, conversion factors,! -! and look-up tables. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: ! -! me - print control for parallel process ! -! ! -! outputs: (none) ! -! ! -! external module variables: (in physparam) ! -! ilwrate - heating rate unit selections ! -! =1: output in k/day ! -! =2: output in k/second ! -! ilwrgas - control flag for rare gases (ch4,n2o,o2,cfcs, etc.) ! -! =0: do not include rare gases ! -! >0: include all rare gases ! -! ilwcliq - liquid cloud optical properties contrl flag ! -! =0: input cloud opt depth from diagnostic scheme ! -! >0: input cwp,rew, and other cloud content parameters ! -! isubclw - sub-column cloud approximation control flag ! -! =0: no sub-col cld treatment, use grid-mean cld quantities ! -! =1: mcica sub-col, prescribed seeds to get random numbers ! -! =2: mcica sub-col, providing array icseed for random numbers! -! icldflg - cloud scheme control flag ! -! =0: diagnostic scheme gives cloud tau, omiga, and g. ! -! =1: prognostic scheme gives cloud liq/ice path, etc. ! -! iovrlw - clouds vertical overlapping control flag ! -! =0: random overlapping clouds ! -! =1: maximum/random overlapping clouds ! -! =2: maximum overlap cloud (isubcol>0 only) ! -! =3: decorrelation-length overlap (for isubclw>0 only) ! -! ! -! ******************************************************************* ! -! original code description ! -! ! -! original version: michael j. iacono; july, 1998 ! -! first revision for ncar ccm: september, 1998 ! -! second revision for rrtm_v3.0: september, 2002 ! -! ! -! this subroutine performs calculations necessary for the initialization -! of the longwave model. lookup tables are computed for use in the lw ! -! radiative transfer, and input absorption coefficient data for each ! -! spectral band are reduced from 256 g-point intervals to 140. ! -! ! -! ******************************************************************* ! -! ! -! definitions: ! -! arrays for 10000-point look-up tables: ! -! tau_tbl - clear-sky optical depth (used in cloudy radiative transfer! -! exp_tbl - exponential lookup table for tansmittance ! -! tfn_tbl - tau transition function; i.e. the transition of the Planck! -! function from that for the mean layer temperature to that ! -! for the layer boundary temperature as a function of optical -! depth. the "linear in tau" method is used to make the table -! ! -! ******************************************************************* ! -! ! -! ====================== end of description block ================= ! - -! --- inputs: - integer, intent(in) :: me - -! --- outputs: none - -! --- locals: - real (kind=kind_phys), parameter :: expeps = 1.e-20 - - real (kind=kind_phys) :: tfn, pival, explimit - - integer :: i - -! -!===> ... begin here -! - if ( iovrlw<0 .or. iovrlw>4 ) then - print *,' *** Error in specification of cloud overlap flag', & - & ' IOVRLW=',iovrlw,' in RLWINIT !!' - stop -!mz -! elseif ( iovrlw>=2 .and. isubclw==0 ) then - elseif ( (iovrlw.eq.2 .or. iovrlw.eq.3).and. isubclw==0 ) then - if (me == 0) then - print *,' *** IOVRLW=',iovrlw,' is not available for', & - & ' ISUBCLW=0 setting!!' - print *,' The program uses maximum/random overlap', & - & ' instead.' - endif - - iovrlw = 1 - endif - - if (me == 0) then - print *,' - Using AER Longwave Radiation, Version: ', VTAGLW - - if (ilwrgas > 0) then - print *,' --- Include rare gases N2O, CH4, O2, CFCs ', & - & 'absorptions in LW' - else - print *,' --- Rare gases effect is NOT included in LW' - endif - - if ( isubclw == 0 ) then - print *,' --- Using standard grid average clouds, no ', & - & 'sub-column clouds approximation applied' - elseif ( isubclw == 1 ) then - print *,' --- Using MCICA sub-colum clouds approximation ', & - & 'with a prescribed sequence of permutaion seeds' - elseif ( isubclw == 2 ) then - print *,' --- Using MCICA sub-colum clouds approximation ', & - & 'with provided input array of permutation seeds' - else - print *,' *** Error in specification of sub-column cloud ', & - & ' control flag isubclw =',isubclw,' !!' - stop - endif - endif - -!> -# Check cloud flags for consistency. - - if ((icldflg == 0 .and. ilwcliq /= 0) .or. & - & (icldflg == 1 .and. ilwcliq == 0)) then - print *,' *** Model cloud scheme inconsistent with LW', & - & ' radiation cloud radiative property setup !!' - stop - endif - -!> -# Setup default surface emissivity for each band. - - semiss0(:) = f_one - -!> -# Setup constant factors for flux and heating rate -!! the 1.0e-2 is to convert pressure from mb to \f$N/m^2\f$. - - pival = 2.0 * asin(f_one) - fluxfac = pival * 2.0d4 -! fluxfac = 62831.85307179586 ! = 2 * pi * 1.0e4 - - if (ilwrate == 1) then -! heatfac = 8.4391 -! heatfac = con_g * 86400. * 1.0e-2 / con_cp ! (in k/day) - heatfac = con_g * 864.0 / con_cp ! (in k/day) - else - heatfac = con_g * 1.0e-2 / con_cp ! (in k/second) - endif - -!> -# Compute lookup tables for transmittance, tau transition -!! function, and clear sky tau (for the cloudy sky radiative -!! transfer). tau is computed as a function of the tau -!! transition function, transmittance is calculated as a -!! function of tau, and the tau transition function is -!! calculated using the linear in tau formulation at values of -!! tau above 0.01. tf is approximated as tau/6 for tau < 0.01. -!! all tables are computed at intervals of 0.001. the inverse -!! of the constant used in the pade approximation to the tau -!! transition function is set to b. - - tau_tbl(0) = f_zero - exp_tbl(0) = f_one - tfn_tbl(0) = f_zero - - tau_tbl(ntbl) = 1.e10 - exp_tbl(ntbl) = expeps - tfn_tbl(ntbl) = f_one - - explimit = aint( -log(tiny(exp_tbl(0))) ) - - do i = 1, ntbl-1 -!org tfn = float(i) / float(ntbl) -!org tau_tbl(i) = bpade * tfn / (f_one - tfn) - tfn = real(i, kind_phys) / real(ntbl-i, kind_phys) - tau_tbl(i) = bpade * tfn - if (tau_tbl(i) >= explimit) then - exp_tbl(i) = expeps - else - exp_tbl(i) = exp( -tau_tbl(i) ) - endif - - if (tau_tbl(i) < 0.06) then - tfn_tbl(i) = tau_tbl(i) / 6.0 - else - tfn_tbl(i) = f_one - 2.0*( (f_one / tau_tbl(i)) & - & - ( exp_tbl(i) / (f_one - exp_tbl(i)) ) ) - endif - enddo - -!................................... - end subroutine rlwinit -!! @} -!----------------------------------- - - -!>\ingroup module_radlw_main -!> \brief This subroutine computes the cloud optical depth(s) for each cloudy -!! layer and g-point interval. -!!\param cfrac layer cloud fraction -!!\n --- for ilwcliq > 0 (prognostic cloud scheme) - - - -!!\param cliqp layer in-cloud liq water path (\f$g/m^2\f$) -!!\param reliq mean eff radius for liq cloud (micron) -!!\param cicep layer in-cloud ice water path (\f$g/m^2\f$) -!!\param reice mean eff radius for ice cloud (micron) -!!\param cdat1 layer rain drop water path (\f$g/m^2\f$) -!!\param cdat2 effective radius for rain drop (micron) -!!\param cdat3 layer snow flake water path(\f$g/m^2\f$) -!!\param cdat4 mean effective radius for snow flake(micron) -!!\n --- for ilwcliq = 0 (diagnostic cloud scheme) - - - -!!\param cliqp not used -!!\param cicep not used -!!\param reliq not used -!!\param reice not used -!!\param cdat1 layer cloud optical depth -!!\param cdat2 layer cloud single scattering albedo -!!\param cdat3 layer cloud asymmetry factor -!!\param cdat4 optional use -!!\param nlay number of layer number -!!\param nlp1 number of veritcal levels -!!\param ipseed permutation seed for generating random numbers (isubclw>0) -!!\param dz layer thickness (km) -!!\param de_lgth layer cloud decorrelation length (km) -!!\param cldfmc cloud fraction for each sub-column -!!\param taucld cloud optical depth for bands (non-mcica) -!!\section gen_cldprop cldprop General Algorithm -!> @{ - subroutine cldprop & - & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & nlay, nlp1, ipseed, dz, de_lgth, & - & cldfmc, taucld & ! --- outputs - & ) - -! =================== program usage description =================== ! -! ! -! purpose: compute the cloud optical depth(s) for each cloudy layer ! -! and g-point interval. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -size- ! -! cfrac - real, layer cloud fraction 0:nlp1 ! -! ..... for ilwcliq > 0 (prognostic cloud sckeme) - - - ! -! cliqp - real, layer in-cloud liq water path (g/m**2) nlay ! -! reliq - real, mean eff radius for liq cloud (micron) nlay ! -! cicep - real, layer in-cloud ice water path (g/m**2) nlay ! -! reice - real, mean eff radius for ice cloud (micron) nlay ! -! cdat1 - real, layer rain drop water path (g/m**2) nlay ! -! cdat2 - real, effective radius for rain drop (microm) nlay ! -! cdat3 - real, layer snow flake water path (g/m**2) nlay ! -! cdat4 - real, effective radius for snow flakes (micron) nlay ! -! ..... for ilwcliq = 0 (diagnostic cloud sckeme) - - - ! -! cdat1 - real, input cloud optical depth nlay ! -! cdat2 - real, layer cloud single scattering albedo nlay ! -! cdat3 - real, layer cloud asymmetry factor nlay ! -! cdat4 - real, optional use nlay ! -! cliqp - not used nlay ! -! reliq - not used nlay ! -! cicep - not used nlay ! -! reice - not used nlay ! -! ! -! dz - real, layer thickness (km) nlay ! -! de_lgth- real, layer cloud decorrelation length (km) 1 ! -! nlay - integer, number of vertical layers 1 ! -! nlp1 - integer, number of vertical levels 1 ! -! ipseed- permutation seed for generating random numbers (isubclw>0) ! -! ! -! outputs: ! -! cldfmc - real, cloud fraction for each sub-column ngptlw*nlay! -! taucld - real, cld opt depth for bands (non-mcica) nbands*nlay! -! ! -! explanation of the method for each value of ilwcliq, and ilwcice. ! -! set up in module "module_radlw_cntr_para" ! -! ! -! ilwcliq=0 : input cloud optical property (tau, ssa, asy). ! -! (used for diagnostic cloud method) ! -! ilwcliq>0 : input cloud liq/ice path and effective radius, also ! -! require the user of 'ilwcice' to specify the method ! -! used to compute aborption due to water/ice parts. ! -! ................................................................... ! -! ! -! ilwcliq=1: the water droplet effective radius (microns) is input! -! and the opt depths due to water clouds are computed ! -! as in hu and stamnes, j., clim., 6, 728-742, (1993). ! -! the values for absorption coefficients appropriate for -! the spectral bands in rrtm have been obtained for a ! -! range of effective radii by an averaging procedure ! -! based on the work of j. pinto (private communication). -! linear interpolation is used to get the absorption ! -! coefficients for the input effective radius. ! -! ! -! ilwcice=1: the cloud ice path (g/m2) and ice effective radius ! -! (microns) are input and the optical depths due to ice! -! clouds are computed as in ebert and curry, jgr, 97, ! -! 3831-3836 (1992). the spectral regions in this work ! -! have been matched with the spectral bands in rrtm to ! -! as great an extent as possible: ! -! e&c 1 ib = 5 rrtm bands 9-16 ! -! e&c 2 ib = 4 rrtm bands 6-8 ! -! e&c 3 ib = 3 rrtm bands 3-5 ! -! e&c 4 ib = 2 rrtm band 2 ! -! e&c 5 ib = 1 rrtm band 1 ! -! ilwcice=2: the cloud ice path (g/m2) and ice effective radius ! -! (microns) are input and the optical depths due to ice! -! clouds are computed as in rt code, streamer v3.0 ! -! (ref: key j., streamer user's guide, cooperative ! -! institute for meteorological satellite studies, 2001,! -! 96 pp.) valid range of values for re are between 5.0 ! -! and 131.0 micron. ! -! ilwcice=3: the ice generalized effective size (dge) is input and! -! the optical properties, are calculated as in q. fu, ! -! j. climate, (1998). q. fu provided high resolution ! -! tales which were appropriately averaged for the bands! -! in rrtm_lw. linear interpolation is used to get the ! -! coeff from the stored tables. valid range of values ! -! for deg are between 5.0 and 140.0 micron. ! -! ! -! other cloud control module variables: ! -! isubclw =0: standard cloud scheme, no sub-col cloud approximation ! -! >0: mcica sub-col cloud scheme using ipseed as permutation! -! seed for generating rundom numbers ! -! ! -! ====================== end of description block ================= ! -! - use module_radlw_cldprlw - -! --- inputs: - integer, intent(in) :: nlay, nlp1, ipseed - - real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac - real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & - & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz - real (kind=kind_phys), intent(in) :: de_lgth - -! --- outputs: - real (kind=kind_phys), dimension(ngptlw,nlay),intent(out):: cldfmc - real (kind=kind_phys), dimension(nbands,nlay),intent(out):: taucld - -! --- locals: - real (kind=kind_phys), dimension(nbands) :: tauliq, tauice - real (kind=kind_phys), dimension(nlay) :: cldf - - real (kind=kind_phys) :: dgeice, factor, fint, tauran, tausnw, & - & cldliq, refliq, cldice, refice - - logical :: lcloudy(ngptlw,nlay) - integer :: ia, ib, ig, k, index - -! -!===> ... begin here -! - do k = 1, nlay - do ib = 1, nbands - taucld(ib,k) = f_zero - enddo - enddo - - do k = 1, nlay - do ig = 1, ngptlw - cldfmc(ig,k) = f_zero - enddo - enddo - -!> -# Compute cloud radiative properties for a cloudy column: -!!\n - Compute cloud radiative properties for rain and snow (tauran,tausnw) -!!\n - Calculation of absorption coefficients due to water clouds(tauliq) -!!\n - Calculation of absorption coefficients due to ice clouds (tauice). -!!\n - For prognostic cloud scheme: sum up the cloud optical property: -!!\n \f$ taucld=tauice+tauliq+tauran+tausnw \f$ - -! --- ... compute cloud radiative properties for a cloudy column - - lab_if_ilwcliq : if (ilwcliq > 0) then - - lab_do_k : do k = 1, nlay - lab_if_cld : if (cfrac(k) > cldmin) then - - tauran = absrain * cdat1(k) ! ncar formula -!! tausnw = abssnow1 * cdat3(k) ! ncar formula -! --- if use fu's formula it needs to be normalized by snow density -! !not use snow density = 0.1 g/cm**3 = 0.1 g/(mu * m**2) -! use ice density = 0.9167 g/cm**3 = 0.9167 g/(mu * m**2) -! factor 1.5396=8/(3*sqrt(3)) converts reff to generalized ice particle size -! use newer factor value 1.0315 -! 1/(0.9167*1.0315) = 1.05756 - if (cdat3(k)>f_zero .and. cdat4(k)>10.0_kind_phys) then - tausnw = abssnow0*1.05756*cdat3(k)/cdat4(k) ! fu's formula - else - tausnw = f_zero - endif - - cldliq = cliqp(k) - cldice = cicep(k) -! refliq = max(2.5e0, min(60.0e0, reliq(k) )) -! refice = max(5.0e0, reice(k) ) - refliq = reliq(k) - refice = reice(k) - -! --- ... calculation of absorption coefficients due to water clouds. - - if ( cldliq <= f_zero ) then - do ib = 1, nbands - tauliq(ib) = f_zero - enddo - else - if ( ilwcliq == 1 ) then - - factor = refliq - 1.5 - index = max( 1, min( 57, int( factor ) )) - fint = factor - float(index) - - do ib = 1, nbands - tauliq(ib) = max(f_zero, cldliq*(absliq1(index,ib) & - & + fint*(absliq1(index+1,ib)-absliq1(index,ib)) )) - enddo - endif ! end if_ilwcliq_block - endif ! end if_cldliq_block - -! --- ... calculation of absorption coefficients due to ice clouds. - - if ( cldice <= f_zero ) then - do ib = 1, nbands - tauice(ib) = f_zero - enddo - else - -! --- ... ebert and curry approach for all particle sizes though somewhat -! unjustified for large ice particles - - if ( ilwcice == 1 ) then - refice = min(130.0, max(13.0, real(refice) )) - - do ib = 1, nbands - ia = ipat(ib) ! eb_&_c band index for ice cloud coeff - tauice(ib) = max(f_zero, cldice*(absice1(1,ia) & - & + absice1(2,ia)/refice) ) - enddo - -! --- ... streamer approach for ice effective radius between 5.0 and 131.0 microns -! and ebert and curry approach for ice eff radius greater than 131.0 microns. -! no smoothing between the transition of the two methods. - - elseif ( ilwcice == 2 ) then - - factor = (refice - 2.0) / 3.0 - index = max( 1, min( 42, int( factor ) )) - fint = factor - float(index) - - do ib = 1, nbands - tauice(ib) = max(f_zero, cldice*(absice2(index,ib) & - & + fint*(absice2(index+1,ib) - absice2(index,ib)) )) - enddo - -! --- ... fu's approach for ice effective radius between 4.8 and 135 microns -! (generalized effective size from 5 to 140 microns) - - elseif ( ilwcice == 3 ) then - -! dgeice = max(5.0, 1.5396*refice) ! v4.4 value - dgeice = max(5.0, 1.0315*refice) ! v4.71 value - factor = (dgeice - 2.0) / 3.0 - index = max( 1, min( 45, int( factor ) )) - fint = factor - float(index) - - do ib = 1, nbands - tauice(ib) = max(f_zero, cldice*(absice3(index,ib) & - & + fint*(absice3(index+1,ib) - absice3(index,ib)) )) - enddo - - endif ! end if_ilwcice_block - endif ! end if_cldice_block - - do ib = 1, nbands - taucld(ib,k) = tauice(ib) + tauliq(ib) + tauran + tausnw - enddo - - endif lab_if_cld - enddo lab_do_k - - else lab_if_ilwcliq - - do k = 1, nlay - if (cfrac(k) > cldmin) then - do ib = 1, nbands - taucld(ib,k) = cdat1(k) - enddo - endif - enddo - - endif lab_if_ilwcliq - -!> -# if physparam::isubclw > 0, call mcica_subcol() to distribute -!! cloud properties to each g-point. - - if ( isubclw > 0 ) then ! mcica sub-col clouds approx - do k = 1, nlay - if ( cfrac(k) < cldmin ) then - cldf(k) = f_zero - else - cldf(k) = cfrac(k) - endif - enddo - -! --- ... call sub-column cloud generator - - call mcica_subcol & -! --- inputs: - & ( cldf, nlay, ipseed, dz, de_lgth, & -! --- output: - & lcloudy & - & ) - - do k = 1, nlay - do ig = 1, ngptlw - if ( lcloudy(ig,k) ) then - cldfmc(ig,k) = f_one - else - cldfmc(ig,k) = f_zero - endif - enddo - enddo - - endif ! end if_isubclw_block - - return -! .................................. - end subroutine cldprop -! ---------------------------------- -!> @} - -!>\ingroup module_radlw_main -!>\brief This suroutine computes sub-colum cloud profile flag array. -!!\param cldf layer cloud fraction -!!\param nlay number of model vertical layers -!!\param ipseed permute seed for random num generator -!!\param dz layer thickness -!!\param de_lgth layer cloud decorrelation length (km) -!!\param lcloudy sub-colum cloud profile flag array -!!\section mcica_subcol_gen mcica_subcol General Algorithm -!! @{ - subroutine mcica_subcol & - & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs - & lcloudy & ! --- outputs - & ) - -! ==================== defination of variables ==================== ! -! ! -! input variables: size ! -! cldf - real, layer cloud fraction nlay ! -! nlay - integer, number of model vertical layers 1 ! -! ipseed - integer, permute seed for random num generator 1 ! -! ** note : if the cloud generator is called multiple times, need ! -! to permute the seed between each call; if between calls ! -! for lw and sw, use values differ by the number of g-pts. ! -! dz - real, layer thickness (km) nlay ! -! de_lgth - real, layer cloud decorrelation length (km) 1 ! -! ! -! output variables: ! -! lcloudy - logical, sub-colum cloud profile flag array ngptlw*nlay! -! ! -! other control flags from module variables: ! -! iovrlw : control flag for cloud overlapping method ! -! =0:random; =1:maximum/random: =2:maximum; =3:decorr ! -! ! -! ===================== end of definitions ==================== ! - - implicit none - -! --- inputs: - integer, intent(in) :: nlay, ipseed - - real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz - real (kind=kind_phys), intent(in) :: de_lgth - -! --- outputs: - logical, dimension(ngptlw,nlay), intent(out) :: lcloudy - -! --- locals: - real (kind=kind_phys) :: cdfunc(ngptlw,nlay), rand1d(ngptlw), & - & rand2d(nlay*ngptlw), tem1, fac_lcf(nlay), & - & cdfun2(ngptlw,nlay) - - type (random_stat) :: stat ! for thread safe random generator - - integer :: k, n, k1 -! -!===> ... begin here -! -!> -# Call random_setseed() to advance randum number generator by ipseed values. - - call random_setseed & -! --- inputs: - & ( ipseed, & -! --- outputs: - & stat & - & ) - -!> -# Sub-column set up according to overlapping assumption: -!! - For random overlap, pick a random value at every level -!! - For max-random overlap, pick a random value at every level -!! - For maximum overlap, pick same random numebr at every level - - select case ( iovrlw ) - - case( 0 ) ! random overlap, pick a random value at every level - - call random_number & -! --- inputs: ( none ) -! --- outputs: - & ( rand2d, stat ) - - k1 = 0 - do n = 1, ngptlw - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - case( 1 ) ! max-ran overlap - - call random_number & -! --- inputs: ( none ) -! --- outputs: - & ( rand2d, stat ) - - k1 = 0 - do n = 1, ngptlw - do k = 1, nlay - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - -! --- first pick a random number for bottom (or top) layer. -! then walk up the column: (aer's code) -! if layer below is cloudy, use the same rand num in the layer below -! if layer below is clear, use a new random number - -! --- from bottom up - do k = 2, nlay - k1 = k - 1 - tem1 = f_one - cldf(k1) - - do n = 1, ngptlw - if ( cdfunc(n,k1) > tem1 ) then - cdfunc(n,k) = cdfunc(n,k1) - else - cdfunc(n,k) = cdfunc(n,k) * tem1 - endif - enddo - enddo - -! --- or walk down the column: (if use original author's method) -! if layer above is cloudy, use the same rand num in the layer above -! if layer above is clear, use a new random number - -! --- from top down -! do k = nlay-1, 1, -1 -! k1 = k + 1 -! tem1 = f_one - cldf(k1) - -! do n = 1, ngptlw -! if ( cdfunc(n,k1) > tem1 ) then -! cdfunc(n,k) = cdfunc(n,k1) -! else -! cdfunc(n,k) = cdfunc(n,k) * tem1 -! endif -! enddo -! enddo - - case( 2 ) !< - For maximum overlap, pick same random numebr at every level - - call random_number & -! --- inputs: ( none ) -! --- outputs: - & ( rand1d, stat ) - - do n = 1, ngptlw - tem1 = rand1d(n) - - do k = 1, nlay - cdfunc(n,k) = tem1 - enddo - enddo - - case( 3 ) ! decorrelation length overlap - -! --- compute overlapping factors based on layer midpoint distances -! and decorrelation depths - - do k = nlay, 2, -1 - fac_lcf(k) = exp( -0.5 * (dz(k)+dz(k-1)) / de_lgth ) - enddo - -! --- setup 2 sets of random numbers - - call random_number ( rand2d, stat ) - - k1 = 0 - do k = 1, nlay - do n = 1, ngptlw - k1 = k1 + 1 - cdfunc(n,k) = rand2d(k1) - enddo - enddo - - call random_number ( rand2d, stat ) - - k1 = 0 - do k = 1, nlay - do n = 1, ngptlw - k1 = k1 + 1 - cdfun2(n,k) = rand2d(k1) - enddo - enddo - -! --- then working from the top down: -! if a random number (from an independent set -cdfun2) is smaller then the -! scale factor: use the upper layer's number, otherwise use a new random -! number (keep the original assigned one). - - do k = nlay-1, 1, -1 - k1 = k + 1 - - do n = 1, ngptlw - if ( cdfun2(n,k) <= fac_lcf(k1) ) then - cdfunc(n,k) = cdfunc(n,k1) - endif - enddo - enddo - - end select - -!> -# Generate subcolumns for homogeneous clouds. - - do k = 1, nlay - tem1 = f_one - cldf(k) - - do n = 1, ngptlw - lcloudy(n,k) = cdfunc(n,k) >= tem1 - enddo - enddo - - return -! .................................. - end subroutine mcica_subcol -!! @} -! ---------------------------------- - -!>\ingroup module_radlw_main -!> This subroutine computes various coefficients needed in radiative -!! transfer calculations. -!!\param pavel layer pressure (mb) -!!\param tavel layer temperature (K) -!!\param tz level(interface) temperatures (K) -!!\param stemp surface ground temperature (K) -!!\param h2ovmr layer w.v. volumn mixing ratio (kg/kg) -!!\param colamt column amounts of absorbing gases. -!! 2nd indices range: 1-maxgas, for watervapor,carbon dioxide, ozone, -!! nitrous oxide, methane,oxigen, carbon monoxide,etc. \f$(mol/cm^2)\f$ -!!\param coldry dry air column amount -!!\param colbrd column amount of broadening gases -!!\param nlay total number of vertical layers -!!\param nlp1 total number of vertical levels -!!\param laytrop tropopause layer index (unitless) -!!\param pklay integrated planck func at lay temp -!!\param pklev integrated planck func at lev temp -!!\param jp indices of lower reference pressure -!!\param jt, jt1 indices of lower reference temperatures -!!\param rfrate ref ratios of binary species param -!!\n (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o, -!! 4-h2o/ch4,5-n2o/co2,6-o3/co2 -!!\n (:,:,n)n=1,2: the rates of ref press at -!! the 2 sides of the layer -!!\param fac00,fac01,fac10,fac11 factors multiply the reference ks, i,j=0/1 for -!! lower/higher of the 2 appropriate temperatures -!! and altitudes. -!!\param selffac scale factor for w. v. self-continuum equals -!! (w. v. density)/(atmospheric density at 296k and 1013 mb) -!!\param selffrac factor for temperature interpolation of -!! reference w. v. self-continuum data -!!\param indself index of lower ref temp for selffac -!!\param forfac scale factor for w. v. foreign-continuum -!!\param forfrac factor for temperature interpolation of -!! reference w.v. foreign-continuum data -!!\param indfor index of lower ref temp for forfac -!!\param minorfrac factor for minor gases -!!\param scaleminor,scaleminorn2 scale factors for minor gases -!!\param indminor index of lower ref temp for minor gases -!>\section setcoef_gen setcoef General Algorithm -!> @{ - subroutine setcoef & - & ( pavel,tavel,tz,stemp,h2ovmr,colamt,coldry,colbrd, & ! --- inputs: - & nlay, nlp1, & - & laytrop,pklay,pklev,jp,jt,jt1, & ! --- outputs: - & rfrate,fac00,fac01,fac10,fac11, & - & selffac,selffrac,indself,forfac,forfrac,indfor, & - & minorfrac,scaleminor,scaleminorn2,indminor & - & ) - -! =================== program usage description =================== ! -! ! -! purpose: compute various coefficients needed in radiative transfer ! -! calculations. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -size- ! -! pavel - real, layer pressures (mb) nlay ! -! tavel - real, layer temperatures (k) nlay ! -! tz - real, level (interface) temperatures (k) 0:nlay ! -! stemp - real, surface ground temperature (k) 1 ! -! h2ovmr - real, layer w.v. volum mixing ratio (kg/kg) nlay ! -! colamt - real, column amounts of absorbing gases nlay*maxgas! -! 2nd indices range: 1-maxgas, for watervapor, ! -! carbon dioxide, ozone, nitrous oxide, methane, ! -! oxigen, carbon monoxide,etc. (molecules/cm**2) ! -! coldry - real, dry air column amount nlay ! -! colbrd - real, column amount of broadening gases nlay ! -! nlay/nlp1 - integer, total number of vertical layers, levels 1 ! -! ! -! outputs: ! -! laytrop - integer, tropopause layer index (unitless) 1 ! -! pklay - real, integrated planck func at lay temp nbands*0:nlay! -! pklev - real, integrated planck func at lev temp nbands*0:nlay! -! jp - real, indices of lower reference pressure nlay ! -! jt, jt1 - real, indices of lower reference temperatures nlay ! -! rfrate - real, ref ratios of binary species param nlay*nrates*2! -! (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o,4-h2o/ch4,5-n2o/co2,6-o3/co2! -! (:,:,n)n=1,2: the rates of ref press at the 2 sides of the layer ! -! facij - real, factors multiply the reference ks, nlay ! -! i,j=0/1 for lower/higher of the 2 appropriate ! -! temperatures and altitudes. ! -! selffac - real, scale factor for w. v. self-continuum nlay ! -! equals (w. v. density)/(atmospheric density ! -! at 296k and 1013 mb) ! -! selffrac - real, factor for temperature interpolation of nlay ! -! reference w. v. self-continuum data ! -! indself - integer, index of lower ref temp for selffac nlay ! -! forfac - real, scale factor for w. v. foreign-continuum nlay ! -! forfrac - real, factor for temperature interpolation of nlay ! -! reference w.v. foreign-continuum data ! -! indfor - integer, index of lower ref temp for forfac nlay ! -! minorfrac - real, factor for minor gases nlay ! -! scaleminor,scaleminorn2 ! -! - real, scale factors for minor gases nlay ! -! indminor - integer, index of lower ref temp for minor gases nlay ! -! ! -! ====================== end of definitions =================== ! - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(nlay,maxgas),intent(in):: colamt - real (kind=kind_phys), dimension(0:nlay), intent(in):: tz - - real (kind=kind_phys), dimension(nlay), intent(in) :: pavel, & - & tavel, h2ovmr, coldry, colbrd - - real (kind=kind_phys), intent(in) :: stemp - -! --- outputs: - integer, dimension(nlay), intent(out) :: jp, jt, jt1, indself, & - & indfor, indminor - - integer, intent(out) :: laytrop - - real (kind=kind_phys), dimension(nlay,nrates,2), intent(out) :: & - & rfrate - real (kind=kind_phys), dimension(nbands,0:nlay), intent(out) :: & - & pklev, pklay - - real (kind=kind_phys), dimension(nlay), intent(out) :: & - & fac00, fac01, fac10, fac11, selffac, selffrac, forfac, & - & forfrac, minorfrac, scaleminor, scaleminorn2 - -! --- locals: - real (kind=kind_phys) :: tlvlfr, tlyrfr, plog, fp, ft, ft1, & - & tem1, tem2 - - integer :: i, k, jp1, indlev, indlay -! -!===> ... begin here -! -!> -# Calculate information needed by the radiative transfer routine -!! that is specific to this atmosphere, especially some of the -!! coefficients and indices needed to compute the optical depths -!! by interpolating data from stored reference atmospheres. - - indlay = min(180, max(1, int(stemp-159.0) )) - indlev = min(180, max(1, int(tz(0)-159.0) )) - tlyrfr = stemp - int(stemp) - tlvlfr = tz(0) - int(tz(0)) - do i = 1, nbands - tem1 = totplnk(indlay+1,i) - totplnk(indlay,i) - tem2 = totplnk(indlev+1,i) - totplnk(indlev,i) - pklay(i,0) = delwave(i) * (totplnk(indlay,i) + tlyrfr*tem1) - pklev(i,0) = delwave(i) * (totplnk(indlev,i) + tlvlfr*tem2) - enddo - -! --- ... begin layer loop -!> -# Calculate the integrated Planck functions for each band at the -!! surface, level, and layer temperatures. - - laytrop = 0 - - do k = 1, nlay - - indlay = min(180, max(1, int(tavel(k)-159.0) )) - tlyrfr = tavel(k) - int(tavel(k)) - - indlev = min(180, max(1, int(tz(k)-159.0) )) - tlvlfr = tz(k) - int(tz(k)) - -! --- ... begin spectral band loop - - do i = 1, nbands - pklay(i,k) = delwave(i) * (totplnk(indlay,i) + tlyrfr & - & * (totplnk(indlay+1,i) - totplnk(indlay,i)) ) - pklev(i,k) = delwave(i) * (totplnk(indlev,i) + tlvlfr & - & * (totplnk(indlev+1,i) - totplnk(indlev,i)) ) - enddo - -!> -# Find the two reference pressures on either side of the -!! layer pressure. store them in jp and jp1. store in fp the -!! fraction of the difference (in ln(pressure)) between these -!! two values that the layer pressure lies. - - plog = log(pavel(k)) - jp(k)= max(1, min(58, int(36.0 - 5.0*(plog+0.04)) )) - jp1 = jp(k) + 1 -! --- ... limit pressure extrapolation at the top - fp = max(f_zero, min(f_one, 5.0*(preflog(jp(k))-plog) )) -!org fp = 5.0 * (preflog(jp(k)) - plog) - -!> -# Determine, for each reference pressure (jp and jp1), which -!! reference temperature (these are different for each -!! reference pressure) is nearest the layer temperature but does -!! not exceed it. store these indices in jt and jt1, resp. -!! store in ft (resp. ft1) the fraction of the way between jt -!! (jt1) and the next highest reference temperature that the -!! layer temperature falls. - - tem1 = (tavel(k)-tref(jp(k))) / 15.0 - tem2 = (tavel(k)-tref(jp1 )) / 15.0 - jt (k) = max(1, min(4, int(3.0 + tem1) )) - jt1(k) = max(1, min(4, int(3.0 + tem2) )) -! --- ... restrict extrapolation ranges by limiting abs(det t) < 37.5 deg - ft = max(-0.5, min(1.5, tem1 - float(jt (k) - 3) )) - ft1 = max(-0.5, min(1.5, tem2 - float(jt1(k) - 3) )) -!org ft = tem1 - float(jt (k) - 3) -!org ft1 = tem2 - float(jt1(k) - 3) - -!> -# We have now isolated the layer ln pressure and temperature, -!! between two reference pressures and two reference temperatures -!!(for each reference pressure). we multiply the pressure -!! fraction fp with the appropriate temperature fractions to get -!! the factors that will be needed for the interpolation that yields -!! the optical depths (performed in routines taugbn for band n). - - tem1 = f_one - fp - fac10(k) = tem1 * ft - fac00(k) = tem1 * (f_one - ft) - fac11(k) = fp * ft1 - fac01(k) = fp * (f_one - ft1) - - forfac(k) = pavel(k)*stpfac / (tavel(k)*(1.0 + h2ovmr(k))) - selffac(k) = h2ovmr(k) * forfac(k) - -!> -# Set up factors needed to separately include the minor gases -!! in the calculation of absorption coefficient. - - scaleminor(k) = pavel(k) / tavel(k) - scaleminorn2(k) = (pavel(k) / tavel(k)) & - & * (colbrd(k)/(coldry(k) + colamt(k,1))) - tem1 = (tavel(k) - 180.8) / 7.2 - indminor(k) = min(18, max(1, int(tem1))) - minorfrac(k) = tem1 - float(indminor(k)) - -!> -# If the pressure is less than ~100mb, perform a different -!! set of species interpolations. - - if (plog > 4.56) then - - laytrop = laytrop + 1 - - tem1 = (332.0 - tavel(k)) / 36.0 - indfor(k) = min(2, max(1, int(tem1))) - forfrac(k) = tem1 - float(indfor(k)) - -!> -# Set up factors needed to separately include the water vapor -!! self-continuum in the calculation of absorption coefficient. - - tem1 = (tavel(k) - 188.0) / 7.2 - indself(k) = min(9, max(1, int(tem1)-7)) - selffrac(k) = tem1 - float(indself(k) + 7) - -!> -# Setup reference ratio to be used in calculation of binary -!! species parameter in lower atmosphere. - - rfrate(k,1,1) = chi_mls(1,jp(k)) / chi_mls(2,jp(k)) - rfrate(k,1,2) = chi_mls(1,jp(k)+1) / chi_mls(2,jp(k)+1) - - rfrate(k,2,1) = chi_mls(1,jp(k)) / chi_mls(3,jp(k)) - rfrate(k,2,2) = chi_mls(1,jp(k)+1) / chi_mls(3,jp(k)+1) - - rfrate(k,3,1) = chi_mls(1,jp(k)) / chi_mls(4,jp(k)) - rfrate(k,3,2) = chi_mls(1,jp(k)+1) / chi_mls(4,jp(k)+1) - - rfrate(k,4,1) = chi_mls(1,jp(k)) / chi_mls(6,jp(k)) - rfrate(k,4,2) = chi_mls(1,jp(k)+1) / chi_mls(6,jp(k)+1) - - rfrate(k,5,1) = chi_mls(4,jp(k)) / chi_mls(2,jp(k)) - rfrate(k,5,2) = chi_mls(4,jp(k)+1) / chi_mls(2,jp(k)+1) - - else - - tem1 = (tavel(k) - 188.0) / 36.0 - indfor(k) = 3 - forfrac(k) = tem1 - f_one - - indself(k) = 0 - selffrac(k) = f_zero - -!> -# Setup reference ratio to be used in calculation of binary -!! species parameter in upper atmosphere. - - rfrate(k,1,1) = chi_mls(1,jp(k)) / chi_mls(2,jp(k)) - rfrate(k,1,2) = chi_mls(1,jp(k)+1) / chi_mls(2,jp(k)+1) - - rfrate(k,6,1) = chi_mls(3,jp(k)) / chi_mls(2,jp(k)) - rfrate(k,6,2) = chi_mls(3,jp(k)+1) / chi_mls(2,jp(k)+1) - - endif - -!> -# Rescale \a selffac and \a forfac for use in taumol. - - selffac(k) = colamt(k,1) * selffac(k) - forfac(k) = colamt(k,1) * forfac(k) - - enddo ! end do_k layer loop - - return -! .................................. - end subroutine setcoef -!> @} -! ---------------------------------- - -!>\ingroup module_radlw_main -!> This subroutine computes the upward/downward radiative fluxes, and -!! heating rates for both clear or cloudy atmosphere. Clouds assumed as -!! randomly overlaping in a vertical column. -!!\brief Original Code Description: this program calculates the upward -!! fluxes, downward fluxes, and heating rates for an arbitrary clear or -!! cloudy atmosphere. The input to this program is the atmospheric -!! profile, all Planck function information, and the cloud fraction by -!! layer. A variable diffusivity angle (secdif) is used for the angle -!! integration. Bands 2-3 and 5-9 use a value for secdif that varies -!! from 1.50 to 1.80 as a function of the column water vapor, and other -!! bands use a value of 1.66. The gaussian weight appropriate to this -!! angle (wtdiff =0.5) is applied here. Note that use of the emissivity -!! angle for the flux integration can cause errors of 1 to 4 \f$W/m^2\f$ -!! within cloudy layers. Clouds are treated with a random cloud overlap -!! method. -!!\param semiss lw surface emissivity -!!\param delp layer pressure thickness (mb) -!!\param cldfrc layer cloud fraction -!!\param taucld layer cloud opt depth -!!\param tautot total optical depth (gas+aerosols) -!!\param pklay integrated planck function at lay temp -!!\param pklev integrated planck func at lev temp -!!\param fracs planck fractions -!!\param secdif secant of diffusivity angle -!!\param nlay number of vertical layers -!!\param nlp1 number of vertical levels (interfaces) -!!\param totuflux total sky upward flux \f$(w/m^2)\f$ -!!\param totdflux total sky downward flux \f$(w/m^2)\f$ -!!\param htr total sky heating rate (k/sec or k/day) -!!\param totuclfl clear sky upward flux \f$(w/m^2)\f$ -!!\param totdclfl clear sky downward flux \f$(w/m^2)\f$ -!!\param htrcl clear sky heating rate (k/sec or k/day) -!!\param htrb spectral band lw heating rate (k/day) -!>\section gen_rtrn rtrn General Algorithm -!! @{ -! ---------------------------------- - subroutine rtrn & - & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, & ! --- inputs - & fracs,secdif, nlay,nlp1, & - & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & ! --- outputs - & ) - -! =================== program usage description =================== ! -! ! -! purpose: compute the upward/downward radiative fluxes, and heating ! -! rates for both clear or cloudy atmosphere. clouds are assumed as ! -! randomly overlaping in a vertical colum. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -size- ! -! semiss - real, lw surface emissivity nbands! -! delp - real, layer pressure thickness (mb) nlay ! -! cldfrc - real, layer cloud fraction 0:nlp1 ! -! taucld - real, layer cloud opt depth nbands,nlay! -! tautot - real, total optical depth (gas+aerosols) ngptlw,nlay! -! pklay - real, integrated planck func at lay temp nbands*0:nlay! -! pklev - real, integrated planck func at lev temp nbands*0:nlay! -! fracs - real, planck fractions ngptlw,nlay! -! secdif - real, secant of diffusivity angle nbands! -! nlay - integer, number of vertical layers 1 ! -! nlp1 - integer, number of vertical levels (interfaces) 1 ! -! ! -! outputs: ! -! totuflux- real, total sky upward flux (w/m2) 0:nlay ! -! totdflux- real, total sky downward flux (w/m2) 0:nlay ! -! htr - real, total sky heating rate (k/sec or k/day) nlay ! -! totuclfl- real, clear sky upward flux (w/m2) 0:nlay ! -! totdclfl- real, clear sky downward flux (w/m2) 0:nlay ! -! htrcl - real, clear sky heating rate (k/sec or k/day) nlay ! -! htrb - real, spectral band lw heating rate (k/day) nlay*nbands! -! ! -! module veriables: ! -! ngb - integer, band index for each g-value ngptlw! -! fluxfac - real, conversion factor for fluxes (pi*2.e4) 1 ! -! heatfac - real, conversion factor for heating rates (g/cp*1e-2) 1 ! -! tblint - real, conversion factor for look-up tbl (float(ntbl) 1 ! -! bpade - real, pade approx constant (1/0.278) 1 ! -! wtdiff - real, weight for radiance to flux conversion 1 ! -! ntbl - integer, dimension of look-up tables 1 ! -! tau_tbl - real, clr-sky opt dep lookup table 0:ntbl ! -! exp_tbl - real, transmittance lookup table 0:ntbl ! -! tfn_tbl - real, tau transition function 0:ntbl ! -! ! -! local variables: ! -! itgas - integer, index for gases contribution look-up table 1 ! -! ittot - integer, index for gases plus clouds look-up table 1 ! -! reflct - real, surface reflectance 1 ! -! atrgas - real, gaseous absorptivity 1 ! -! atrtot - real, gaseous and cloud absorptivity 1 ! -! odcld - real, cloud optical depth 1 ! -! efclrfr- real, effective clear sky fraction (1-efcldfr) nlay ! -! odepth - real, optical depth of gaseous only 1 ! -! odtot - real, optical depth of gas and cloud 1 ! -! gasfac - real, gas-only pade factor, used for planck fn 1 ! -! totfac - real, gas+cld pade factor, used for planck fn 1 ! -! bbdgas - real, gas-only planck function for downward rt 1 ! -! bbugas - real, gas-only planck function for upward rt 1 ! -! bbdtot - real, gas and cloud planck function for downward rt 1 ! -! bbutot - real, gas and cloud planck function for upward rt 1 ! -! gassrcu- real, upwd source radiance due to gas only nlay! -! totsrcu- real, upwd source radiance due to gas+cld nlay! -! gassrcd- real, dnwd source radiance due to gas only 1 ! -! totsrcd- real, dnwd source radiance due to gas+cld 1 ! -! radtotu- real, spectrally summed total sky upwd radiance 1 ! -! radclru- real, spectrally summed clear sky upwd radiance 1 ! -! radtotd- real, spectrally summed total sky dnwd radiance 1 ! -! radclrd- real, spectrally summed clear sky dnwd radiance 1 ! -! toturad- real, total sky upward radiance by layer 0:nlay*nbands! -! clrurad- real, clear sky upward radiance by layer 0:nlay*nbands! -! totdrad- real, total sky downward radiance by layer 0:nlay*nbands! -! clrdrad- real, clear sky downward radiance by layer 0:nlay*nbands! -! fnet - real, net longwave flux (w/m2) 0:nlay ! -! fnetc - real, clear sky net longwave flux (w/m2) 0:nlay ! -! ! -! ! -! ******************************************************************* ! -! original code description ! -! ! -! original version: e. j. mlawer, et al. rrtm_v3.0 ! -! revision for gcms: michael j. iacono; october, 2002 ! -! revision for f90: michael j. iacono; june, 2006 ! -! ! -! this program calculates the upward fluxes, downward fluxes, and ! -! heating rates for an arbitrary clear or cloudy atmosphere. the input ! -! to this program is the atmospheric profile, all Planck function ! -! information, and the cloud fraction by layer. a variable diffusivity! -! angle (secdif) is used for the angle integration. bands 2-3 and 5-9 ! -! use a value for secdif that varies from 1.50 to 1.80 as a function ! -! of the column water vapor, and other bands use a value of 1.66. the ! -! gaussian weight appropriate to this angle (wtdiff=0.5) is applied ! -! here. note that use of the emissivity angle for the flux integration! -! can cause errors of 1 to 4 W/m2 within cloudy layers. ! -! clouds are treated with a random cloud overlap method. ! -! ! -! ******************************************************************* ! -! ====================== end of description block ================= ! - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cldfrc - real (kind=kind_phys), dimension(nbands), intent(in) :: semiss, & - & secdif - real (kind=kind_phys), dimension(nlay), intent(in) :: delp - - real (kind=kind_phys), dimension(nbands,nlay),intent(in):: taucld - real (kind=kind_phys), dimension(ngptlw,nlay),intent(in):: fracs, & - & tautot - - real (kind=kind_phys), dimension(nbands,0:nlay), intent(in) :: & - & pklev, pklay - -! --- outputs: - real (kind=kind_phys), dimension(nlay), intent(out) :: htr, htrcl - - real (kind=kind_phys), dimension(nlay,nbands),intent(out) :: htrb - - real (kind=kind_phys), dimension(0:nlay), intent(out) :: & - & totuflux, totdflux, totuclfl, totdclfl - -! --- locals: - real (kind=kind_phys), parameter :: rec_6 = 0.166667 - - real (kind=kind_phys), dimension(0:nlay,nbands) :: clrurad, & - & clrdrad, toturad, totdrad - - real (kind=kind_phys), dimension(nlay) :: gassrcu, totsrcu, & - & trngas, efclrfr, rfdelp - real (kind=kind_phys), dimension(0:nlay) :: fnet, fnetc - - real (kind=kind_phys) :: totsrcd, gassrcd, tblind, odepth, odtot, & - & odcld, atrtot, atrgas, reflct, totfac, gasfac, flxfac, & - & plfrac, blay, bbdgas, bbdtot, bbugas, bbutot, dplnku, & - & dplnkd, radtotu, radclru, radtotd, radclrd, rad0, & - & clfr, trng, gasu - - integer :: ittot, itgas, ib, ig, k -! -!===> ... begin here -! - do ib = 1, NBANDS - do k = 0, NLAY - toturad(k,ib) = f_zero - totdrad(k,ib) = f_zero - clrurad(k,ib) = f_zero - clrdrad(k,ib) = f_zero - enddo - enddo - - do k = 0, nlay - totuflux(k) = f_zero - totdflux(k) = f_zero - totuclfl(k) = f_zero - totdclfl(k) = f_zero - enddo - -! --- ... loop over all g-points - - do ig = 1, ngptlw - ib = ngb(ig) - - radtotd = f_zero - radclrd = f_zero - -!> -# Downward radiative transfer loop. - - do k = nlay, 1, -1 - -!!\n - clear sky, gases contribution - - odepth = max( f_zero, secdif(ib)*tautot(ig,k) ) - if (odepth <= 0.06) then - atrgas = odepth - 0.5*odepth*odepth - trng = f_one - atrgas - gasfac = rec_6 * odepth - else - tblind = odepth / (bpade + odepth) - itgas = tblint*tblind + 0.5 - trng = exp_tbl(itgas) - atrgas = f_one - trng - gasfac = tfn_tbl(itgas) - odepth = tau_tbl(itgas) - endif - - plfrac = fracs(ig,k) - blay = pklay(ib,k) - - dplnku = pklev(ib,k ) - blay - dplnkd = pklev(ib,k-1) - blay - bbdgas = plfrac * (blay + dplnkd*gasfac) - bbugas = plfrac * (blay + dplnku*gasfac) - gassrcd= bbdgas * atrgas - gassrcu(k)= bbugas * atrgas - trngas(k) = trng - -!!\n - total sky, gases+clouds contribution - - clfr = cldfrc(k) - if (clfr >= eps) then -!!\n - cloudy layer - - odcld = secdif(ib) * taucld(ib,k) - efclrfr(k) = f_one-(f_one - exp(-odcld))*clfr - odtot = odepth + odcld - if (odtot < 0.06) then - totfac = rec_6 * odtot - atrtot = odtot - 0.5*odtot*odtot - else - tblind = odtot / (bpade + odtot) - ittot = tblint*tblind + 0.5 - totfac = tfn_tbl(ittot) - atrtot = f_one - exp_tbl(ittot) - endif - - bbdtot = plfrac * (blay + dplnkd*totfac) - bbutot = plfrac * (blay + dplnku*totfac) - totsrcd= bbdtot * atrtot - totsrcu(k)= bbutot * atrtot - -! --- ... total sky radiance - radtotd = radtotd*trng*efclrfr(k) + gassrcd & - & + clfr*(totsrcd - gassrcd) - totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd - -! --- ... clear sky radiance - radclrd = radclrd*trng + gassrcd - clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd - - else -! --- ... clear layer - -! --- ... total sky radiance - radtotd = radtotd*trng + gassrcd - totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd - -! --- ... clear sky radiance - radclrd = radclrd*trng + gassrcd - clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd - - endif ! end if_clfr_block - - enddo ! end do_k_loop - -!> -# Compute spectral emissivity & reflectance, include the -!! contribution of spectrally varying longwave emissivity and -!! reflection from the surface to the upward radiative transfer. - -! note: spectral and Lambertian reflection are identical for the -! diffusivity angle flux integration used here. - - reflct = f_one - semiss(ib) - rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) - -!> -# Compute total sky radiance. - radtotu = rad0 + reflct*radtotd - toturad(0,ib) = toturad(0,ib) + radtotu - -!> -# Compute clear sky radiance - radclru = rad0 + reflct*radclrd - clrurad(0,ib) = clrurad(0,ib) + radclru - -!> -# Upward radiative transfer loop. - - do k = 1, nlay - clfr = cldfrc(k) - trng = trngas(k) - gasu = gassrcu(k) - - if (clfr >= eps) then -! --- ... cloudy layer - -! --- ... total sky radiance - radtotu = radtotu*trng*efclrfr(k) + gasu & - & + clfr*(totsrcu(k) - gasu) - toturad(k,ib) = toturad(k,ib) + radtotu - -! --- ... clear sky radiance - radclru = radclru*trng + gasu - clrurad(k,ib) = clrurad(k,ib) + radclru - - else -! --- ... clear layer - -! --- ... total sky radiance - radtotu = radtotu*trng + gasu - toturad(k,ib) = toturad(k,ib) + radtotu - -! --- ... clear sky radiance - radclru = radclru*trng + gasu - clrurad(k,ib) = clrurad(k,ib) + radclru - - endif ! end if_clfr_block - - enddo ! end do_k_loop - - enddo ! end do_ig_loop - -!> -# Process longwave output from band for total and clear streams. -!! Calculate upward, downward, and net flux. - - flxfac = wtdiff * fluxfac - - do k = 0, nlay - do ib = 1, nbands - totuflux(k) = totuflux(k) + toturad(k,ib) - totdflux(k) = totdflux(k) + totdrad(k,ib) - totuclfl(k) = totuclfl(k) + clrurad(k,ib) - totdclfl(k) = totdclfl(k) + clrdrad(k,ib) - enddo - - totuflux(k) = totuflux(k) * flxfac - totdflux(k) = totdflux(k) * flxfac - totuclfl(k) = totuclfl(k) * flxfac - totdclfl(k) = totdclfl(k) * flxfac - enddo - -! --- ... calculate net fluxes and heating rates - fnet(0) = totuflux(0) - totdflux(0) - - do k = 1, nlay - rfdelp(k) = heatfac / delp(k) - fnet(k) = totuflux(k) - totdflux(k) - htr (k) = (fnet(k-1) - fnet(k)) * rfdelp(k) - enddo - -!! --- ... optional clear sky heating rates - if ( lhlw0 ) then - fnetc(0) = totuclfl(0) - totdclfl(0) - - do k = 1, nlay - fnetc(k) = totuclfl(k) - totdclfl(k) - htrcl(k) = (fnetc(k-1) - fnetc(k)) * rfdelp(k) - enddo - endif - -!! --- ... optional spectral band heating rates - if ( lhlwb ) then - do ib = 1, nbands - fnet(0) = (toturad(0,ib) - totdrad(0,ib)) * flxfac - - do k = 1, nlay - fnet(k) = (toturad(k,ib) - totdrad(k,ib)) * flxfac - htrb(k,ib) = (fnet(k-1) - fnet(k)) * rfdelp(k) - enddo - enddo - endif - -! .................................. - end subroutine rtrn -!! @} -! ---------------------------------- - - -!>\ingroup module_radlw_main -!> This subroutine computes the upward/downward radiative fluxes, and -!! heating rates for both clear or cloudy atmosphere. Clouds are -!! assumed as in maximum-randomly overlaping in a vertical column. -!!\param semiss lw surface emissivity -!!\param delp layer pressure thickness (mb) -!!\param cldfrc layer cloud fraction -!!\param taucld layer cloud opt depth -!!\param tautot total optical depth (gas+aerosols) -!!\param pklay integrated planck func at lay temp -!!\param pklev integrated planck func at lev temp -!!\param fracs planck fractions -!!\param secdif secant of diffusivity angle -!!\param nlay number of vertical layers -!!\param nlp1 number of vertical levels (interfaces) -!!\param totuflux total sky upward flux (\f$w/m^2\f$) -!!\param totdflux total sky downward flux (\f$w/m^2\f$) -!!\param htr total sky heating rate (k/sec or k/day) -!!\param totuclfl clear sky upward flux (\f$w/m^2\f$) -!!\param totdclfl clear sky downward flux (\f$w/m^2\f$) -!!\param htrcl clear sky heating rate (k/sec or k/day) -!!\param htrb spectral band lw heating rate (k/day) -!!\section gen_rtrnmr rtrnmr General Algorithm -!> @{ -! ---------------------------------- - subroutine rtrnmr & - & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, &! --- inputs - & fracs,secdif, nlay,nlp1, & - & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & ! --- outputs: - & ) - -! =================== program usage description =================== ! -! ! -! purpose: compute the upward/downward radiative fluxes, and heating ! -! rates for both clear or cloudy atmosphere. clouds are assumed as in ! -! maximum-randomly overlaping in a vertical colum. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -size- ! -! semiss - real, lw surface emissivity nbands! -! delp - real, layer pressure thickness (mb) nlay ! -! cldfrc - real, layer cloud fraction 0:nlp1 ! -! taucld - real, layer cloud opt depth nbands,nlay! -! tautot - real, total optical depth (gas+aerosols) ngptlw,nlay! -! pklay - real, integrated planck func at lay temp nbands*0:nlay! -! pklev - real, integrated planck func at lev temp nbands*0:nlay! -! fracs - real, planck fractions ngptlw,nlay! -! secdif - real, secant of diffusivity angle nbands! -! nlay - integer, number of vertical layers 1 ! -! nlp1 - integer, number of vertical levels (interfaces) 1 ! -! ! -! outputs: ! -! totuflux- real, total sky upward flux (w/m2) 0:nlay ! -! totdflux- real, total sky downward flux (w/m2) 0:nlay ! -! htr - real, total sky heating rate (k/sec or k/day) nlay ! -! totuclfl- real, clear sky upward flux (w/m2) 0:nlay ! -! totdclfl- real, clear sky downward flux (w/m2) 0:nlay ! -! htrcl - real, clear sky heating rate (k/sec or k/day) nlay ! -! htrb - real, spectral band lw heating rate (k/day) nlay*nbands! -! ! -! module veriables: ! -! ngb - integer, band index for each g-value ngptlw! -! fluxfac - real, conversion factor for fluxes (pi*2.e4) 1 ! -! heatfac - real, conversion factor for heating rates (g/cp*1e-2) 1 ! -! tblint - real, conversion factor for look-up tbl (float(ntbl) 1 ! -! bpade - real, pade approx constant (1/0.278) 1 ! -! wtdiff - real, weight for radiance to flux conversion 1 ! -! ntbl - integer, dimension of look-up tables 1 ! -! tau_tbl - real, clr-sky opt dep lookup table 0:ntbl ! -! exp_tbl - real, transmittance lookup table 0:ntbl ! -! tfn_tbl - real, tau transition function 0:ntbl ! -! ! -! local variables: ! -! itgas - integer, index for gases contribution look-up table 1 ! -! ittot - integer, index for gases plus clouds look-up table 1 ! -! reflct - real, surface reflectance 1 ! -! atrgas - real, gaseous absorptivity 1 ! -! atrtot - real, gaseous and cloud absorptivity 1 ! -! odcld - real, cloud optical depth 1 ! -! odepth - real, optical depth of gaseous only 1 ! -! odtot - real, optical depth of gas and cloud 1 ! -! gasfac - real, gas-only pade factor, used for planck fn 1 ! -! totfac - real, gas+cld pade factor, used for planck fn 1 ! -! bbdgas - real, gas-only planck function for downward rt 1 ! -! bbugas - real, gas-only planck function for upward rt 1 ! -! bbdtot - real, gas and cloud planck function for downward rt 1 ! -! bbutot - real, gas and cloud planck function for upward rt 1 ! -! gassrcu- real, upwd source radiance due to gas only nlay! -! totsrcu- real, upwd source radiance due to gas + cld nlay! -! gassrcd- real, dnwd source radiance due to gas only 1 ! -! totsrcd- real, dnwd source radiance due to gas + cld 1 ! -! radtotu- real, spectrally summed total sky upwd radiance 1 ! -! radclru- real, spectrally summed clear sky upwd radiance 1 ! -! radtotd- real, spectrally summed total sky dnwd radiance 1 ! -! radclrd- real, spectrally summed clear sky dnwd radiance 1 ! -! toturad- real, total sky upward radiance by layer 0:nlay*nbands! -! clrurad- real, clear sky upward radiance by layer 0:nlay*nbands! -! totdrad- real, total sky downward radiance by layer 0:nlay*nbands! -! clrdrad- real, clear sky downward radiance by layer 0:nlay*nbands! -! fnet - real, net longwave flux (w/m2) 0:nlay ! -! fnetc - real, clear sky net longwave flux (w/m2) 0:nlay ! -! ! -! ! -! ******************************************************************* ! -! original code description ! -! ! -! original version: e. j. mlawer, et al. rrtm_v3.0 ! -! revision for gcms: michael j. iacono; october, 2002 ! -! revision for f90: michael j. iacono; june, 2006 ! -! ! -! this program calculates the upward fluxes, downward fluxes, and ! -! heating rates for an arbitrary clear or cloudy atmosphere. the input ! -! to this program is the atmospheric profile, all Planck function ! -! information, and the cloud fraction by layer. a variable diffusivity! -! angle (secdif) is used for the angle integration. bands 2-3 and 5-9 ! -! use a value for secdif that varies from 1.50 to 1.80 as a function ! -! of the column water vapor, and other bands use a value of 1.66. the ! -! gaussian weight appropriate to this angle (wtdiff=0.5) is applied ! -! here. note that use of the emissivity angle for the flux integration! -! can cause errors of 1 to 4 W/m2 within cloudy layers. ! -! clouds are treated with a maximum-random cloud overlap method. ! -! ! -! ******************************************************************* ! -! ====================== end of description block ================= ! - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cldfrc - real (kind=kind_phys), dimension(nbands), intent(in) :: semiss, & - & secdif - real (kind=kind_phys), dimension(nlay), intent(in) :: delp - - real (kind=kind_phys), dimension(nbands,nlay),intent(in):: taucld - real (kind=kind_phys), dimension(ngptlw,nlay),intent(in):: fracs, & - & tautot - - real (kind=kind_phys), dimension(nbands,0:nlay), intent(in) :: & - & pklev, pklay - -! --- outputs: - real (kind=kind_phys), dimension(nlay), intent(out) :: htr, htrcl - - real (kind=kind_phys), dimension(nlay,nbands),intent(out) :: htrb - - real (kind=kind_phys), dimension(0:nlay), intent(out) :: & - & totuflux, totdflux, totuclfl, totdclfl - -! --- locals: - real (kind=kind_phys), parameter :: rec_6 = 0.166667 - - real (kind=kind_phys), dimension(0:nlay,nbands) :: clrurad, & - & clrdrad, toturad, totdrad - - real (kind=kind_phys), dimension(nlay) :: gassrcu, totsrcu, & - & trngas, trntot, rfdelp - real (kind=kind_phys), dimension(0:nlay) :: fnet, fnetc - - real (kind=kind_phys) :: totsrcd, gassrcd, tblind, odepth, odtot, & - & odcld, atrtot, atrgas, reflct, totfac, gasfac, flxfac, & - & plfrac, blay, bbdgas, bbdtot, bbugas, bbutot, dplnku, & - & dplnkd, radtotu, radclru, radtotd, radclrd, rad0, rad, & - & totradd, clrradd, totradu, clrradu, fmax, fmin, rat1, rat2,& - & radmod, clfr, trng, trnt, gasu, totu - - integer :: ittot, itgas, ib, ig, k - -! dimensions for cloud overlap adjustment - real (kind=kind_phys), dimension(nlp1) :: faccld1u, faccld2u, & - & facclr1u, facclr2u, faccmb1u, faccmb2u - real (kind=kind_phys), dimension(0:nlay) :: faccld1d, faccld2d, & - & facclr1d, facclr2d, faccmb1d, faccmb2d - - logical :: lstcldu(nlay), lstcldd(nlay) -! -!===> ... begin here -! - do k = 1, nlp1 - faccld1u(k) = f_zero - faccld2u(k) = f_zero - facclr1u(k) = f_zero - facclr2u(k) = f_zero - faccmb1u(k) = f_zero - faccmb2u(k) = f_zero - enddo - - lstcldu(1) = cldfrc(1) > eps - rat1 = f_zero - rat2 = f_zero - - do k = 1, nlay-1 - - lstcldu(k+1) = cldfrc(k+1)>eps .and. cldfrc(k)<=eps - - if (cldfrc(k) > eps) then - -!> -# Setup maximum/random cloud overlap. - - if (cldfrc(k+1) >= cldfrc(k)) then - if (lstcldu(k)) then - if (cldfrc(k) < f_one) then - facclr2u(k+1) = (cldfrc(k+1) - cldfrc(k)) & - & / (f_one - cldfrc(k)) - endif - facclr2u(k) = f_zero - faccld2u(k) = f_zero - else - fmax = max(cldfrc(k), cldfrc(k-1)) - if (cldfrc(k+1) > fmax) then - facclr1u(k+1) = rat2 - facclr2u(k+1) = (cldfrc(k+1) - fmax)/(f_one - fmax) - elseif (cldfrc(k+1) < fmax) then - facclr1u(k+1) = (cldfrc(k+1) - cldfrc(k)) & - & / (cldfrc(k-1) - cldfrc(k)) - else - facclr1u(k+1) = rat2 - endif - endif - - if (facclr1u(k+1)>f_zero .or. facclr2u(k+1)>f_zero) then - rat1 = f_one - rat2 = f_zero - else - rat1 = f_zero - rat2 = f_zero - endif - else - if (lstcldu(k)) then - faccld2u(k+1) = (cldfrc(k) - cldfrc(k+1)) / cldfrc(k) - facclr2u(k) = f_zero - faccld2u(k) = f_zero - else - fmin = min(cldfrc(k), cldfrc(k-1)) - if (cldfrc(k+1) <= fmin) then - faccld1u(k+1) = rat1 - faccld2u(k+1) = (fmin - cldfrc(k+1)) / fmin - else - faccld1u(k+1) = (cldfrc(k) - cldfrc(k+1)) & - & / (cldfrc(k) - fmin) - endif - endif - - if (faccld1u(k+1)>f_zero .or. faccld2u(k+1)>f_zero) then - rat1 = f_zero - rat2 = f_one - else - rat1 = f_zero - rat2 = f_zero - endif - endif - - faccmb1u(k+1) = facclr1u(k+1) * faccld2u(k) * cldfrc(k-1) - faccmb2u(k+1) = faccld1u(k+1) * facclr2u(k) & - & * (f_one - cldfrc(k-1)) - endif - - enddo - - do k = 0, nlay - faccld1d(k) = f_zero - faccld2d(k) = f_zero - facclr1d(k) = f_zero - facclr2d(k) = f_zero - faccmb1d(k) = f_zero - faccmb2d(k) = f_zero - enddo - - lstcldd(nlay) = cldfrc(nlay) > eps - rat1 = f_zero - rat2 = f_zero - - do k = nlay, 2, -1 - - lstcldd(k-1) = cldfrc(k-1) > eps .and. cldfrc(k)<=eps - - if (cldfrc(k) > eps) then - - if (cldfrc(k-1) >= cldfrc(k)) then - if (lstcldd(k)) then - if (cldfrc(k) < f_one) then - facclr2d(k-1) = (cldfrc(k-1) - cldfrc(k)) & - & / (f_one - cldfrc(k)) - endif - - facclr2d(k) = f_zero - faccld2d(k) = f_zero - else - fmax = max(cldfrc(k), cldfrc(k+1)) - - if (cldfrc(k-1) > fmax) then - facclr1d(k-1) = rat2 - facclr2d(k-1) = (cldfrc(k-1) - fmax) / (f_one - fmax) - elseif (cldfrc(k-1) < fmax) then - facclr1d(k-1) = (cldfrc(k-1) - cldfrc(k)) & - & / (cldfrc(k+1) - cldfrc(k)) - else - facclr1d(k-1) = rat2 - endif - endif - - if (facclr1d(k-1)>f_zero .or. facclr2d(k-1)>f_zero) then - rat1 = f_one - rat2 = f_zero - else - rat1 = f_zero - rat2 = f_zero - endif - else - if (lstcldd(k)) then - faccld2d(k-1) = (cldfrc(k) - cldfrc(k-1)) / cldfrc(k) - facclr2d(k) = f_zero - faccld2d(k) = f_zero - else - fmin = min(cldfrc(k), cldfrc(k+1)) - - if (cldfrc(k-1) <= fmin) then - faccld1d(k-1) = rat1 - faccld2d(k-1) = (fmin - cldfrc(k-1)) / fmin - else - faccld1d(k-1) = (cldfrc(k) - cldfrc(k-1)) & - & / (cldfrc(k) - fmin) - endif - endif - - if (faccld1d(k-1)>f_zero .or. faccld2d(k-1)>f_zero) then - rat1 = f_zero - rat2 = f_one - else - rat1 = f_zero - rat2 = f_zero - endif - endif - - faccmb1d(k-1) = facclr1d(k-1) * faccld2d(k) * cldfrc(k+1) - faccmb2d(k-1) = faccld1d(k-1) * facclr2d(k) & - & * (f_one - cldfrc(k+1)) - endif - - enddo - -!> -# Initialize for radiative transfer - - do ib = 1, NBANDS - do k = 0, NLAY - toturad(k,ib) = f_zero - totdrad(k,ib) = f_zero - clrurad(k,ib) = f_zero - clrdrad(k,ib) = f_zero - enddo - enddo - - do k = 0, nlay - totuflux(k) = f_zero - totdflux(k) = f_zero - totuclfl(k) = f_zero - totdclfl(k) = f_zero - enddo - -! --- ... loop over all g-points - - do ig = 1, ngptlw - ib = ngb(ig) - - radtotd = f_zero - radclrd = f_zero - -!> -# Downward radiative transfer loop: - - do k = nlay, 1, -1 - -! --- ... clear sky, gases contribution - - odepth = max( f_zero, secdif(ib)*tautot(ig,k) ) - if (odepth <= 0.06) then - atrgas = odepth - 0.5*odepth*odepth - trng = f_one - atrgas - gasfac = rec_6 * odepth - else - tblind = odepth / (bpade + odepth) - itgas = tblint*tblind + 0.5 - trng = exp_tbl(itgas) - atrgas = f_one - trng - gasfac = tfn_tbl(itgas) - odepth = tau_tbl(itgas) - endif - - plfrac = fracs(ig,k) - blay = pklay(ib,k) - - dplnku = pklev(ib,k ) - blay - dplnkd = pklev(ib,k-1) - blay - bbdgas = plfrac * (blay + dplnkd*gasfac) - bbugas = plfrac * (blay + dplnku*gasfac) - gassrcd = bbdgas * atrgas - gassrcu(k)= bbugas * atrgas - trngas(k) = trng - -! --- ... total sky, gases+clouds contribution - - clfr = cldfrc(k) - if (lstcldd(k)) then - totradd = clfr * radtotd - clrradd = radtotd - totradd - rad = f_zero - endif - - if (clfr >= eps) then -!> - cloudy layer - - odcld = secdif(ib) * taucld(ib,k) - odtot = odepth + odcld - if (odtot < 0.06) then - totfac = rec_6 * odtot - atrtot = odtot - 0.5*odtot*odtot - trnt = f_one - atrtot - else - tblind = odtot / (bpade + odtot) - ittot = tblint*tblind + 0.5 - totfac = tfn_tbl(ittot) - trnt = exp_tbl(ittot) - atrtot = f_one - trnt - endif - - bbdtot = plfrac * (blay + dplnkd*totfac) - bbutot = plfrac * (blay + dplnku*totfac) - totsrcd = bbdtot * atrtot - totsrcu(k)= bbutot * atrtot - trntot(k) = trnt - - totradd = totradd*trnt + clfr*totsrcd - clrradd = clrradd*trng + (f_one - clfr)*gassrcd - -!> - total sky radiance - radtotd = totradd + clrradd - totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd - -!> - clear sky radiance - radclrd = radclrd*trng + gassrcd - clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd - - radmod = rad*(facclr1d(k-1)*trng + faccld1d(k-1)*trnt) & - & - faccmb1d(k-1)*gassrcd + faccmb2d(k-1)*totsrcd - - rad = -radmod + facclr2d(k-1)*(clrradd + radmod) & - & - faccld2d(k-1)*(totradd - radmod) - totradd = totradd + rad - clrradd = clrradd - rad - - else -! --- ... clear layer - -! --- ... total sky radiance - radtotd = radtotd*trng + gassrcd - totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd - -! --- ... clear sky radiance - radclrd = radclrd*trng + gassrcd - clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd - - endif ! end if_clfr_block - - enddo ! end do_k_loop - -!> -# Compute spectral emissivity & reflectance, include the -!! contribution of spectrally varying longwave emissivity and -!! reflection from the surface to the upward radiative transfer. - -! note: spectral and Lambertian reflection are identical for the -! diffusivity angle flux integration used here. - - reflct = f_one - semiss(ib) - rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) - -!> -# Compute total sky radiance. - radtotu = rad0 + reflct*radtotd - toturad(0,ib) = toturad(0,ib) + radtotu - -!> -# Compute clear sky radiance. - radclru = rad0 + reflct*radclrd - clrurad(0,ib) = clrurad(0,ib) + radclru - -!> -# Upward radiative transfer loop: - - do k = 1, nlay - - clfr = cldfrc(k) - trng = trngas(k) - gasu = gassrcu(k) - - if (lstcldu(k)) then - totradu = clfr * radtotu - clrradu = radtotu - totradu - rad = f_zero - endif - - if (clfr >= eps) then -!> - cloudy layer radiance - - trnt = trntot(k) - totu = totsrcu(k) - totradu = totradu*trnt + clfr*totu - clrradu = clrradu*trng + (f_one - clfr)*gasu - -!> - total sky radiance - radtotu = totradu + clrradu - toturad(k,ib) = toturad(k,ib) + radtotu - -!> - clear sky radiance - radclru = radclru*trng + gasu - clrurad(k,ib) = clrurad(k,ib) + radclru - - radmod = rad*(facclr1u(k+1)*trng + faccld1u(k+1)*trnt) & - & - faccmb1u(k+1)*gasu + faccmb2u(k+1)*totu - rad = -radmod + facclr2u(k+1)*(clrradu + radmod) & - & - faccld2u(k+1)*(totradu - radmod) - totradu = totradu + rad - clrradu = clrradu - rad - - else -! --- ... clear layer - -! --- ... total sky radiance - radtotu = radtotu*trng + gasu - toturad(k,ib) = toturad(k,ib) + radtotu - -! --- ... clear sky radiance - radclru = radclru*trng + gasu - clrurad(k,ib) = clrurad(k,ib) + radclru - - endif ! end if_clfr_block - - enddo ! end do_k_loop - - enddo ! end do_ig_loop - -!> -# Process longwave output from band for total and clear streams. -!! calculate upward, downward, and net flux. - - flxfac = wtdiff * fluxfac - - do k = 0, nlay - do ib = 1, nbands - totuflux(k) = totuflux(k) + toturad(k,ib) - totdflux(k) = totdflux(k) + totdrad(k,ib) - totuclfl(k) = totuclfl(k) + clrurad(k,ib) - totdclfl(k) = totdclfl(k) + clrdrad(k,ib) - enddo - - totuflux(k) = totuflux(k) * flxfac - totdflux(k) = totdflux(k) * flxfac - totuclfl(k) = totuclfl(k) * flxfac - totdclfl(k) = totdclfl(k) * flxfac - enddo - -! --- ... calculate net fluxes and heating rates - fnet(0) = totuflux(0) - totdflux(0) - - do k = 1, nlay - rfdelp(k) = heatfac / delp(k) - fnet(k) = totuflux(k) - totdflux(k) - htr (k) = (fnet(k-1) - fnet(k)) * rfdelp(k) - enddo - -!! --- ... optional clear sky heating rates - if ( lhlw0 ) then - fnetc(0) = totuclfl(0) - totdclfl(0) - - do k = 1, nlay - fnetc(k) = totuclfl(k) - totdclfl(k) - htrcl(k) = (fnetc(k-1) - fnetc(k)) * rfdelp(k) - enddo - endif - -!! --- ... optional spectral band heating rates - if ( lhlwb ) then - do ib = 1, nbands - fnet(0) = (toturad(0,ib) - totdrad(0,ib)) * flxfac - - do k = 1, nlay - fnet(k) = (toturad(k,ib) - totdrad(k,ib)) * flxfac - htrb(k,ib) = (fnet(k-1) - fnet(k)) * rfdelp(k) - enddo - enddo - endif - -! ................................. - end subroutine rtrnmr -! --------------------------------- -!> @} - -!>\ingroup module_radlw_main -!> \brief This subroutine computes the upward/downward radiative fluxes, and -!! heating rates for both clear or cloudy atmosphere.Clouds are treated -!! with the mcica stochastic approach. -!! -!!\param semiss lw surface emissivity -!!\param delp layer pressure thickness (mb) -!!\param cldfmc layer cloud fraction (sub-column) -!!\param taucld layer cloud opt depth -!!\param tautot total optical depth (gas+aerosols) -!!\param pklay integrated planck func at lay temp -!!\param pklev integrated planck func at lev temp -!!\param fracs planck fractions -!!\param secdif secant of diffusivity angle -!!\param nlay number of vertical layers -!!\param nlp1 number of vertical levels (interfaces) -!!\param totuflux total sky upward flux \f$(w/m^2)\f$ -!!\param totdflux total sky downward flux \f$(w/m^2)\f$ -!!\param htr total sky heating rate (k/sec or k/day) -!!\param totuclfl clear sky upward flux \f$(w/m^2)\f$ -!!\param totdclfl clear sky downward flux \f$(w/m^2)\f$ -!!\param htrcl clear sky heating rate (k/sec or k/day) -!!\param htrb spectral band lw heating rate (k/day) -!!\section gen_rtrnmc rtrnmc General Algorithm -!> @{ -! --------------------------------- - subroutine rtrnmc & - & ( semiss,delp,cldfmc,taucld,tautot,pklay,pklev, & ! --- inputs: - & fracs,secdif, nlay,nlp1, & - & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & ! --- outputs: - & ) - -! =================== program usage description =================== ! -! ! -! purpose: compute the upward/downward radiative fluxes, and heating ! -! rates for both clear or cloudy atmosphere. clouds are treated with ! -! the mcica stochastic approach. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -size- ! -! semiss - real, lw surface emissivity nbands! -! delp - real, layer pressure thickness (mb) nlay ! -! cldfmc - real, layer cloud fraction (sub-column) ngptlw*nlay! -! taucld - real, layer cloud opt depth nbands*nlay! -! tautot - real, total optical depth (gas+aerosols) ngptlw*nlay! -! pklay - real, integrated planck func at lay temp nbands*0:nlay! -! pklev - real, integrated planck func at lev temp nbands*0:nlay! -! fracs - real, planck fractions ngptlw*nlay! -! secdif - real, secant of diffusivity angle nbands! -! nlay - integer, number of vertical layers 1 ! -! nlp1 - integer, number of vertical levels (interfaces) 1 ! -! ! -! outputs: ! -! totuflux- real, total sky upward flux (w/m2) 0:nlay ! -! totdflux- real, total sky downward flux (w/m2) 0:nlay ! -! htr - real, total sky heating rate (k/sec or k/day) nlay ! -! totuclfl- real, clear sky upward flux (w/m2) 0:nlay ! -! totdclfl- real, clear sky downward flux (w/m2) 0:nlay ! -! htrcl - real, clear sky heating rate (k/sec or k/day) nlay ! -! htrb - real, spectral band lw heating rate (k/day) nlay*nbands! -! ! -! module veriables: ! -! ngb - integer, band index for each g-value ngptlw! -! fluxfac - real, conversion factor for fluxes (pi*2.e4) 1 ! -! heatfac - real, conversion factor for heating rates (g/cp*1e-2) 1 ! -! tblint - real, conversion factor for look-up tbl (float(ntbl) 1 ! -! bpade - real, pade approx constant (1/0.278) 1 ! -! wtdiff - real, weight for radiance to flux conversion 1 ! -! ntbl - integer, dimension of look-up tables 1 ! -! tau_tbl - real, clr-sky opt dep lookup table 0:ntbl ! -! exp_tbl - real, transmittance lookup table 0:ntbl ! -! tfn_tbl - real, tau transition function 0:ntbl ! -! ! -! local variables: ! -! itgas - integer, index for gases contribution look-up table 1 ! -! ittot - integer, index for gases plus clouds look-up table 1 ! -! reflct - real, surface reflectance 1 ! -! atrgas - real, gaseous absorptivity 1 ! -! atrtot - real, gaseous and cloud absorptivity 1 ! -! odcld - real, cloud optical depth 1 ! -! efclrfr- real, effective clear sky fraction (1-efcldfr) nlay! -! odepth - real, optical depth of gaseous only 1 ! -! odtot - real, optical depth of gas and cloud 1 ! -! gasfac - real, gas-only pade factor, used for planck function 1 ! -! totfac - real, gas and cloud pade factor, used for planck fn 1 ! -! bbdgas - real, gas-only planck function for downward rt 1 ! -! bbugas - real, gas-only planck function for upward rt 1 ! -! bbdtot - real, gas and cloud planck function for downward rt 1 ! -! bbutot - real, gas and cloud planck function for upward rt 1 ! -! gassrcu- real, upwd source radiance due to gas nlay! -! totsrcu- real, upwd source radiance due to gas+cld nlay! -! gassrcd- real, dnwd source radiance due to gas 1 ! -! totsrcd- real, dnwd source radiance due to gas+cld 1 ! -! radtotu- real, spectrally summed total sky upwd radiance 1 ! -! radclru- real, spectrally summed clear sky upwd radiance 1 ! -! radtotd- real, spectrally summed total sky dnwd radiance 1 ! -! radclrd- real, spectrally summed clear sky dnwd radiance 1 ! -! toturad- real, total sky upward radiance by layer 0:nlay*nbands! -! clrurad- real, clear sky upward radiance by layer 0:nlay*nbands! -! totdrad- real, total sky downward radiance by layer 0:nlay*nbands! -! clrdrad- real, clear sky downward radiance by layer 0:nlay*nbands! -! fnet - real, net longwave flux (w/m2) 0:nlay ! -! fnetc - real, clear sky net longwave flux (w/m2) 0:nlay ! -! ! -! ! -! ******************************************************************* ! -! original code description ! -! ! -! original version: e. j. mlawer, et al. rrtm_v3.0 ! -! revision for gcms: michael j. iacono; october, 2002 ! -! revision for f90: michael j. iacono; june, 2006 ! -! ! -! this program calculates the upward fluxes, downward fluxes, and ! -! heating rates for an arbitrary clear or cloudy atmosphere. the input ! -! to this program is the atmospheric profile, all Planck function ! -! information, and the cloud fraction by layer. a variable diffusivity! -! angle (secdif) is used for the angle integration. bands 2-3 and 5-9 ! -! use a value for secdif that varies from 1.50 to 1.80 as a function ! -! of the column water vapor, and other bands use a value of 1.66. the ! -! gaussian weight appropriate to this angle (wtdiff=0.5) is applied ! -! here. note that use of the emissivity angle for the flux integration! -! can cause errors of 1 to 4 W/m2 within cloudy layers. ! -! clouds are treated with the mcica stochastic approach and ! -! maximum-random cloud overlap. ! -! ! -! ******************************************************************* ! -! ====================== end of description block ================= ! - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(nbands), intent(in) :: semiss, & - & secdif - real (kind=kind_phys), dimension(nlay), intent(in) :: delp - - real (kind=kind_phys), dimension(nbands,nlay),intent(in):: taucld - real (kind=kind_phys), dimension(ngptlw,nlay),intent(in):: fracs, & - & tautot, cldfmc - - real (kind=kind_phys), dimension(nbands,0:nlay), intent(in) :: & - & pklev, pklay - -! --- outputs: - real (kind=kind_phys), dimension(nlay), intent(out) :: htr, htrcl - - real (kind=kind_phys), dimension(nlay,nbands),intent(out) :: htrb - - real (kind=kind_phys), dimension(0:nlay), intent(out) :: & - & totuflux, totdflux, totuclfl, totdclfl - -! --- locals: - real (kind=kind_phys), parameter :: rec_6 = 0.166667 - - real (kind=kind_phys), dimension(0:nlay,nbands) :: clrurad, & - & clrdrad, toturad, totdrad - - real (kind=kind_phys), dimension(nlay) :: gassrcu, totsrcu, & - & trngas, efclrfr, rfdelp - real (kind=kind_phys), dimension(0:nlay) :: fnet, fnetc - - real (kind=kind_phys) :: totsrcd, gassrcd, tblind, odepth, odtot, & - & odcld, atrtot, atrgas, reflct, totfac, gasfac, flxfac, & - & plfrac, blay, bbdgas, bbdtot, bbugas, bbutot, dplnku, & - & dplnkd, radtotu, radclru, radtotd, radclrd, rad0, & - & clfm, trng, gasu - - integer :: ittot, itgas, ib, ig, k -! -!===> ... begin here -! - do ib = 1, NBANDS - do k = 0, NLAY - toturad(k,ib) = f_zero - totdrad(k,ib) = f_zero - clrurad(k,ib) = f_zero - clrdrad(k,ib) = f_zero - enddo - enddo - - do k = 0, nlay - totuflux(k) = f_zero - totdflux(k) = f_zero - totuclfl(k) = f_zero - totdclfl(k) = f_zero - enddo - -! --- ... loop over all g-points - - do ig = 1, ngptlw - ib = ngb(ig) - - radtotd = f_zero - radclrd = f_zero - -!> -# Downward radiative transfer loop. -!!\n - Clear sky, gases contribution -!!\n - Total sky, gases+clouds contribution -!!\n - Cloudy layer -!!\n - Total sky radiance -!!\n - Clear sky radiance - - do k = nlay, 1, -1 - -! --- ... clear sky, gases contribution - - odepth = max( f_zero, secdif(ib)*tautot(ig,k) ) - if (odepth <= 0.06) then - atrgas = odepth - 0.5*odepth*odepth - trng = f_one - atrgas - gasfac = rec_6 * odepth - else - tblind = odepth / (bpade + odepth) - itgas = tblint*tblind + 0.5 - trng = exp_tbl(itgas) - atrgas = f_one - trng - gasfac = tfn_tbl(itgas) - odepth = tau_tbl(itgas) - endif - - plfrac = fracs(ig,k) - blay = pklay(ib,k) - - dplnku = pklev(ib,k ) - blay - dplnkd = pklev(ib,k-1) - blay - bbdgas = plfrac * (blay + dplnkd*gasfac) - bbugas = plfrac * (blay + dplnku*gasfac) - gassrcd= bbdgas * atrgas - gassrcu(k)= bbugas * atrgas - trngas(k) = trng - -! --- ... total sky, gases+clouds contribution - - clfm = cldfmc(ig,k) - if (clfm >= eps) then -! --- ... cloudy layer - - odcld = secdif(ib) * taucld(ib,k) - efclrfr(k) = f_one - (f_one - exp(-odcld))*clfm - odtot = odepth + odcld - if (odtot < 0.06) then - totfac = rec_6 * odtot - atrtot = odtot - 0.5*odtot*odtot - else - tblind = odtot / (bpade + odtot) - ittot = tblint*tblind + 0.5 - totfac = tfn_tbl(ittot) - atrtot = f_one - exp_tbl(ittot) - endif - - bbdtot = plfrac * (blay + dplnkd*totfac) - bbutot = plfrac * (blay + dplnku*totfac) - totsrcd= bbdtot * atrtot - totsrcu(k)= bbutot * atrtot - -! --- ... total sky radiance - radtotd = radtotd*trng*efclrfr(k) + gassrcd & - & + clfm*(totsrcd - gassrcd) - totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd - -! --- ... clear sky radiance - radclrd = radclrd*trng + gassrcd - clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd - - else -! --- ... clear layer - -! --- ... total sky radiance - radtotd = radtotd*trng + gassrcd - totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd - -! --- ... clear sky radiance - radclrd = radclrd*trng + gassrcd - clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd - - endif ! end if_clfm_block - - enddo ! end do_k_loop - -!> -# Compute spectral emissivity & reflectance, include the -!! contribution of spectrally varying longwave emissivity and -!! reflection from the surface to the upward radiative transfer. - -! note: spectral and Lambertian reflection are identical for the -! diffusivity angle flux integration used here. - - reflct = f_one - semiss(ib) - rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) - -!> -# Compute total sky radiance. - radtotu = rad0 + reflct*radtotd - toturad(0,ib) = toturad(0,ib) + radtotu - -!> -# Compute clear sky radiance. - radclru = rad0 + reflct*radclrd - clrurad(0,ib) = clrurad(0,ib) + radclru - -!> -# Upward radiative transfer loop. -!!\n - Compute total sky radiance -!!\n - Compute clear sky radiance - -! toturad holds summed radiance for total sky stream -! clrurad holds summed radiance for clear sky stream - - do k = 1, nlay - clfm = cldfmc(ig,k) - trng = trngas(k) - gasu = gassrcu(k) - - if (clfm > eps) then -! --- ... cloudy layer - -! --- ... total sky radiance - radtotu = radtotu*trng*efclrfr(k) + gasu & - & + clfm*(totsrcu(k) - gasu) - toturad(k,ib) = toturad(k,ib) + radtotu - -! --- ... clear sky radiance - radclru = radclru*trng + gasu - clrurad(k,ib) = clrurad(k,ib) + radclru - - else -! --- ... clear layer - -! --- ... total sky radiance - radtotu = radtotu*trng + gasu - toturad(k,ib) = toturad(k,ib) + radtotu - -! --- ... clear sky radiance - radclru = radclru*trng + gasu - clrurad(k,ib) = clrurad(k,ib) + radclru - - endif ! end if_clfm_block - - enddo ! end do_k_loop - - enddo ! end do_ig_loop - -!> -# Process longwave output from band for total and clear streams. -!! Calculate upward, downward, and net flux. - - flxfac = wtdiff * fluxfac - - do k = 0, nlay - do ib = 1, nbands - totuflux(k) = totuflux(k) + toturad(k,ib) - totdflux(k) = totdflux(k) + totdrad(k,ib) - totuclfl(k) = totuclfl(k) + clrurad(k,ib) - totdclfl(k) = totdclfl(k) + clrdrad(k,ib) - enddo - - totuflux(k) = totuflux(k) * flxfac - totdflux(k) = totdflux(k) * flxfac - totuclfl(k) = totuclfl(k) * flxfac - totdclfl(k) = totdclfl(k) * flxfac - enddo - -!> -# Calculate net fluxes and heating rates. - fnet(0) = totuflux(0) - totdflux(0) - - do k = 1, nlay - rfdelp(k) = heatfac / delp(k) - fnet(k) = totuflux(k) - totdflux(k) - htr (k) = (fnet(k-1) - fnet(k)) * rfdelp(k) - enddo - -!> -# Optional clear sky heating rates. - if ( lhlw0 ) then - fnetc(0) = totuclfl(0) - totdclfl(0) - - do k = 1, nlay - fnetc(k) = totuclfl(k) - totdclfl(k) - htrcl(k) = (fnetc(k-1) - fnetc(k)) * rfdelp(k) - enddo - endif - -!> -# Optional spectral band heating rates. - if ( lhlwb ) then - do ib = 1, nbands - fnet(0) = (toturad(0,ib) - totdrad(0,ib)) * flxfac - - do k = 1, nlay - fnet(k) = (toturad(k,ib) - totdrad(k,ib)) * flxfac - htrb(k,ib) = (fnet(k-1) - fnet(k)) * rfdelp(k) - enddo - enddo - endif - -! .................................. - end subroutine rtrnmc -! ---------------------------------- -!> @} - -!>\ingroup module_radlw_main -!>\brief This subroutine contains optical depths developed for the rapid -!! radiative transfer model. -!! -!! It contains the subroutines \a taugbn (where n goes from -!! 1 to 16). \a taugbn calculates the optical depths and planck fractions -!! per g-value and layer for band n. -!!\param laytrop tropopause layer index (unitless) layer at -!! which switch is made for key species -!!\param pavel layer pressures (mb) -!!\param coldry column amount for dry air \f$(mol/cm^2)\f$ -!!\param colamt column amounts of h2o, co2, o3, n2o, ch4,o2, -!! co \f$(mol/cm^2)\f$ -!!\param colbrd column amount of broadening gases -!!\param wx cross-section amounts \f$(mol/cm^2)\f$ -!!\param tauaer aerosol optical depth -!!\param rfrate reference ratios of binary species parameter -!!\n (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o,4-h2o/ch4, -!! 5-n2o/co2,6-o3/co2 -!!\n (:,:,n)n=1,2: the rates of ref press at the 2 -!! sides of the layer -!!\param fac00,fac01,fac10,fac11 factors multiply the reference ks, i,j of 0/1 -!! for lower/higher of the 2 appropriate -!! temperatures and altitudes -!!\param jp index of lower reference pressure -!!\param jt, jt1 indices of lower reference temperatures for -!! pressure levels jp and jp+1, respectively -!!\param selffac scale factor for water vapor self-continuum -!! equals (water vapor density)/(atmospheric -!! density at 296k and 1013 mb) -!!\param selffrac factor for temperature interpolation of -!! reference water vapor self-continuum data -!!\param indself index of lower reference temperature for the -!! self-continuum interpolation -!!\param forfac scale factor for w. v. foreign-continuum -!!\param forfrac factor for temperature interpolation of -!! reference w.v. foreign-continuum data -!!\param indfor index of lower reference temperature for the -!! foreign-continuum interpolation -!!\param minorfrac factor for minor gases -!!\param scaleminor,scaleminorn2 scale factors for minor gases -!!\param indminor index of lower reference temperature for -!! minor gases -!!\param nlay total number of layers -!!\param fracs planck fractions -!!\param tautot total optical depth (gas+aerosols) -!>\section taumol_gen taumol General Algorithm -!! @{ -!! subprograms called: taugb## (## = 01 -16) - subroutine taumol & - & ( laytrop,pavel,coldry,colamt,colbrd,wx,tauaer, & ! --- inputs - & rfrate,fac00,fac01,fac10,fac11,jp,jt,jt1, & - & selffac,selffrac,indself,forfac,forfrac,indfor, & - & minorfrac,scaleminor,scaleminorn2,indminor, & - & nlay, & - & fracs, tautot & ! --- outputs - & ) - -! ************ original subprogram description *************** ! -! ! -! optical depths developed for the ! -! ! -! rapid radiative transfer model (rrtm) ! -! ! -! atmospheric and environmental research, inc. ! -! 131 hartwell avenue ! -! lexington, ma 02421 ! -! ! -! eli j. mlawer ! -! jennifer delamere ! -! steven j. taubman ! -! shepard a. clough ! -! ! -! email: mlawer@aer.com ! -! email: jdelamer@aer.com ! -! ! -! the authors wish to acknowledge the contributions of the ! -! following people: karen cady-pereira, patrick d. brown, ! -! michael j. iacono, ronald e. farren, luke chen, ! -! robert bergstrom. ! -! ! -! revision for g-point reduction: michael j. iacono; aer, inc. ! -! ! -! taumol ! -! ! -! this file contains the subroutines taugbn (where n goes from ! -! 1 to 16). taugbn calculates the optical depths and planck ! -! fractions per g-value and layer for band n. ! -! ! -! ******************************************************************* ! -! ================== program usage description ================== ! -! ! -! call taumol ! -! inputs: ! -! ( laytrop,pavel,coldry,colamt,colbrd,wx,tauaer, ! -! rfrate,fac00,fac01,fac10,fac11,jp,jt,jt1, ! -! selffac,selffrac,indself,forfac,forfrac,indfor, ! -! minorfrac,scaleminor,scaleminorn2,indminor, ! -! nlay, ! -! outputs: ! -! fracs, tautot ) ! -! ! -! subprograms called: taugb## (## = 01 -16) ! -! ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: size ! -! laytrop - integer, tropopause layer index (unitless) 1 ! -! layer at which switch is made for key species ! -! pavel - real, layer pressures (mb) nlay ! -! coldry - real, column amount for dry air (mol/cm2) nlay ! -! colamt - real, column amounts of h2o, co2, o3, n2o, ch4, ! -! o2, co (mol/cm**2) nlay*maxgas! -! colbrd - real, column amount of broadening gases nlay ! -! wx - real, cross-section amounts(mol/cm2) nlay*maxxsec! -! tauaer - real, aerosol optical depth nbands*nlay ! -! rfrate - real, reference ratios of binary species parameter ! -! (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o,4-h2o/ch4,5-n2o/co2,6-o3/co2! -! (:,:,n)n=1,2: the rates of ref press at the 2 sides of the layer ! -! nlay*nrates*2! -! facij - real, factors multiply the reference ks, i,j of 0/1 ! -! for lower/higher of the 2 appropriate temperatures ! -! and altitudes nlay ! -! jp - real, index of lower reference pressure nlay ! -! jt, jt1 - real, indices of lower reference temperatures nlay ! -! for pressure levels jp and jp+1, respectively ! -! selffac - real, scale factor for water vapor self-continuum ! -! equals (water vapor density)/(atmospheric density ! -! at 296k and 1013 mb) nlay ! -! selffrac - real, factor for temperature interpolation of ! -! reference water vapor self-continuum data nlay ! -! indself - integer, index of lower reference temperature for ! -! the self-continuum interpolation nlay ! -! forfac - real, scale factor for w. v. foreign-continuum nlay ! -! forfrac - real, factor for temperature interpolation of ! -! reference w.v. foreign-continuum data nlay ! -! indfor - integer, index of lower reference temperature for ! -! the foreign-continuum interpolation nlay ! -! minorfrac - real, factor for minor gases nlay ! -! scaleminor,scaleminorn2 ! -! - real, scale factors for minor gases nlay ! -! indminor - integer, index of lower reference temperature for ! -! minor gases nlay ! -! nlay - integer, total number of layers 1 ! -! ! -! outputs: ! -! fracs - real, planck fractions ngptlw,nlay! -! tautot - real, total optical depth (gas+aerosols) ngptlw,nlay! -! ! -! internal variables: ! -! ng## - integer, number of g-values in band ## (##=01-16) 1 ! -! nspa - integer, for lower atmosphere, the number of ref ! -! atmos, each has different relative amounts of the ! -! key species for the band nbands! -! nspb - integer, same but for upper atmosphere nbands! -! absa - real, k-values for lower ref atmospheres (no w.v. ! -! self-continuum) (cm**2/molecule) nspa(##)*5*13*ng##! -! absb - real, k-values for high ref atmospheres (all sources) ! -! (cm**2/molecule) nspb(##)*5*13:59*ng##! -! ka_m'mgas'- real, k-values for low ref atmospheres minor species ! -! (cm**2/molecule) mmn##*ng##! -! kb_m'mgas'- real, k-values for high ref atmospheres minor species ! -! (cm**2/molecule) mmn##*ng##! -! selfref - real, k-values for w.v. self-continuum for ref atmos ! -! used below laytrop (cm**2/mol) 10*ng##! -! forref - real, k-values for w.v. foreign-continuum for ref atmos -! used below/above laytrop (cm**2/mol) 4*ng##! -! ! -! ****************************************************************** ! - -! --- inputs: - integer, intent(in) :: nlay, laytrop - - integer, dimension(nlay), intent(in) :: jp, jt, jt1, indself, & - & indfor, indminor - - real (kind=kind_phys), dimension(nlay), intent(in) :: pavel, & - & coldry, colbrd, fac00, fac01, fac10, fac11, selffac, & - & selffrac, forfac, forfrac, minorfrac, scaleminor, & - & scaleminorn2 - - real (kind=kind_phys), dimension(nlay,maxgas), intent(in):: colamt - real (kind=kind_phys), dimension(nlay,maxxsec),intent(in):: wx - - real (kind=kind_phys), dimension(nbands,nlay), intent(in):: tauaer - - real (kind=kind_phys), dimension(nlay,nrates,2), intent(in) :: & - & rfrate - -! --- outputs: - real (kind=kind_phys), dimension(ngptlw,nlay), intent(out) :: & - & fracs, tautot - -! --- locals - real (kind=kind_phys), dimension(ngptlw,nlay) :: taug - - integer :: ib, ig, k -! -!===> ... begin here -! - call taugb01 - call taugb02 - call taugb03 - call taugb04 - call taugb05 - call taugb06 - call taugb07 - call taugb08 - call taugb09 - call taugb10 - call taugb11 - call taugb12 - call taugb13 - call taugb14 - call taugb15 - call taugb16 - -! --- combine gaseous and aerosol optical depths - - do ig = 1, ngptlw - ib = ngb(ig) - - do k = 1, nlay - tautot(ig,k) = taug(ig,k) + tauaer(ib,k) - enddo - enddo - -! ================= - contains -! ================= - -!>\ingroup module_radlw_main -!> band 1: 10-350 cm-1 (low key - h2o; low minor - n2); -!! (high key - h2o; high minor - n2) -! ---------------------------------- - subroutine taugb01 -! .................................. - -! ------------------------------------------------------------------ ! -! written by eli j. mlawer, atmospheric & environmental research. ! -! revised by michael j. iacono, atmospheric & environmental research. ! -! ! -! band 1: 10-350 cm-1 (low key - h2o; low minor - n2) ! -! (high key - h2o; high minor - n2) ! -! ! -! compute the optical depth by interpolating in ln(pressure) and ! -! temperature. below laytrop, the water vapor self-continuum and ! -! foreign continuum is interpolated (in temperature) separately. ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb01 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & indm, indmp, ig - - real (kind=kind_phys) :: pp, corradj, scalen2, tauself, taufor, & - & taun2 -! -!===> ... begin here -! -! --- minor gas mapping levels: -! lower - n2, p = 142.5490 mbar, t = 215.70 k -! upper - n2, p = 142.5490 mbar, t = 215.70 k - -! --- ... lower atmosphere loop - - do k = 1, laytrop - ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(1) + 1 - ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(1) + 1 - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - - pp = pavel(k) - scalen2 = colbrd(k) * scaleminorn2(k) - if (pp < 250.0) then - corradj = f_one - 0.15 * (250.0-pp) / 154.4 - else - corradj = f_one - endif - - do ig = 1, ng01 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - taun2 = scalen2 * (ka_mn2(ig,indm) + minorfrac(k) & - & * (ka_mn2(ig,indmp) - ka_mn2(ig,indm))) - - taug(ig,k) = corradj * (colamt(k,1) & - & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & - & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & - & + tauself + taufor + taun2) - - fracs(ig,k) = fracrefa(ig) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(1) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(1) + 1 - indf = indfor(k) - indm = indminor(k) - - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indfp = indf + 1 - indmp = indm + 1 - - scalen2 = colbrd(k) * scaleminorn2(k) - corradj = f_one - 0.15 * (pavel(k) / 95.6) - - do ig = 1, ng01 - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - taun2 = scalen2 * (kb_mn2(ig,indm) + minorfrac(k) & - & * (kb_mn2(ig,indmp) - kb_mn2(ig,indm))) - - taug(ig,k) = corradj * (colamt(k,1) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & - & + taufor + taun2) - - fracs(ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb01 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 2: 350-500 cm-1 (low key - h2o; high key - h2o) -! ---------------------------------- - subroutine taugb02 -! .................................. - -! ------------------------------------------------------------------ ! -! band 2: 350-500 cm-1 (low key - h2o; high key - h2o) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb02 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & ig - - real (kind=kind_phys) :: corradj, tauself, taufor -! -!===> ... begin here -! -! --- ... lower atmosphere loop - - do k = 1, laytrop - ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(2) + 1 - ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(2) + 1 - inds = indself(k) - indf = indfor(k) - - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indsp = inds + 1 - indfp = indf + 1 - - corradj = f_one - 0.05 * (pavel(k) - 100.0) / 900.0 - - do ig = 1, ng02 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - taug(ns02+ig,k) = corradj * (colamt(k,1) & - & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & - & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & - & + tauself + taufor) - - fracs(ns02+ig,k) = fracrefa(ig) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(2) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(2) + 1 - indf = indfor(k) - - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indfp = indf + 1 - - do ig = 1, ng02 - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - taug(ns02+ig,k) = colamt(k,1) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & - & + taufor - - fracs(ns02+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb02 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o); -!! (high key - h2o,co2; high minor - n2o) -! ---------------------------------- - subroutine taugb03 -! .................................. - -! ------------------------------------------------------------------ ! -! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o) ! -! (high key - h2o,co2; high minor - n2o) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb03 - -! --- locals: - integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & - & id000, id010, id100, id110, id200, id210, jmn2o, jmn2op, & - & id001, id011, id101, id111, id201, id211, jpl, jplp, & - & ig, js, js1 - - real (kind=kind_phys) :: absn2o, ratn2o, adjfac, adjcoln2o, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & refrat_planck_a, refrat_planck_b, refrat_m_a, refrat_m_b, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & tau_major, tau_major1, tauself, taufor, n2om1, n2om2, & - & p, p4, fk0, fk1, fk2 -! -!===> ... begin here -! -! --- ... minor gas mapping levels: -! lower - n2o, p = 706.272 mbar, t = 278.94 k -! upper - n2o, p = 95.58 mbar, t = 215.7 k - - refrat_planck_a = chi_mls(1,9)/chi_mls(2,9) ! P = 212.725 mb - refrat_planck_b = chi_mls(1,13)/chi_mls(2,13) ! P = 95.58 mb - refrat_m_a = chi_mls(1,3)/chi_mls(2,3) ! P = 706.270 mb - refrat_m_b = chi_mls(1,13)/chi_mls(2,13) ! P = 95.58 mb - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(3) + js - - speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(3) + js1 - - speccomb_mn2o = colamt(k,1) + refrat_m_a*colamt(k,2) - specparm_mn2o = colamt(k,1) / speccomb_mn2o - specmult_mn2o = 8.0 * min(specparm_mn2o, oneminus) - jmn2o = 1 + int(specmult_mn2o) - fmn2o = mod(specmult_mn2o, f_one) - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - jmn2op= jmn2o+ 1 - jplp = jpl + 1 - -! --- ... in atmospheres where the amount of n2O is too great to be considered -! a minor species, adjust the column amount of n2O by an empirical factor -! to obtain the proper contribution. - - p = coldry(k) * chi_mls(4,jp(k)+1) - ratn2o = colamt(k,4) / p - if (ratn2o > 1.5) then - adjfac = 0.5 + (ratn2o - 0.5)**0.65 - adjcoln2o = adjfac * p - else - adjcoln2o = colamt(k,4) - endif - - if (specparm < 0.125) then - p = fs - f_one - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - else if (specparm > 0.875) then - p = -fs - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk0 = f_one - fs - fk1 = fs - fk2 = f_zero - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk0*fac00(k) - fac100 = fk1*fac00(k) - fac200 = fk2*fac00(k) - fac010 = fk0*fac10(k) - fac110 = fk1*fac10(k) - fac210 = fk2*fac10(k) - - if (specparm1 < 0.125) then - p = fs1 - f_one - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p = -fs1 - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk0 = f_one - fs1 - fk1 = fs1 - fk2 = f_zero - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk0*fac01(k) - fac101 = fk1*fac01(k) - fac201 = fk2*fac01(k) - fac011 = fk0*fac11(k) - fac111 = fk1*fac11(k) - fac211 = fk2*fac11(k) - - do ig = 1, ng03 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - n2om1 = ka_mn2o(ig,jmn2o,indm) + fmn2o & - & * (ka_mn2o(ig,jmn2op,indm) - ka_mn2o(ig,jmn2o,indm)) - n2om2 = ka_mn2o(ig,jmn2o,indmp) + fmn2o & - & * (ka_mn2o(ig,jmn2op,indmp) - ka_mn2o(ig,jmn2o,indmp)) - absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1) - - tau_major = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) - - tau_major1 = speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) - - taug(ns03+ig,k) = tau_major + tau_major1 & - & + tauself + taufor + adjcoln2o*absn2o - - fracs(ns03+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo ! end do_k_loop - enddo ! end do_ig_loop - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) - specparm = colamt(k,1) / speccomb - specmult = 4.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(3) + js - - speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 4.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(3) + js1 - - speccomb_mn2o = colamt(k,1) + refrat_m_b*colamt(k,2) - specparm_mn2o = colamt(k,1) / speccomb_mn2o - specmult_mn2o = 4.0 * min(specparm_mn2o, oneminus) - jmn2o = 1 + int(specmult_mn2o) - fmn2o = mod(specmult_mn2o, f_one) - - speccomb_planck = colamt(k,1) + refrat_planck_b*colamt(k,2) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 4.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - indf = indfor(k) - indm = indminor(k) - indfp = indf + 1 - indmp = indm + 1 - jmn2op= jmn2o+ 1 - jplp = jpl + 1 - - id000 = ind0 - id010 = ind0 + 5 - id100 = ind0 + 1 - id110 = ind0 + 6 - id001 = ind1 - id011 = ind1 + 5 - id101 = ind1 + 1 - id111 = ind1 + 6 - -! --- ... in atmospheres where the amount of n2o is too great to be considered -! a minor species, adjust the column amount of N2O by an empirical factor -! to obtain the proper contribution. - - p = coldry(k) * chi_mls(4,jp(k)+1) - ratn2o = colamt(k,4) / p - if (ratn2o > 1.5) then - adjfac = 0.5 + (ratn2o - 0.5)**0.65 - adjcoln2o = adjfac * p - else - adjcoln2o = colamt(k,4) - endif - - fk0 = f_one - fs - fk1 = fs - fac000 = fk0*fac00(k) - fac010 = fk0*fac10(k) - fac100 = fk1*fac00(k) - fac110 = fk1*fac10(k) - - fk0 = f_one - fs1 - fk1 = fs1 - fac001 = fk0*fac01(k) - fac011 = fk0*fac11(k) - fac101 = fk1*fac01(k) - fac111 = fk1*fac11(k) - - do ig = 1, ng03 - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - n2om1 = kb_mn2o(ig,jmn2o,indm) + fmn2o & - & * (kb_mn2o(ig,jmn2op,indm) - kb_mn2o(ig,jmn2o,indm)) - n2om2 = kb_mn2o(ig,jmn2o,indmp) + fmn2o & - & * (kb_mn2o(ig,jmn2op,indmp) - kb_mn2o(ig,jmn2o,indmp)) - absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1) - - tau_major = speccomb & - & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) & - & + fac100*absb(ig,id100) + fac110*absb(ig,id110)) - - tau_major1 = speccomb1 & - & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) & - & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) - - taug(ns03+ig,k) = tau_major + tau_major1 & - & + taufor + adjcoln2o*absn2o - - fracs(ns03+ig,k) = fracrefb(ig,jpl) + fpl & - & * (fracrefb(ig,jplp) - fracrefb(ig,jpl)) - enddo - enddo - -! .................................. - end subroutine taugb03 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2) -! ---------------------------------- - subroutine taugb04 -! .................................. - -! ------------------------------------------------------------------ ! -! band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb04 - -! --- locals: - integer :: k, ind0, ind1, inds, indsp, indf, indfp, jpl, jplp, & - & id000, id010, id100, id110, id200, id210, ig, js, js1, & - & id001, id011, id101, id111, id201, id211 - - real (kind=kind_phys) :: tauself, taufor, p, p4, fk0, fk1, fk2, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & refrat_planck_a, refrat_planck_b, tau_major, tau_major1 -! -!===> ... begin here -! - refrat_planck_a = chi_mls(1,11)/chi_mls(2,11) ! P = 142.5940 mb - refrat_planck_b = chi_mls(3,13)/chi_mls(2,13) ! P = 95.58350 mb - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(4) + js - - speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = ( jp(k)*5 + (jt1(k)-1)) * nspa(4) + js1 - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, 1.0) - - inds = indself(k) - indf = indfor(k) - indsp = inds + 1 - indfp = indf + 1 - jplp = jpl + 1 - - if (specparm < 0.125) then - p = fs - f_one - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p = -fs - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk0 = f_one - fs - fk1 = fs - fk2 = f_zero - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk0*fac00(k) - fac100 = fk1*fac00(k) - fac200 = fk2*fac00(k) - fac010 = fk0*fac10(k) - fac110 = fk1*fac10(k) - fac210 = fk2*fac10(k) - - if (specparm1 < 0.125) then - p = fs1 - f_one - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p = -fs1 - p4 = p**4 - fk0 = p4 - fk1 = f_one - p - 2.0*p4 - fk2 = p + p4 - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk0 = f_one - fs1 - fk1 = fs1 - fk2 = f_zero - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk0*fac01(k) - fac101 = fk1*fac01(k) - fac201 = fk2*fac01(k) - fac011 = fk0*fac11(k) - fac111 = fk1*fac11(k) - fac211 = fk2*fac11(k) - - do ig = 1, ng04 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - tau_major = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) - - tau_major1 = speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) - - taug(ns04+ig,k) = tau_major + tau_major1 + tauself + taufor - - fracs(ns04+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo ! end do_k_loop - enddo ! end do_ig_loop - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - speccomb = colamt(k,3) + rfrate(k,6,1)*colamt(k,2) - specparm = colamt(k,3) / speccomb - specmult = 4.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(4) + js - - speccomb1 = colamt(k,3) + rfrate(k,6,2)*colamt(k,2) - specparm1 = colamt(k,3) / speccomb1 - specmult1 = 4.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(4) + js1 - - speccomb_planck = colamt(k,3) + refrat_planck_b*colamt(k,2) - specparm_planck = colamt(k,3) / speccomb_planck - specmult_planck = 4.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - jplp = jpl + 1 - - id000 = ind0 - id010 = ind0 + 5 - id100 = ind0 + 1 - id110 = ind0 + 6 - id001 = ind1 - id011 = ind1 + 5 - id101 = ind1 + 1 - id111 = ind1 + 6 - - fk0 = f_one - fs - fk1 = fs - fac000 = fk0*fac00(k) - fac010 = fk0*fac10(k) - fac100 = fk1*fac00(k) - fac110 = fk1*fac10(k) - - fk0 = f_one - fs1 - fk1 = fs1 - fac001 = fk0*fac01(k) - fac011 = fk0*fac11(k) - fac101 = fk1*fac01(k) - fac111 = fk1*fac11(k) - - do ig = 1, ng04 - tau_major = speccomb & - & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) & - & + fac100*absb(ig,id100) + fac110*absb(ig,id110)) - tau_major1 = speccomb1 & - & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) & - & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) - - taug(ns04+ig,k) = tau_major + tau_major1 - - fracs(ns04+ig,k) = fracrefb(ig,jpl) + fpl & - & * (fracrefb(ig,jplp) - fracrefb(ig,jpl)) - enddo - -! --- ... empirical modification to code to improve stratospheric cooling rates -! for co2. revised to apply weighting for g-point reduction in this band. - - taug(ns04+ 8,k) = taug(ns04+ 8,k) * 0.92 - taug(ns04+ 9,k) = taug(ns04+ 9,k) * 0.88 - taug(ns04+10,k) = taug(ns04+10,k) * 1.07 - taug(ns04+11,k) = taug(ns04+11,k) * 1.1 - taug(ns04+12,k) = taug(ns04+12,k) * 0.99 - taug(ns04+13,k) = taug(ns04+13,k) * 0.88 - taug(ns04+14,k) = taug(ns04+14,k) * 0.943 - enddo - -! .................................. - end subroutine taugb04 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) -!! (high key - o3,co2) -! ---------------------------------- - subroutine taugb05 -! .................................. - -! ------------------------------------------------------------------ ! -! band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) ! -! (high key - o3,co2) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb05 - -! --- locals: - integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & - & id000, id010, id100, id110, id200, id210, jmo3, jmo3p, & - & id001, id011, id101, id111, id201, id211, jpl, jplp, & - & ig, js, js1 - - real (kind=kind_phys) :: tauself, taufor, o3m1, o3m2, abso3, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_mo3, specparm_mo3, specmult_mo3, fmo3, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & refrat_planck_a, refrat_planck_b, refrat_m_a, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 -! -!===> ... begin here -! -! --- ... minor gas mapping level : -! lower - o3, p = 317.34 mbar, t = 240.77 k -! lower - ccl4 - -! --- ... calculate reference ratio to be used in calculation of Planck -! fraction in lower/upper atmosphere. - - refrat_planck_a = chi_mls(1,5)/chi_mls(2,5) ! P = 473.420 mb - refrat_planck_b = chi_mls(3,43)/chi_mls(2,43) ! P = 0.2369 mb - refrat_m_a = chi_mls(1,7)/chi_mls(2,7) ! P = 317.348 mb - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(5) + js - - speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(5) + js1 - - speccomb_mo3 = colamt(k,1) + refrat_m_a*colamt(k,2) - specparm_mo3 = colamt(k,1) / speccomb_mo3 - specmult_mo3 = 8.0 * min(specparm_mo3, oneminus) - jmo3 = 1 + int(specmult_mo3) - fmo3 = mod(specmult_mo3, f_one) - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - jplp = jpl + 1 - jmo3p = jmo3 + 1 - - if (specparm < 0.125) then - p0 = fs - f_one - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p0 = -fs - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk00 = f_one - fs - fk10 = fs - fk20 = f_zero - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk00 * fac00(k) - fac100 = fk10 * fac00(k) - fac200 = fk20 * fac00(k) - fac010 = fk00 * fac10(k) - fac110 = fk10 * fac10(k) - fac210 = fk20 * fac10(k) - - if (specparm1 < 0.125) then - p1 = fs1 - f_one - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p1 = -fs1 - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk01 = f_one - fs1 - fk11 = fs1 - fk21 = f_zero - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk01 * fac01(k) - fac101 = fk11 * fac01(k) - fac201 = fk21 * fac01(k) - fac011 = fk01 * fac11(k) - fac111 = fk11 * fac11(k) - fac211 = fk21 * fac11(k) - - do ig = 1, ng05 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - o3m1 = ka_mo3(ig,jmo3,indm) + fmo3 & - & * (ka_mo3(ig,jmo3p,indm) - ka_mo3(ig,jmo3,indm)) - o3m2 = ka_mo3(ig,jmo3,indmp) + fmo3 & - & * (ka_mo3(ig,jmo3p,indmp) - ka_mo3(ig,jmo3,indmp)) - abso3 = o3m1 + minorfrac(k)*(o3m2 - o3m1) - - taug(ns05+ig,k) = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & - & + speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor+abso3*colamt(k,3)+wx(k,1)*ccl4(ig) - - fracs(ns05+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - speccomb = colamt(k,3) + rfrate(k,6,1)*colamt(k,2) - specparm = colamt(k,3) / speccomb - specmult = 4.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(5) + js - - speccomb1 = colamt(k,3) + rfrate(k,6,2)*colamt(k,2) - specparm1 = colamt(k,3) / speccomb1 - specmult1 = 4.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(5) + js1 - - speccomb_planck = colamt(k,3) + refrat_planck_b*colamt(k,2) - specparm_planck = colamt(k,3) / speccomb_planck - specmult_planck = 4.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - jplp= jpl + 1 - - id000 = ind0 - id010 = ind0 + 5 - id100 = ind0 + 1 - id110 = ind0 + 6 - id001 = ind1 - id011 = ind1 + 5 - id101 = ind1 + 1 - id111 = ind1 + 6 - - fk00 = f_one - fs - fk10 = fs - - fk01 = f_one - fs1 - fk11 = fs1 - - fac000 = fk00 * fac00(k) - fac010 = fk00 * fac10(k) - fac100 = fk10 * fac00(k) - fac110 = fk10 * fac10(k) - - fac001 = fk01 * fac01(k) - fac011 = fk01 * fac11(k) - fac101 = fk11 * fac01(k) - fac111 = fk11 * fac11(k) - - do ig = 1, ng05 - taug(ns05+ig,k) = speccomb & - & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) & - & + fac100*absb(ig,id100) + fac110*absb(ig,id110)) & - & + speccomb1 & - & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) & - & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) & - & + wx(k,1) * ccl4(ig) - - fracs(ns05+ig,k) = fracrefb(ig,jpl) + fpl & - & * (fracrefb(ig,jplp) - fracrefb(ig,jpl)) - enddo - enddo - -! .................................. - end subroutine taugb05 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 6: 820-980 cm-1 (low key - h2o; low minor - co2) -!! (high key - none; high minor - cfc11, cfc12) -! ---------------------------------- - subroutine taugb06 -! .................................. - -! ------------------------------------------------------------------ ! -! band 6: 820-980 cm-1 (low key - h2o; low minor - co2) ! -! (high key - none; high minor - cfc11, cfc12) -! ------------------------------------------------------------------ ! - - use module_radlw_kgb06 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & indm, indmp, ig - - real (kind=kind_phys) :: ratco2, adjfac, adjcolco2, tauself, & - & taufor, absco2, temp -! -!===> ... begin here -! -! --- ... minor gas mapping level: -! lower - co2, p = 706.2720 mb, t = 294.2 k -! upper - cfc11, cfc12 - -! --- ... lower atmosphere loop - - do k = 1, laytrop - ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(6) + 1 - ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(6) + 1 - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - ind0p = ind0 + 1 - ind1p = ind1 + 1 - -! --- ... in atmospheres where the amount of co2 is too great to be considered -! a minor species, adjust the column amount of co2 by an empirical factor -! to obtain the proper contribution. - - temp = coldry(k) * chi_mls(2,jp(k)+1) - ratco2 = colamt(k,2) / temp - if (ratco2 > 3.0) then - adjfac = 2.0 + (ratco2-2.0)**0.77 - adjcolco2 = adjfac * temp - else - adjcolco2 = colamt(k,2) - endif - - do ig = 1, ng06 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - absco2 = ka_mco2(ig,indm) + minorfrac(k) & - & * (ka_mco2(ig,indmp) - ka_mco2(ig,indm)) - - taug(ns06+ig,k) = colamt(k,1) & - & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & - & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & - & + tauself + taufor + adjcolco2*absco2 & - & + wx(k,2)*cfc11adj(ig) + wx(k,3)*cfc12(ig) - - fracs(ns06+ig,k) = fracrefa(ig) - enddo - enddo - -! --- ... upper atmosphere loop -! nothing important goes on above laytrop in this band. - - do k = laytrop+1, nlay - do ig = 1, ng06 - taug(ns06+ig,k) = wx(k,2)*cfc11adj(ig) + wx(k,3)*cfc12(ig) - - fracs(ns06+ig,k) = fracrefa(ig) - enddo - enddo - -! .................................. - end subroutine taugb06 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2) -!! (high key - o3; high minor - co2) -! ---------------------------------- - subroutine taugb07 -! .................................. - -! ------------------------------------------------------------------ ! -! band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2) ! -! (high key - o3; high minor - co2) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb07 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & id000, id010, id100, id110, id200, id210, indm, indmp, & - & id001, id011, id101, id111, id201, id211, jmco2, jmco2p, & - & jpl, jplp, ig, js, js1 - - real (kind=kind_phys) :: tauself, taufor, co2m1, co2m2, absco2, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_mco2, specparm_mco2, specmult_mco2, fmco2, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & refrat_planck_a, refrat_m_a, ratco2, adjfac, adjcolco2, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp -! -!===> ... begin here -! -! --- ... minor gas mapping level : -! lower - co2, p = 706.2620 mbar, t= 278.94 k -! upper - co2, p = 12.9350 mbar, t = 234.01 k - -! --- ... calculate reference ratio to be used in calculation of Planck -! fraction in lower atmosphere. - - refrat_planck_a = chi_mls(1,3)/chi_mls(3,3) ! P = 706.2620 mb - refrat_m_a = chi_mls(1,3)/chi_mls(3,3) ! P = 706.2720 mb - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,2,1)*colamt(k,3) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(7) + js - - speccomb1 = colamt(k,1) + rfrate(k,2,2)*colamt(k,3) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(7) + js1 - - speccomb_mco2 = colamt(k,1) + refrat_m_a*colamt(k,3) - specparm_mco2 = colamt(k,1) / speccomb_mco2 - specmult_mco2 = 8.0 * min(specparm_mco2, oneminus) - jmco2 = 1 + int(specmult_mco2) - fmco2 = mod(specmult_mco2, f_one) - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,3) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - jplp = jpl + 1 - jmco2p= jmco2+ 1 - ind0p = ind0 + 1 - ind1p = ind1 + 1 - -! --- ... in atmospheres where the amount of CO2 is too great to be considered -! a minor species, adjust the column amount of CO2 by an empirical factor -! to obtain the proper contribution. - - temp = coldry(k) * chi_mls(2,jp(k)+1) - ratco2 = colamt(k,2) / temp - if (ratco2 > 3.0) then - adjfac = 3.0 + (ratco2-3.0)**0.79 - adjcolco2 = adjfac * temp - else - adjcolco2 = colamt(k,2) - endif - - if (specparm < 0.125) then - p0 = fs - f_one - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p0 = -fs - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk00 = f_one - fs - fk10 = fs - fk20 = f_zero - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk00 * fac00(k) - fac100 = fk10 * fac00(k) - fac200 = fk20 * fac00(k) - fac010 = fk00 * fac10(k) - fac110 = fk10 * fac10(k) - fac210 = fk20 * fac10(k) - - if (specparm1 < 0.125) then - p1 = fs1 - f_one - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p1 = -fs1 - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk01 = f_one - fs1 - fk11 = fs1 - fk21 = f_zero - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk01 * fac01(k) - fac101 = fk11 * fac01(k) - fac201 = fk21 * fac01(k) - fac011 = fk01 * fac11(k) - fac111 = fk11 * fac11(k) - fac211 = fk21 * fac11(k) - - do ig = 1, ng07 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 & - & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm)) - co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 & - & * (ka_mco2(ig,jmco2p,indmp) - ka_mco2(ig,jmco2,indmp)) - absco2 = co2m1 + minorfrac(k) * (co2m2 - co2m1) - - taug(ns07+ig,k) = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & - & + speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor + adjcolco2*absco2 - - fracs(ns07+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo - enddo - -! --- ... upper atmosphere loop - -! --- ... in atmospheres where the amount of co2 is too great to be considered -! a minor species, adjust the column amount of co2 by an empirical factor -! to obtain the proper contribution. - - do k = laytrop+1, nlay - temp = coldry(k) * chi_mls(2,jp(k)+1) - ratco2 = colamt(k,2) / temp - if (ratco2 > 3.0) then - adjfac = 2.0 + (ratco2-2.0)**0.79 - adjcolco2 = adjfac * temp - else - adjcolco2 = colamt(k,2) - endif - - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(7) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(7) + 1 - - indm = indminor(k) - indmp = indm + 1 - ind0p = ind0 + 1 - ind1p = ind1 + 1 - - do ig = 1, ng07 - absco2 = kb_mco2(ig,indm) + minorfrac(k) & - & * (kb_mco2(ig,indmp) - kb_mco2(ig,indm)) - - taug(ns07+ig,k) = colamt(k,3) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & - & + adjcolco2 * absco2 - - fracs(ns07+ig,k) = fracrefb(ig) - enddo - -! --- ... empirical modification to code to improve stratospheric cooling rates -! for o3. revised to apply weighting for g-point reduction in this band. - - taug(ns07+ 6,k) = taug(ns07+ 6,k) * 0.92 - taug(ns07+ 7,k) = taug(ns07+ 7,k) * 0.88 - taug(ns07+ 8,k) = taug(ns07+ 8,k) * 1.07 - taug(ns07+ 9,k) = taug(ns07+ 9,k) * 1.1 - taug(ns07+10,k) = taug(ns07+10,k) * 0.99 - taug(ns07+11,k) = taug(ns07+11,k) * 0.855 - enddo - -! .................................. - end subroutine taugb07 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) -!! (high key - o3; high minor - co2, n2o) -! ---------------------------------- - subroutine taugb08 -! .................................. - -! ------------------------------------------------------------------ ! -! band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) ! -! (high key - o3; high minor - co2, n2o) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb08 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & indm, indmp, ig - - real (kind=kind_phys) :: tauself, taufor, absco2, abso3, absn2o, & - & ratco2, adjfac, adjcolco2, temp -! -!===> ... begin here -! -! --- ... minor gas mapping level: -! lower - co2, p = 1053.63 mb, t = 294.2 k -! lower - o3, p = 317.348 mb, t = 240.77 k -! lower - n2o, p = 706.2720 mb, t= 278.94 k -! lower - cfc12,cfc11 -! upper - co2, p = 35.1632 mb, t = 223.28 k -! upper - n2o, p = 8.716e-2 mb, t = 226.03 k - -! --- ... lower atmosphere loop - - do k = 1, laytrop - ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(8) + 1 - ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(8) + 1 - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - -! --- ... in atmospheres where the amount of co2 is too great to be considered -! a minor species, adjust the column amount of co2 by an empirical factor -! to obtain the proper contribution. - - temp = coldry(k) * chi_mls(2,jp(k)+1) - ratco2 = colamt(k,2) / temp - if (ratco2 > 3.0) then - adjfac = 2.0 + (ratco2-2.0)**0.65 - adjcolco2 = adjfac * temp - else - adjcolco2 = colamt(k,2) - endif - - do ig = 1, ng08 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - absco2 = (ka_mco2(ig,indm) + minorfrac(k) & - & * (ka_mco2(ig,indmp) - ka_mco2(ig,indm))) - abso3 = (ka_mo3(ig,indm) + minorfrac(k) & - & * (ka_mo3(ig,indmp) - ka_mo3(ig,indm))) - absn2o = (ka_mn2o(ig,indm) + minorfrac(k) & - & * (ka_mn2o(ig,indmp) - ka_mn2o(ig,indm))) - - taug(ns08+ig,k) = colamt(k,1) & - & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & - & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & - & + tauself+taufor + adjcolco2*absco2 & - & + colamt(k,3)*abso3 + colamt(k,4)*absn2o & - & + wx(k,3)*cfc12(ig) + wx(k,4)*cfc22adj(ig) - - fracs(ns08+ig,k) = fracrefa(ig) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(8) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(8) + 1 - - indm = indminor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indmp = indm + 1 - -! --- ... in atmospheres where the amount of co2 is too great to be considered -! a minor species, adjust the column amount of co2 by an empirical factor -! to obtain the proper contribution. - - temp = coldry(k) * chi_mls(2,jp(k)+1) - ratco2 = colamt(k,2) / temp - if (ratco2 > 3.0) then - adjfac = 2.0 + (ratco2-2.0)**0.65 - adjcolco2 = adjfac * temp - else - adjcolco2 = colamt(k,2) - endif - - do ig = 1, ng08 - absco2 = (kb_mco2(ig,indm) + minorfrac(k) & - & * (kb_mco2(ig,indmp) - kb_mco2(ig,indm))) - absn2o = (kb_mn2o(ig,indm) + minorfrac(k) & - & * (kb_mn2o(ig,indmp) - kb_mn2o(ig,indm))) - - taug(ns08+ig,k) = colamt(k,3) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & - & + adjcolco2*absco2 + colamt(k,4)*absn2o & - & + wx(k,3)*cfc12(ig) + wx(k,4)*cfc22adj(ig) - - fracs(ns08+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb08 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) -!! (high key - ch4; high minor - n2o) -! ---------------------------------- - subroutine taugb09 -! .................................. - -! ------------------------------------------------------------------ ! -! band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) ! -! (high key - ch4; high minor - n2o) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb09 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & id000, id010, id100, id110, id200, id210, indm, indmp, & - & id001, id011, id101, id111, id201, id211, jmn2o, jmn2op, & - & jpl, jplp, ig, js, js1 - - real (kind=kind_phys) :: tauself, taufor, n2om1, n2om2, absn2o, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & refrat_planck_a, refrat_m_a, ratn2o, adjfac, adjcoln2o, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp -! -!===> ... begin here -! -! --- ... minor gas mapping level : -! lower - n2o, p = 706.272 mbar, t = 278.94 k -! upper - n2o, p = 95.58 mbar, t = 215.7 k - -! --- ... calculate reference ratio to be used in calculation of Planck -! fraction in lower/upper atmosphere. - - refrat_planck_a = chi_mls(1,9)/chi_mls(6,9) ! P = 212 mb - refrat_m_a = chi_mls(1,3)/chi_mls(6,3) ! P = 706.272 mb - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,4,1)*colamt(k,5) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(9) + js - - speccomb1 = colamt(k,1) + rfrate(k,4,2)*colamt(k,5) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(9) + js1 - - speccomb_mn2o = colamt(k,1) + refrat_m_a*colamt(k,5) - specparm_mn2o = colamt(k,1) / speccomb_mn2o - specmult_mn2o = 8.0 * min(specparm_mn2o, oneminus) - jmn2o = 1 + int(specmult_mn2o) - fmn2o = mod(specmult_mn2o, f_one) - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,5) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - jplp = jpl + 1 - jmn2op= jmn2o+ 1 - -! --- ... in atmospheres where the amount of n2o is too great to be considered -! a minor species, adjust the column amount of n2o by an empirical factor -! to obtain the proper contribution. - - temp = coldry(k) * chi_mls(4,jp(k)+1) - ratn2o = colamt(k,4) / temp - if (ratn2o > 1.5) then - adjfac = 0.5 + (ratn2o-0.5)**0.65 - adjcoln2o = adjfac * temp - else - adjcoln2o = colamt(k,4) - endif - - if (specparm < 0.125) then - p0 = fs - f_one - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p0 = -fs - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk00 = f_one - fs - fk10 = fs - fk20 = f_zero - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk00 * fac00(k) - fac100 = fk10 * fac00(k) - fac200 = fk20 * fac00(k) - fac010 = fk00 * fac10(k) - fac110 = fk10 * fac10(k) - fac210 = fk20 * fac10(k) - - if (specparm1 < 0.125) then - p1 = fs1 - f_one - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p1 = -fs1 - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk01 = f_one - fs1 - fk11 = fs1 - fk21 = f_zero - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk01 * fac01(k) - fac101 = fk11 * fac01(k) - fac201 = fk21 * fac01(k) - fac011 = fk01 * fac11(k) - fac111 = fk11 * fac11(k) - fac211 = fk21 * fac11(k) - - do ig = 1, ng09 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - n2om1 = ka_mn2o(ig,jmn2o,indm) + fmn2o & - & * (ka_mn2o(ig,jmn2op,indm) - ka_mn2o(ig,jmn2o,indm)) - n2om2 = ka_mn2o(ig,jmn2o,indmp) + fmn2o & - & * (ka_mn2o(ig,jmn2op,indmp) - ka_mn2o(ig,jmn2o,indmp)) - absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1) - - taug(ns09+ig,k) = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & - & + speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor + adjcoln2o*absn2o - - fracs(ns09+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(9) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(9) + 1 - - indm = indminor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indmp = indm + 1 - -! --- ... in atmospheres where the amount of n2o is too great to be considered -! a minor species, adjust the column amount of n2o by an empirical factor -! to obtain the proper contribution. - - temp = coldry(k) * chi_mls(4,jp(k)+1) - ratn2o = colamt(k,4) / temp - if (ratn2o > 1.5) then - adjfac = 0.5 + (ratn2o - 0.5)**0.65 - adjcoln2o = adjfac * temp - else - adjcoln2o = colamt(k,4) - endif - - do ig = 1, ng09 - absn2o = kb_mn2o(ig,indm) + minorfrac(k) & - & * (kb_mn2o(ig,indmp) - kb_mn2o(ig,indm)) - - taug(ns09+ig,k) = colamt(k,5) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & - & + adjcoln2o*absn2o - - fracs(ns09+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb09 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o) -! ---------------------------------- - subroutine taugb10 -! .................................. - -! ------------------------------------------------------------------ ! -! band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb10 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & ig - - real (kind=kind_phys) :: tauself, taufor -! -!===> ... begin here -! -! --- ... lower atmosphere loop - - do k = 1, laytrop - ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(10) + 1 - ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(10) + 1 - - inds = indself(k) - indf = indfor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indsp = inds + 1 - indfp = indf + 1 - - do ig = 1, ng10 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - taug(ns10+ig,k) = colamt(k,1) & - & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & - & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & - & + tauself + taufor - - fracs(ns10+ig,k) = fracrefa(ig) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(10) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(10) + 1 - - indf = indfor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indfp = indf + 1 - - do ig = 1, ng10 - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - taug(ns10+ig,k) = colamt(k,1) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & - & + taufor - - fracs(ns10+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb10 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) -!! (high key - h2o; high minor - o2) -! ---------------------------------- - subroutine taugb11 -! .................................. - -! ------------------------------------------------------------------ ! -! band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) ! -! (high key - h2o; high minor - o2) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb11 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & indm, indmp, ig - - real (kind=kind_phys) :: scaleo2, tauself, taufor, tauo2 -! -!===> ... begin here -! -! --- ... minor gas mapping level : -! lower - o2, p = 706.2720 mbar, t = 278.94 k -! upper - o2, p = 4.758820 mbarm t = 250.85 k - -! --- ... lower atmosphere loop - - do k = 1, laytrop - ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(11) + 1 - ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(11) + 1 - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - - scaleo2 = colamt(k,6) * scaleminor(k) - - do ig = 1, ng11 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - tauo2 = scaleo2 * (ka_mo2(ig,indm) + minorfrac(k) & - & * (ka_mo2(ig,indmp) - ka_mo2(ig,indm))) - - taug(ns11+ig,k) = colamt(k,1) & - & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & - & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & - & + tauself + taufor + tauo2 - - fracs(ns11+ig,k) = fracrefa(ig) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(11) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(11) + 1 - - indf = indfor(k) - indm = indminor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indfp = indf + 1 - indmp = indm + 1 - - scaleo2 = colamt(k,6) * scaleminor(k) - - do ig = 1, ng11 - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - tauo2 = scaleo2 * (kb_mo2(ig,indm) + minorfrac(k) & - & * (kb_mo2(ig,indmp) - kb_mo2(ig,indm))) - - taug(ns11+ig,k) = colamt(k,1) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & - & + taufor + tauo2 - - fracs(ns11+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb11 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) -! ---------------------------------- - subroutine taugb12 -! .................................. - -! ------------------------------------------------------------------ ! -! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb12 - -! --- locals: - integer :: k, ind0, ind1, inds, indsp, indf, indfp, jpl, jplp, & - & id000, id010, id100, id110, id200, id210, ig, js, js1, & - & id001, id011, id101, id111, id201, id211 - - real (kind=kind_phys) :: tauself, taufor, refrat_planck_a, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 -! -!===> ... begin here -! -! --- ... calculate reference ratio to be used in calculation of Planck -! fraction in lower/upper atmosphere. - - refrat_planck_a = chi_mls(1,10)/chi_mls(2,10) ! P = 174.164 mb - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(12) + js - - speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(12) + js1 - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) - specparm_planck = colamt(k,1) / speccomb_planck - if (specparm_planck >= oneminus) specparm_planck=oneminus - specmult_planck = 8.0 * specparm_planck - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - inds = indself(k) - indf = indfor(k) - indsp = inds + 1 - indfp = indf + 1 - jplp = jpl + 1 - - if (specparm < 0.125) then - p0 = fs - f_one - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p0 = -fs - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk00 = f_one - fs - fk10 = fs - fk20 = f_zero - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk00 * fac00(k) - fac100 = fk10 * fac00(k) - fac200 = fk20 * fac00(k) - fac010 = fk00 * fac10(k) - fac110 = fk10 * fac10(k) - fac210 = fk20 * fac10(k) - - if (specparm1 < 0.125) then - p1 = fs1 - f_one - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p1 = -fs1 - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk01 = f_one - fs1 - fk11 = fs1 - fk21 = f_zero - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk01 * fac01(k) - fac101 = fk11 * fac01(k) - fac201 = fk21 * fac01(k) - fac011 = fk01 * fac11(k) - fac111 = fk11 * fac11(k) - fac211 = fk21 * fac11(k) - - do ig = 1, ng12 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - taug(ns12+ig,k) = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & - & + speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor - - fracs(ns12+ig,k) = fracrefa(ig,jpl) + fpl & - & *(fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - do ig = 1, ng12 - taug(ns12+ig,k) = f_zero - fracs(ns12+ig,k) = f_zero - enddo - enddo - -! .................................. - end subroutine taugb12 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 13: 2080-2250 cm-1 (low key-h2o,n2o; high minor-o3 minor) -! ---------------------------------- - subroutine taugb13 -! .................................. - -! ------------------------------------------------------------------ ! -! band 13: 2080-2250 cm-1 (low key-h2o,n2o; high minor-o3 minor) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb13 - -! --- locals: - integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & - & id000, id010, id100, id110, id200, id210, jmco2, jpl, & - & id001, id011, id101, id111, id201, id211, jmco2p, jplp, & - & jmco, jmcop, ig, js, js1 - - real (kind=kind_phys) :: tauself, taufor, co2m1, co2m2, absco2, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_mco2, specparm_mco2, specmult_mco2, fmco2, & - & speccomb_mco, specparm_mco, specmult_mco, fmco, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & refrat_planck_a, refrat_m_a, refrat_m_a3, ratco2, & - & adjfac, adjcolco2, com1, com2, absco, abso3, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp -! -!===> ... begin here -! -! --- ... minor gas mapping levels : -! lower - co2, p = 1053.63 mb, t = 294.2 k -! lower - co, p = 706 mb, t = 278.94 k -! upper - o3, p = 95.5835 mb, t = 215.7 k - -! --- ... calculate reference ratio to be used in calculation of Planck -! fraction in lower/upper atmosphere. - - refrat_planck_a = chi_mls(1,5)/chi_mls(4,5) ! P = 473.420 mb (Level 5) - refrat_m_a = chi_mls(1,1)/chi_mls(4,1) ! P = 1053. (Level 1) - refrat_m_a3 = chi_mls(1,3)/chi_mls(4,3) ! P = 706. (Level 3) - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,3,1)*colamt(k,4) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(13) + js - - speccomb1 = colamt(k,1) + rfrate(k,3,2)*colamt(k,4) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(13) + js1 - - speccomb_mco2 = colamt(k,1) + refrat_m_a*colamt(k,4) - specparm_mco2 = colamt(k,1) / speccomb_mco2 - specmult_mco2 = 8.0 * min(specparm_mco2, oneminus) - jmco2 = 1 + int(specmult_mco2) - fmco2 = mod(specmult_mco2, f_one) - -! --- ... in atmospheres where the amount of co2 is too great to be considered -! a minor species, adjust the column amount of co2 by an empirical factor -! to obtain the proper contribution. - - speccomb_mco = colamt(k,1) + refrat_m_a3*colamt(k,4) - specparm_mco = colamt(k,1) / speccomb_mco - specmult_mco = 8.0 * min(specparm_mco, oneminus) - jmco = 1 + int(specmult_mco) - fmco = mod(specmult_mco, f_one) - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,4) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - jplp = jpl + 1 - jmco2p= jmco2+ 1 - jmcop = jmco + 1 - -! --- ... in atmospheres where the amount of co2 is too great to be considered -! a minor species, adjust the column amount of co2 by an empirical factor -! to obtain the proper contribution. - - temp = coldry(k) * 3.55e-4 - ratco2 = colamt(k,2) / temp - if (ratco2 > 3.0) then - adjfac = 2.0 + (ratco2-2.0)**0.68 - adjcolco2 = adjfac * temp - else - adjcolco2 = colamt(k,2) - endif - - if (specparm < 0.125) then - p0 = fs - f_one - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p0 = -fs - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk00 = f_one - fs - fk10 = fs - fk20 = f_zero - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk00 * fac00(k) - fac100 = fk10 * fac00(k) - fac200 = fk20 * fac00(k) - fac010 = fk00 * fac10(k) - fac110 = fk10 * fac10(k) - fac210 = fk20 * fac10(k) - - if (specparm1 < 0.125) then - p1 = fs1 - f_one - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p1 = -fs1 - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk01 = f_one - fs1 - fk11 = fs1 - fk21 = f_zero - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk01 * fac01(k) - fac101 = fk11 * fac01(k) - fac201 = fk21 * fac01(k) - fac011 = fk01 * fac11(k) - fac111 = fk11 * fac11(k) - fac211 = fk21 * fac11(k) - - do ig = 1, ng13 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 & - & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm)) - co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 & - & * (ka_mco2(ig,jmco2p,indmp) - ka_mco2(ig,jmco2,indmp)) - absco2 = co2m1 + minorfrac(k) * (co2m2 - co2m1) - com1 = ka_mco(ig,jmco,indm) + fmco & - & * (ka_mco(ig,jmcop,indm) - ka_mco(ig,jmco,indm)) - com2 = ka_mco(ig,jmco,indmp) + fmco & - & * (ka_mco(ig,jmcop,indmp) - ka_mco(ig,jmco,indmp)) - absco = com1 + minorfrac(k) * (com2 - com1) - - taug(ns13+ig,k) = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & - & + speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor + adjcolco2*absco2 & - & + colamt(k,7)*absco - - fracs(ns13+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - indm = indminor(k) - indmp = indm + 1 - - do ig = 1, ng13 - abso3 = kb_mo3(ig,indm) + minorfrac(k) & - & * (kb_mo3(ig,indmp) - kb_mo3(ig,indm)) - - taug(ns13+ig,k) = colamt(k,3)*abso3 - - fracs(ns13+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb13 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 14: 2250-2380 cm-1 (low - co2; high - co2) -! ---------------------------------- - subroutine taugb14 -! .................................. - -! ------------------------------------------------------------------ ! -! band 14: 2250-2380 cm-1 (low - co2; high - co2) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb14 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & ig - - real (kind=kind_phys) :: tauself, taufor -! -!===> ... begin here -! -! --- ... lower atmosphere loop - - do k = 1, laytrop - ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(14) + 1 - ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(14) + 1 - - inds = indself(k) - indf = indfor(k) - ind0p = ind0 + 1 - ind1p = ind1 + 1 - indsp = inds + 1 - indfp = indf + 1 - - do ig = 1, ng14 - tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - taug(ns14+ig,k) = colamt(k,2) & - & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & - & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & - & + tauself + taufor - - fracs(ns14+ig,k) = fracrefa(ig) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(14) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(14) + 1 - - ind0p = ind0 + 1 - ind1p = ind1 + 1 - - do ig = 1, ng14 - taug(ns14+ig,k) = colamt(k,2) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) - - fracs(ns14+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb14 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) -!! (high - nothing) -! ---------------------------------- - subroutine taugb15 -! .................................. - -! ------------------------------------------------------------------ ! -! band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) ! -! (high - nothing) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb15 - -! --- locals: - integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & - & id000, id010, id100, id110, id200, id210, jpl, jplp, & - & id001, id011, id101, id111, id201, id211, jmn2, jmn2p, & - & ig, js, js1 - - real (kind=kind_phys) :: scalen2, tauself, taufor, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_mn2, specparm_mn2, specmult_mn2, fmn2, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & refrat_planck_a, refrat_m_a, n2m1, n2m2, taun2, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 -! -!===> ... begin here -! -! --- ... minor gas mapping level : -! lower - nitrogen continuum, P = 1053., T = 294. - -! --- ... calculate reference ratio to be used in calculation of Planck -! fraction in lower atmosphere. - - refrat_planck_a = chi_mls(4,1)/chi_mls(2,1) ! P = 1053. mb (Level 1) - refrat_m_a = chi_mls(4,1)/chi_mls(2,1) ! P = 1053. mb - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,4) + rfrate(k,5,1)*colamt(k,2) - specparm = colamt(k,4) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(15) + js - - speccomb1 = colamt(k,4) + rfrate(k,5,2)*colamt(k,2) - specparm1 = colamt(k,4) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(15) + js1 - - speccomb_mn2 = colamt(k,4) + refrat_m_a*colamt(k,2) - specparm_mn2 = colamt(k,4) / speccomb_mn2 - specmult_mn2 = 8.0 * min(specparm_mn2, oneminus) - jmn2 = 1 + int(specmult_mn2) - fmn2 = mod(specmult_mn2, f_one) - - speccomb_planck = colamt(k,4) + refrat_planck_a*colamt(k,2) - specparm_planck = colamt(k,4) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - scalen2 = colbrd(k) * scaleminor(k) - - inds = indself(k) - indf = indfor(k) - indm = indminor(k) - indsp = inds + 1 - indfp = indf + 1 - indmp = indm + 1 - jplp = jpl + 1 - jmn2p = jmn2 + 1 - - if (specparm < 0.125) then - p0 = fs - f_one - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p0 = -fs - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk00 = f_one - fs - fk10 = fs - fk20 = f_zero - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk00 * fac00(k) - fac100 = fk10 * fac00(k) - fac200 = fk20 * fac00(k) - fac010 = fk00 * fac10(k) - fac110 = fk10 * fac10(k) - fac210 = fk20 * fac10(k) - - if (specparm1 < 0.125) then - p1 = fs1 - f_one - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p1 = -fs1 - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk01 = f_one - fs1 - fk11 = fs1 - fk21 = f_zero - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk01 * fac01(k) - fac101 = fk11 * fac01(k) - fac201 = fk21 * fac01(k) - fac011 = fk01 * fac11(k) - fac111 = fk11 * fac11(k) - fac211 = fk21 * fac11(k) - - do ig = 1, ng15 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - n2m1 = ka_mn2(ig,jmn2,indm) + fmn2 & - & * (ka_mn2(ig,jmn2p,indm) - ka_mn2(ig,jmn2,indm)) - n2m2 = ka_mn2(ig,jmn2,indmp) + fmn2 & - & * (ka_mn2(ig,jmn2p,indmp) - ka_mn2(ig,jmn2,indmp)) - taun2 = scalen2 * (n2m1 + minorfrac(k) * (n2m2 - n2m1)) - - taug(ns15+ig,k) = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & - & + speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor + taun2 - - fracs(ns15+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - do ig = 1, ng15 - taug(ns15+ig,k) = f_zero - - fracs(ns15+ig,k) = f_zero - enddo - enddo - -! .................................. - end subroutine taugb15 -! ---------------------------------- - -!>\ingroup module_radlw_main -!> Band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) -! ---------------------------------- - subroutine taugb16 -! .................................. - -! ------------------------------------------------------------------ ! -! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) ! -! ------------------------------------------------------------------ ! - - use module_radlw_kgb16 - -! --- locals: - integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & - & id000, id010, id100, id110, id200, id210, jpl, jplp, & - & id001, id011, id101, id111, id201, id211, ig, js, js1 - - real (kind=kind_phys) :: tauself, taufor, refrat_planck_a, & - & speccomb, specparm, specmult, fs, & - & speccomb1, specparm1, specmult1, fs1, & - & speccomb_planck,specparm_planck,specmult_planck,fpl, & - & fac000, fac100, fac200, fac010, fac110, fac210, & - & fac001, fac101, fac201, fac011, fac111, fac211, & - & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 -! -!===> ... begin here -! -! --- ... calculate reference ratio to be used in calculation of Planck -! fraction in lower atmosphere. - - refrat_planck_a = chi_mls(1,6)/chi_mls(6,6) ! P = 387. mb (Level 6) - -! --- ... lower atmosphere loop - - do k = 1, laytrop - speccomb = colamt(k,1) + rfrate(k,4,1)*colamt(k,5) - specparm = colamt(k,1) / speccomb - specmult = 8.0 * min(specparm, oneminus) - js = 1 + int(specmult) - fs = mod(specmult, f_one) - ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(16) + js - - speccomb1 = colamt(k,1) + rfrate(k,4,2)*colamt(k,5) - specparm1 = colamt(k,1) / speccomb1 - specmult1 = 8.0 * min(specparm1, oneminus) - js1 = 1 + int(specmult1) - fs1 = mod(specmult1, f_one) - ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(16) + js1 - - speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,5) - specparm_planck = colamt(k,1) / speccomb_planck - specmult_planck = 8.0 * min(specparm_planck, oneminus) - jpl = 1 + int(specmult_planck) - fpl = mod(specmult_planck, f_one) - - inds = indself(k) - indf = indfor(k) - indsp = inds + 1 - indfp = indf + 1 - jplp = jpl + 1 - - if (specparm < 0.125) then - p0 = fs - f_one - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 + 2 - id210 = ind0 +11 - elseif (specparm > 0.875) then - p0 = -fs - p40 = p0**4 - fk00 = p40 - fk10 = f_one - p0 - 2.0*p40 - fk20 = p0 + p40 - - id000 = ind0 + 1 - id010 = ind0 +10 - id100 = ind0 - id110 = ind0 + 9 - id200 = ind0 - 1 - id210 = ind0 + 8 - else - fk00 = f_one - fs - fk10 = fs - fk20 = f_zero - - id000 = ind0 - id010 = ind0 + 9 - id100 = ind0 + 1 - id110 = ind0 +10 - id200 = ind0 - id210 = ind0 - endif - - fac000 = fk00 * fac00(k) - fac100 = fk10 * fac00(k) - fac200 = fk20 * fac00(k) - fac010 = fk00 * fac10(k) - fac110 = fk10 * fac10(k) - fac210 = fk20 * fac10(k) - - if (specparm1 < 0.125) then - p1 = fs1 - f_one - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 + 2 - id211 = ind1 +11 - elseif (specparm1 > 0.875) then - p1 = -fs1 - p41 = p1**4 - fk01 = p41 - fk11 = f_one - p1 - 2.0*p41 - fk21 = p1 + p41 - - id001 = ind1 + 1 - id011 = ind1 +10 - id101 = ind1 - id111 = ind1 + 9 - id201 = ind1 - 1 - id211 = ind1 + 8 - else - fk01 = f_one - fs1 - fk11 = fs1 - fk21 = f_zero - - id001 = ind1 - id011 = ind1 + 9 - id101 = ind1 + 1 - id111 = ind1 +10 - id201 = ind1 - id211 = ind1 - endif - - fac001 = fk01 * fac01(k) - fac101 = fk11 * fac01(k) - fac201 = fk21 * fac01(k) - fac011 = fk01 * fac11(k) - fac111 = fk11 * fac11(k) - fac211 = fk21 * fac11(k) - - do ig = 1, ng16 - tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & - & * (selfref(ig,indsp) - selfref(ig,inds))) - taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & - & * (forref(ig,indfp) - forref(ig,indf))) - - taug(ns16+ig,k) = speccomb & - & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & - & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & - & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & - & + speccomb1 & - & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & - & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & - & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & - & + tauself + taufor - - fracs(ns16+ig,k) = fracrefa(ig,jpl) + fpl & - & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) - enddo - enddo - -! --- ... upper atmosphere loop - - do k = laytrop+1, nlay - ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(16) + 1 - ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(16) + 1 - - ind0p = ind0 + 1 - ind1p = ind1 + 1 - - do ig = 1, ng16 - taug(ns16+ig,k) = colamt(k,5) & - & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & - & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) - - fracs(ns16+ig,k) = fracrefb(ig) - enddo - enddo - -! .................................. - end subroutine taugb16 -! ---------------------------------- - -! .................................. - end subroutine taumol -!! @} -!----------------------------------- - -!mz* exponential cloud overlapping subroutines -!------------------------------------------------------------------ -! Public subroutines -!------------------------------------------------------------------ -! mz* - Add height needed for exponential and exponential-random cloud overlap methods (icld=4 and 5, respectively) -! mz* - cldfmcl only *temporary - subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, & - & irng, play, hgt, & - & cldfrac, ciwp, clwp, cswp, rei, rel, res, tauc, & - & cldfmcl) -!mz* the below output need to be compatible with cldprop() -!mz ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, resnmcl, taucmcl) - - use machine, only : im => kind_io4, rb => kind_phys -! ----- Input ----- -! Control - integer(kind=im), intent(in) :: iplon ! column/longitude index - integer(kind=im), intent(in) :: ncol ! number of columns - integer(kind=im), intent(in) :: nlay ! number of model layers - integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag - integer(kind=im), intent(in) :: permuteseed ! if the cloud generator is called multiple times, - ! permute the seed between each call. - ! between calls for LW and SW, recommended - ! permuteseed differes by 'ngpt' - integer(kind=im), intent(inout) :: irng ! flag for random number generator - ! 0 = kissvec - ! 1 = Mersenne - ! Twister - -! Atmosphere - real(kind=rb), intent(in) :: play(:,:) ! layer pressures (mb) - ! Dimensions: (ncol,nlay) - -! mji - Add height - real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) - ! Dimensions: (ncol,nlay) - -! Atmosphere/clouds - cldprop - real(kind=rb), intent(in) :: cldfrac(:,:) ! layer cloud fraction - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth - ! Dimensions: (nbndlw,ncol,nlay) -! real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo - ! Dimensions: (nbndlw,ncol,nlay) -! real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter - ! Dimensions: (nbndlw,ncol,nlay) - real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow path - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: rei(:,:) ! cloud ice particle size - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: rel(:,:) ! cloud liquid particle size - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: res(:,:) ! snow particle size - ! Dimensions: (ncol,nlay) - -! ----- Output ----- -! Atmosphere/clouds - cldprmc [mcica] - real(kind=rb), intent(out) :: cldfmcl(:,:,:) ! cloud fraction [mcica] - ! Dimensions: (ngptlw,ncol,nlay) -!mz* not activate, temporary local vars - real(kind=rb),dimension(ngptlw,ncol,nlay) :: ciwpmcl ! in-cloud ice water path [mcica] - ! Dimensions: (ngptlw,ncol,nlay) - real(kind=rb),dimension(ngptlw,ncol,nlay) :: clwpmcl ! in-cloud liquid water path [mcica] - ! Dimensions: (ngptlw,ncol,nlay) - real(kind=rb),dimension(ngptlw,ncol,nlay) :: cswpmcl ! in-cloud snow path [mcica] - ! Dimensions: (ngptlw,ncol,nlay) - real(kind=rb),dimension(ncol,nlay) :: relqmcl ! liquid particle size (microns) - ! Dimensions: (ncol,nlay) - real(kind=rb),dimension(ncol,nlay) :: reicmcl ! ice partcle size (microns) - ! Dimensions: (ncol,nlay) - real(kind=rb),dimension(ncol,nlay) :: resnmcl ! snow partcle size (microns) - ! Dimensions: (ncol,nlay) - real(kind=rb),dimension(ngptlw,ncol,nlay) :: taucmcl ! in-cloud optical depth [mcica] -!mz* - ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(out) :: ssacmcl(:,:,:) ! in-cloud single scattering albedo [mcica] - ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(out) :: asmcmcl(:,:,:) ! in-cloud asymmetry parameter [mcica] - ! Dimensions: (ngptlw,ncol,nlay) -! ----- Local ----- - -! Stochastic cloud generator variables [mcica] - integer(kind=im), parameter :: nsubclw = ngptlw ! number of sub-columns (g-point intervals) - integer(kind=im) :: ilev ! loop index - - real(kind=rb) :: pmid(ncol, nlay) ! layer pressures (Pa) -! real(kind=rb) :: pdel(ncol, nlay) ! layer pressure thickness (Pa) -! real(kind=rb) :: qi(ncol, nlay) ! ice water (specific humidity) -! real(kind=rb) :: ql(ncol, nlay) ! liq water (specific humidity) - -! Return if clear sky - if (icld.eq.0) return - -! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at least the number of subcolumns - - -! Pass particle sizes to new arrays, no subcolumns for these properties yet -! Convert pressures from mb to Pa - - reicmcl(:ncol,:nlay) = rei(:ncol,:nlay) - relqmcl(:ncol,:nlay) = rel(:ncol,:nlay) - resnmcl(:ncol,:nlay) = res(:ncol,:nlay) - pmid(:ncol,:nlay) = play(:ncol,:nlay)*1.e2_rb - -! Generate the stochastic subcolumns of cloud optical properties for -! the longwave - call generate_stochastic_clouds (ncol, nlay, nsubclw, icld, irng, & - & pmid, hgt, cldfrac, clwp, ciwp, cswp, tauc, & - & cldfmcl, clwpmcl, ciwpmcl, cswpmcl, & - & taucmcl, permuteseed) - - end subroutine mcica_subcol_lw -!------------------------------------------------------------------------------------------------- - subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, & - & irng, pmid, hgt, cld, clwp, ciwp, cswp, tauc, & - & cld_stoch, clwp_stoch, ciwp_stoch, & - & cswp_stoch, tauc_stoch, changeSeed) -!------------------------------------------------------------------------------------------------- -!------------------------------------------------------------------------------------------------- -! Contact: Cecile Hannay (hannay@ucar.edu) -! -! Original code: Based on Raisanen et al., QJRMS, 2004. -! -! Modifications: -! 1) Generalized for use with RRTMG and added Mersenne Twister as the default -! random number generator, which can be changed to the optional kissvec random number generator -! with flag 'irng'. Some extra functionality has been commented or removed. -! Michael J. Iacono, AER, Inc., February 2007 -! 2) Activated exponential and exponential/random cloud overlap method -! Michael J. Iacono, AER, November 2017 -! -! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns. -! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one -! and uniform cloud liquid and cloud ice concentration. -! The ensemble as a whole reproduces the probability function of cloud liquid and ice within each layer -! and obeys an overlap assumption in the vertical. -! -! Overlap assumption: -! The cloud are consistent with 5 overlap assumptions: random, maximum, maximum-random, exponential and exponential random. -! The default option is maximum-random (option 2) -! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap, 5=exp/random -! This is set with the variable "overlap" -! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) -! -! Seed: -! If the stochastic cloud generator is called several times during the same timestep, -! one should change the seed between the call to insure that the -! subcolumns are different. -! This is done by changing the argument 'changeSeed' -! For example, if one wants to create a set of columns for the -! shortwave and another set for the longwave , -! use 'changeSeed = 1' for the first call and'changeSeed = 2' for the second call - -! PDF assumption: -! We can use arbitrary complicated PDFS. -! In the present version, we produce homogeneuous clouds (the simplest case). -! Future developments include using the PDF scheme of Ben Johnson. -! -! History file: -! Option to add diagnostics variables in the history file. (using FINCL in the namelist) -! nsubcol = number of subcolumns -! overlap = overlap type (1-3) -! Zo = length scale -! CLOUD_S = mean of the subcolumn cloud fraction ('_S" means Stochastic) -! CLDLIQ_S = mean of the subcolumn cloud water -! CLDICE_S = mean of the subcolumn cloud ice -! -! Note: -! Here: we force that the cloud condensate to be consistent with the cloud fraction -! i.e we only have cloud condensate when the cell is cloudy. -! In CAM: The cloud condensate and the cloud fraction are obtained from 2 different equations -! and the 2 quantities can be inconsistent (i.e. CAM can produce cloud fraction -! without cloud condensate or the opposite). -!----------------------------------------------------------------- - - use mcica_random_numbers -! The Mersenne Twister random number engine - use MersenneTwister, only: randomNumberSequence, & - & new_RandomNumberSequence, getRandomReal - use machine ,only : im => kind_io4, rb => kind_phys - - type(randomNumberSequence) :: randomNumbers - -! -- Arguments - - integer(kind=im), intent(in) :: ncol ! number of columns - integer(kind=im), intent(in) :: nlay ! number of layers - integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag - integer(kind=im), intent(inout) :: irng ! flag for random number generator - ! 0 = kissvec - ! 1 = Mersenne Twister - integer(kind=im), intent(in) :: nsubcol ! number of sub-columns (g-point intervals) - integer(kind=im), optional, intent(in) :: changeSeed ! allows permuting seed - -! Column state (cloud fraction, cloud water, cloud ice) + variables needed to read physics state - real(kind=rb), intent(in) :: pmid(:,:) ! layer pressure (Pa) - ! Dimensions: (ncol,nlay) - - real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: cld(:,:) ! cloud fraction - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow path - ! Dimensions: (ncol,nlay) - real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth - ! Dimensions:(nbndlw,ncol,nlay) -! real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo - ! Dimensions: (nbndlw,ncol,nlay) - ! inactive - for future expansion -! real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter - ! Dimensions: (nbndlw,ncol,nlay) - ! inactive - for future expansion - - real(kind=rb), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction - ! Dimensions: (ngptlw,ncol,nlay) - real(kind=rb), intent(out) :: clwp_stoch(:,:,:) ! subcolumn in-cloud liquid water path - ! Dimensions: (ngptlw,ncol,nlay) - real(kind=rb), intent(out) :: ciwp_stoch(:,:,:) ! subcolumn in-cloud ice water path - ! Dimensions: (ngptlw,ncol,nlay) - real(kind=rb), intent(out) :: cswp_stoch(:,:,:) ! subcolumn in-cloud snow path - ! Dimensions: (ngptlw,ncol,nlay) - real(kind=rb), intent(out) :: tauc_stoch(:,:,:) ! subcolumn in-cloud optical depth - ! Dimensions: (ngptlw,ncol,nlay) -! real(kind=rb), intent(out) :: ssac_stoch(:,:,:)! subcolumn in-cloud single scattering albedo - ! Dimensions: (ngptlw,ncol,nlay) - ! inactive - for future expansion -! real(kind=rb), intent(out) :: asmc_stoch(:,:,:)! subcolumn in-cloud asymmetry parameter - ! Dimensions: (ngptlw,ncol,nlay) - ! inactive - for future expansion - -! -- Local variables - real(kind=rb) :: cldf(ncol,nlay) ! cloud fraction - -! Mean over the subcolumns (cloud fraction, cloud water , cloud ice) - inactive -! real(kind=rb) :: mean_cld_stoch(ncol, nlay) ! cloud fraction -! real(kind=rb) :: mean_clwp_stoch(ncol, nlay) ! cloud water -! real(kind=rb) :: mean_ciwp_stoch(ncol, nlay) ! cloud ice -! real(kind=rb) :: mean_tauc_stoch(ncol, nlay) ! cloud optical depth -! real(kind=rb) :: mean_ssac_stoch(ncol, nlay) ! cloud single scattering albedo -! real(kind=rb) :: mean_asmc_stoch(ncol, nlay) ! cloud asymmetry parameter - -! Set overlap - integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum-random, - ! 3 = maximum overlap, 4 = exponential, - ! 5 = exponential-random - real(kind=rb), parameter :: Zo = 2500._rb ! length scale (m) - real(kind=rb), dimension(ncol,nlay) :: alpha ! overlap parameter - -! Constants (min value for cloud fraction and cloud water and ice) - real(kind=rb), parameter :: cldmin = 1.0e-20_rb ! min cloud fraction -! real(kind=rb), parameter :: qmin = 1.0e-10_rb ! min cloud water and cloud ice (not used) - -! Variables related to random number and seed - real(kind=rb), dimension(nsubcol, ncol, nlay) :: CDF, CDF2 !random numbers - integer(kind=im), dimension(ncol) :: seed1, seed2, seed3, seed4 !seed to create random number (kissvec) - real(kind=rb), dimension(ncol) :: rand_num ! random number (kissvec) - integer(kind=im) :: iseed ! seed to create random number (Mersenne Teister) - real(kind=rb) :: rand_num_mt ! random number (Mersenne Twister) - -! Flag to identify cloud fraction in subcolumns - logical, dimension(nsubcol, ncol, nlay) :: iscloudy ! flag that says whether a gridbox is cloudy - -! Indices - integer(kind=im) :: ilev, isubcol, i, n ! indices - -!------------------------------------------------------------------- - -! Check that irng is in bounds; if not, set to default - if (irng .ne. 0) irng = 1 - -! Pass input cloud overlap setting to local variable - overlap = icld - -! Ensure that cloud fractions are in bounds - do ilev = 1, nlay - do i = 1, ncol - cldf(i,ilev) = cld(i,ilev) - if (cldf(i,ilev) < cldmin) then - cldf(i,ilev) = 0._rb - endif - enddo - enddo - -! ----- Create seed -------- - -! Advance randum number generator by changeseed values - if (irng.eq.0) then -! For kissvec, create a seed that depends on the state of the columns. Maybe not the best way, but it works. -! Must use pmid from bottom four layers. - do i=1,ncol - if (pmid(i,1).lt.pmid(i,2)) then - stop 'MCICA_SUBCOL: KISSVEC SEED GENERATOR REQUIRES PMID & - & FROM BOTTOM FOUR LAYERS.' - endif - seed1(i) = (pmid(i,1) - int(pmid(i,1))) * 1000000000_im - seed2(i) = (pmid(i,2) - int(pmid(i,2))) * 1000000000_im - seed3(i) = (pmid(i,3) - int(pmid(i,3))) * 1000000000_im - seed4(i) = (pmid(i,4) - int(pmid(i,4))) * 1000000000_im - enddo - do i=1,changeSeed - call kissvec(seed1, seed2, seed3, seed4, rand_num) - enddo - elseif (irng.eq.1) then - randomNumbers = new_RandomNumberSequence(seed = changeSeed) - endif - -! ------ Apply overlap assumption -------- - -! generate the random numbers - - select case (overlap) - - case(1) -! Random overlap -! i) pick a random value at every level - - if (irng.eq.0) then - do isubcol = 1,nsubcol - do ilev = 1,nlay - call kissvec(seed1, seed2, seed3, seed4, rand_num) ! we get different random number for each level - CDF(isubcol,:,ilev) = rand_num - enddo - enddo - elseif (irng.eq.1) then - do isubcol = 1, nsubcol - do i = 1, ncol - do ilev = 1, nlay - rand_num_mt = getRandomReal(randomNumbers) - CDF(isubcol,i,ilev) = rand_num_mt - enddo - enddo - enddo - endif - - case(2) -! Maximum-Random overlap -! i) pick a random number for top layer. -! ii) walk down the column: -! - if the layer above is cloudy, we use the same random number than in the layer above -! - if the layer above is clear, we use a new random number - - if (irng.eq.0) then - do isubcol = 1,nsubcol - do ilev = 1,nlay - call kissvec(seed1, seed2, seed3, seed4, rand_num) - CDF(isubcol,:,ilev) = rand_num - enddo - enddo - elseif (irng.eq.1) then - do isubcol = 1, nsubcol - do i = 1, ncol - do ilev = 1, nlay - rand_num_mt = getRandomReal(randomNumbers) - CDF(isubcol,i,ilev) = rand_num_mt - enddo - enddo - enddo - endif - - do ilev = 2,nlay - do i = 1, ncol - do isubcol = 1, nsubcol - if (CDF(isubcol, i, ilev-1) > 1._rb - cldf(i,ilev-1) )& - & then - CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev-1) - else - CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev) * (1._rb & - & - cldf(i,ilev-1)) - endif - enddo - enddo - enddo - - case(3) -! Maximum overlap -! i) pick the same random numebr at every level - - if (irng.eq.0) then - do isubcol = 1,nsubcol - call kissvec(seed1, seed2, seed3, seed4, rand_num) - do ilev = 1,nlay - CDF(isubcol,:,ilev) = rand_num - enddo - enddo - elseif (irng.eq.1) then - do isubcol = 1, nsubcol - do i = 1, ncol - rand_num_mt = getRandomReal(randomNumbers) - do ilev = 1, nlay - CDF(isubcol,i,ilev) = rand_num_mt - enddo - enddo - enddo - endif - -! mji - Activate exponential cloud overlap option - case(4) - ! Exponential overlap: weighting between maximum and random overlap increases with the distance. - ! The random numbers for exponential overlap verify: - ! j=1 RAN(j)=RND1 - ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) - ! RAN(j) = RND2 - ! alpha is obtained from the equation - ! alpha = exp(-(Z(j)-Z(j-1))/Zo) where Zo is a characteristic length scale - - ! compute alpha - do i = 1, ncol - alpha(i, 1) = 0._rb - do ilev = 2,nlay - alpha(i, ilev) = exp( -( hgt (i, ilev) - & - & hgt (i, ilev-1)) / Zo) - enddo - enddo - - ! generate 2 streams of random numbers - if (irng.eq.0) then - do isubcol = 1,nsubcol - do ilev = 1,nlay - call kissvec(seed1, seed2, seed3, seed4, rand_num) - CDF(isubcol, :, ilev) = rand_num - call kissvec(seed1, seed2, seed3, seed4, rand_num) - CDF2(isubcol, :, ilev) = rand_num - enddo - enddo - elseif (irng.eq.1) then - do isubcol = 1, nsubcol - do i = 1, ncol - do ilev = 1, nlay - rand_num_mt = getRandomReal(randomNumbers) - CDF(isubcol,i,ilev) = rand_num_mt - rand_num_mt = getRandomReal(randomNumbers) - CDF2(isubcol,i,ilev) = rand_num_mt - enddo - enddo - enddo - endif - - ! generate random numbers - do ilev = 2,nlay - where (CDF2(:, :, ilev) < spread(alpha (:,ilev), & - & dim=1,nCopies=nsubcol) ) - CDF(:,:,ilev) = CDF(:,:,ilev-1) - end where - end do - -! Activate exponential-random cloud overlap option - case(5) - ! Exponential-random overlap: -!mz* call wrf_error_fatal("Cloud Overlap case 5: ER has not yet & -! been implemented. Stopping...") - - end select - -! -- generate subcolumns for homogeneous clouds ----- - do ilev = 1,nlay - iscloudy(:,:,ilev) = (CDF(:,:,ilev) >= 1._rb - & - & spread(cldf(:,ilev), dim=1, nCopies=nsubcol) ) - enddo - -! where the subcolumn is cloudy, the subcolumn cloud fraction is 1; -! where the subcolumn is not cloudy, the subcolumn cloud fraction is 0; -! where there is a cloud, define the subcolumn cloud properties, -! otherwise set these to zero - - do ilev = 1,nlay - do i = 1, ncol - do isubcol = 1, nsubcol - if (iscloudy(isubcol,i,ilev) ) then - cld_stoch(isubcol,i,ilev) = 1._rb - clwp_stoch(isubcol,i,ilev) = clwp(i,ilev) - ciwp_stoch(isubcol,i,ilev) = ciwp(i,ilev) - cswp_stoch(isubcol,i,ilev) = cswp(i,ilev) - n = ngb(isubcol) - tauc_stoch(isubcol,i,ilev) = tauc(n,i,ilev) -! ssac_stoch(isubcol,i,ilev) = ssac(n,i,ilev) -! asmc_stoch(isubcol,i,ilev) = asmc(n,i,ilev) - else - cld_stoch(isubcol,i,ilev) = 0._rb - clwp_stoch(isubcol,i,ilev) = 0._rb - ciwp_stoch(isubcol,i,ilev) = 0._rb - cswp_stoch(isubcol,i,ilev) = 0._rb - tauc_stoch(isubcol,i,ilev) = 0._rb -! ssac_stoch(isubcol,i,ilev) = 1._rb -! asmc_stoch(isubcol,i,ilev) = 1._rb - endif - enddo - enddo - enddo - -! -- compute the means of the subcolumns --- -! mean_cld_stoch(:,:) = 0._rb -! mean_clwp_stoch(:,:) = 0._rb -! mean_ciwp_stoch(:,:) = 0._rb -! mean_tauc_stoch(:,:) = 0._rb -! mean_ssac_stoch(:,:) = 0._rb -! mean_asmc_stoch(:,:) = 0._rb -! do i = 1, nsubcol -! mean_cld_stoch(:,:) = cld_stoch(i,:,:) + mean_cld_stoch(:,:) -! mean_clwp_stoch(:,:) = clwp_stoch( i,:,:) + mean_clwp_stoch(:,:) -! mean_ciwp_stoch(:,:) = ciwp_stoch( i,:,:) + mean_ciwp_stoch(:,:) -! mean_tauc_stoch(:,:) = tauc_stoch( i,:,:) + mean_tauc_stoch(:,:) -! mean_ssac_stoch(:,:) = ssac_stoch( i,:,:) + mean_ssac_stoch(:,:) -! mean_asmc_stoch(:,:) = asmc_stoch( i,:,:) + mean_asmc_stoch(:,:) -! end do -! mean_cld_stoch(:,:) = mean_cld_stoch(:,:) / nsubcol -! mean_clwp_stoch(:,:) = mean_clwp_stoch(:,:) / nsubcol -! mean_ciwp_stoch(:,:) = mean_ciwp_stoch(:,:) / nsubcol -! mean_tauc_stoch(:,:) = mean_tauc_stoch(:,:) / nsubcol -! mean_ssac_stoch(:,:) = mean_ssac_stoch(:,:) / nsubcol -! mean_asmc_stoch(:,:) = mean_asmc_stoch(:,:) / nsubcol - - end subroutine generate_stochastic_clouds - -!------------------------------------------------------------------ -! Private subroutines -!------------------------------------------------------------------ - -!----------------------------------------------------------------- - subroutine kissvec(seed1,seed2,seed3,seed4,ran_arr) -!---------------------------------------------------------------- - -! public domain code -! made available from http://www.fortran.com/ -! downloaded by pjr on 03/16/04 for NCAR CAM -! converted to vector form, functions inlined by pjr,mvr on 05/10/2004 - -! The KISS (Keep It Simple Stupid) random number generator. Combines: -! (1) The congruential generator x(n)=69069*x(n-1)+1327217885, period 2^32. -! (2) A 3-shift shift-register generator, period 2^32-1, -! (3) Two 16-bit multiply-with-carry generators, period 597273182964842497>2^59 -! Overall period>2^123; - real(kind=rb), dimension(:), intent(inout) :: ran_arr - integer(kind=im), dimension(:), intent(inout) :: seed1,seed2,seed3& - & ,seed4 - integer(kind=im) :: i,sz,kiss - integer(kind=im) :: m, k, n - -! inline function - m(k, n) = ieor (k, ishft (k, n) ) - - sz = size(ran_arr) - do i = 1, sz - seed1(i) = 69069_im * seed1(i) + 1327217885_im - seed2(i) = m (m (m (seed2(i), 13_im), - 17_im), 5_im) - seed3(i) = 18000_im * iand (seed3(i), 65535_im) + & - & ishft (seed3(i), - 16_im) - seed4(i) = 30903_im * iand (seed4(i), 65535_im) + & - & ishft (seed4(i), - 16_im) - kiss = seed1(i) + seed2(i) + ishft (seed3(i), 16_im) + seed4(i) - ran_arr(i) = kiss*2.328306e-10_rb + 0.5_rb - end do - - end subroutine kissvec -! - -!........................................!$ - end module rrtmg_lw !$ -!========================================!$ diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 73977e5cb..4d2e5fa42 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -371,6 +371,22 @@ kind = kind_phys intent = in optional = T +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From bb68108abe5bf6d5101dd8eb451d562bdd30267d Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 17 Mar 2020 10:08:38 -0600 Subject: [PATCH 016/274] HWRF RRTMG cloud-rad interaction --- physics/GFS_rrtmg_pre.F90 | 6 +--- physics/GFS_rrtmg_pre.meta | 18 +++++------ physics/GFS_rrtmg_setup.F90 | 33 +++++++++++--------- physics/GFS_rrtmg_setup.meta | 20 ++++++------- physics/radiation_clouds.f | 24 +++++++++++---- physics/radlw_main.meta | 34 +++++++++++++++------ physics/radsw_main.f | 10 +++---- physics/radsw_main.meta | 58 ++++++++++++++++++++++++++++++------ 8 files changed, 136 insertions(+), 67 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 165411a33..92f21683a 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -81,7 +81,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input type(GFS_sfcprop_type), intent(in) :: Sfcprop type(GFS_statein_type), intent(in) :: Statein type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_tbd_type), intent(in) :: Tbd + type(GFS_tbd_type), intent(inout) :: Tbd type(GFS_cldprop_type), intent(in) :: Cldprop type(GFS_coupling_type), intent(in) :: Coupling @@ -724,10 +724,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input gridkm = 1.414*SQRT(dx(1)*0.001*dx(1)*0.001 ) - ! if(mpirank == mpiroot) then - ! write(0,*)'cldfra3: max/min(plyrpa) = ', maxval(plyrpa), minval(plyrpa) - ! write(0,*)'cldfra3: max/min(rho) = ', maxval(rho), minval(rho) - ! endif if(Model%icloud == 3) then diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 198cd0a5a..716090962 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -436,7 +436,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -445,7 +445,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -454,7 +454,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -463,7 +463,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -472,7 +472,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -481,7 +481,7 @@ standard_name = cloud_rain_water_path long_name = cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -490,7 +490,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -499,7 +499,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -508,7 +508,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index b6d86a34e..043ea8560 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -5,9 +5,9 @@ module GFS_rrtmg_setup use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg,& ! & iaermdl, laswflg, lalwflg, lavoflg, icldflg, & & iaermdl, icldflg, & - & iovrsw , iovrlw , lcrick , lcnorm , lnoprec, & - & ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & - & iswcliq, & + & lcrick , lcnorm , lnoprec, & + & ialbflg, iemsflg, ivflip , ipsd0, & +! & iswcliq, & & kind_phys use radcons, only: ltp, lextop @@ -136,6 +136,7 @@ subroutine GFS_rrtmg_setup_init ( & ! =1: max/ran overlapping clouds ! ! =2: maximum overlap clouds (mcica only) ! ! =3: decorrelation-length overlap (mcica only) ! +! =4: exponential overlap clouds ! isubc_sw/isubc_lw: sub-column cloud approx control flag (sw/lw rad) ! ! =0: with out sub-column cloud approximation ! ! =1: mcica sub-col approx. prescribed random seed ! @@ -177,8 +178,8 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: num_p3d integer, intent(in) :: npdf3d integer, intent(in) :: ntoz - integer, intent(in) :: iovr_sw - integer, intent(in) :: iovr_lw + integer, intent(inout) :: iovr_sw + integer, intent(inout) :: iovr_lw integer, intent(in) :: isubc_sw integer, intent(in) :: isubc_lw integer, intent(in) :: icliq_sw @@ -204,6 +205,8 @@ subroutine GFS_rrtmg_setup_init ( & real(kind_phys), dimension(im,NSPC1) :: aerodp_check ! End for consistency checks + integer :: iswcliq + ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -268,14 +271,14 @@ subroutine GFS_rrtmg_setup_init ( & iswcliq = icliq_sw ! optical property for liquid clouds for sw - iovrsw = iovr_sw ! cloud overlapping control flag for sw - iovrlw = iovr_lw ! cloud overlapping control flag for lw + ! iovrsw = iovr_sw ! cloud overlapping control flag for sw + ! iovrlw = iovr_lw ! cloud overlapping control flag for lw lcrick = crick_proof ! control flag for eliminating CRICK lcnorm = ccnorm ! control flag for in-cld condensate lnoprec = norad_precip ! precip effect on radiation flag (ferrier microphysics) - isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation - isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation +! isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation +! isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation ialbflg= ialb ! surface albedo control flag iemsflg= iems ! surface emissivity control flag @@ -303,7 +306,7 @@ subroutine GFS_rrtmg_setup_init ( & call radinit & ! --- inputs: - & ( si, levr, imp_physics, me ) + & ( si, levr, imp_physics,iswcliq, iovr_lw, iovr_sw, isubc_lw, isubc_sw, me ) ! --- outputs: ! ( none ) @@ -384,7 +387,7 @@ end subroutine GFS_rrtmg_setup_finalize ! Private functions - subroutine radinit( si, NLAY, imp_physics, me ) + subroutine radinit( si, NLAY, imp_physics,iswcliq, iovrlw,iovrsw,isubclw,isubcsw, me ) !................................... ! --- inputs: @@ -509,8 +512,10 @@ subroutine radinit( si, NLAY, imp_physics, me ) implicit none ! --- inputs: - integer, intent(in) :: NLAY, me, imp_physics + integer, intent(in) :: NLAY, me, imp_physics, & + & isubclw,isubcsw,iswcliq + integer, intent(inout) :: iovrlw,iovrsw real (kind=kind_phys), intent(in) :: si(:) ! --- outputs: (none, to module variables) @@ -619,9 +624,9 @@ subroutine radinit( si, NLAY, imp_physics, me ) call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine - call rlwinit ( me ) ! --- ... lw radiation initialization routine + call rlwinit (iovrlw,isubclw, me ) ! --- ... lw radiation initialization routine - call rswinit ( me ) ! --- ... sw radiation initialization routine + call rswinit (iswcliq, iovrsw,isubcsw, me ) ! --- ... sw radiation initialization routine ! return !................................... diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 8405d160d..4f96b76f1 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -107,32 +107,32 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation - long_name = sw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation + long_name = control flag for cloud overlapping method for SW units = flag dimensions = () type = integer - intent = in + intent = inout optional = F [iovr_lw] - standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation - long_name = lw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation + long_name = control flag for cloud overlapping method for LW units = flag dimensions = () type = integer - intent = in + intent = inout optional = F [isubc_sw] - standard_name = flag_for_sw_clouds_without_sub_grid_approximation - long_name = flag for sw clouds without sub-grid approximation + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation units = flag dimensions = () type = integer intent = in optional = F [isubc_lw] - standard_name = flag_for_lw_clouds_without_sub_grid_approximation - long_name = flag for lw clouds without sub-grid approximation + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation units = flag dimensions = () type = integer diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index c259fc22e..2a1184e99 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -2436,8 +2436,12 @@ subroutine progcld5 & logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz, & - & re_cloud, re_ice, re_snow + & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz +! & re_cloud, re_ice, re_snow + +!mz: for diagnostics purpose + real (kind=kind_phys), dimension(:,:), intent(inout) :: & + & re_cloud, re_ice, re_snow real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw @@ -2689,9 +2693,11 @@ subroutine progcld5 & else rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 endif +! if (icloud == 3 ) then rei(i,k) = max(25.,rei(i,k)) !mz* HWRF -!mz GFDL +! else !mz GFDL ! rei(i,k) = max(10.0, min(rei(i,k), 150.0)) +! endif endif rei(i,k) = min(rei(i,k), 135.72) !- 1.0315*rei<= 140 microns enddo @@ -2699,7 +2705,7 @@ subroutine progcld5 & !mz !> -# Compute effective snow cloud droplet radius - do k = 1, NLAY + do k = 1, NLAY do i = 1, IX res(i,k) = 10.0 enddo @@ -2717,8 +2723,14 @@ subroutine progcld5 & clouds(i,k,5) = rei(i,k) clouds(i,k,6) = crp(i,k) ! added for Thompson clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) ! added for Thompson - clouds(i,k,9) = res(i,k) + !mz inflg .ne.5 + clouds(i,k,8) = 0. + clouds(i,k,9) = 10. +!mz for diagnostics? + re_cloud(i,k) =rew(i,k) + re_ice(i,k) =rei(i,k) + re_snow(i,k) = 10. + enddo enddo diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 4d2e5fa42..6fc58d635 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -207,6 +207,22 @@ kind = kind_phys intent = in optional = F +[iovrlw] + standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation + long_name = control flag for cloud overlapping method for LW + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubclw] + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F [npts] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -243,7 +259,7 @@ standard_name = total_cloud_fraction long_name = total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -303,7 +319,7 @@ standard_name = cloud_liquid_water_path long_name = cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -312,7 +328,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -321,7 +337,7 @@ standard_name = cloud_ice_water_path long_name = cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -330,7 +346,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -339,7 +355,7 @@ standard_name = cloud_rain_water_path long_name = cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -348,7 +364,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -357,7 +373,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -366,7 +382,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in diff --git a/physics/radsw_main.f b/physics/radsw_main.f index b10541fb7..30bc58bba 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -268,7 +268,7 @@ !! code from aer inc. module rrtmg_sw ! - use physparam, only : iswrate, iswrgas, iswcliq, iswcice, & + use physparam, only : iswrate, iswrgas, iswcice, & !mz: iswcliq-NML option & isubcsw, icldflg, iovrsw, ivflip, & & iswmode, kind_phys use physcons, only : con_g, con_cp, con_avgd, con_amd, & @@ -1542,7 +1542,7 @@ end subroutine rswinit !----------------------------------- subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & cf1, nlay, ipseed, dz, delgth, & + & cf1, nlay, ipseed, dz, delgth, iswcliq, & & taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output & ) @@ -1557,7 +1557,7 @@ subroutine cldprop & ! ! ! inputs: size ! ! cfrac - real, layer cloud fraction nlay ! -! ..... for iswcliq > 0 (prognostic cloud sckeme) - - - ! +! ..... for iswcliq > 0 (prognostic cloud scheme) - - - ! ! cliqp - real, layer in-cloud liq water path (g/m**2) nlay ! ! reliq - real, mean eff radius for liq cloud (micron) nlay ! ! cicep - real, layer in-cloud ice water path (g/m**2) nlay ! @@ -1566,7 +1566,7 @@ subroutine cldprop & ! cdat2 - real, effective radius for rain drop (micron) nlay ! ! cdat3 - real, layer snow flake water path(g/m**2) nlay ! ! cdat4 - real, mean eff radius for snow flake(micron) nlay ! -! ..... for iswcliq = 0 (diagnostic cloud sckeme) - - - ! +! ..... for iswcliq = 0 (diagnostic cloud scheme) - - - ! ! cdat1 - real, layer cloud optical depth nlay ! ! cdat2 - real, layer cloud single scattering albedo nlay ! ! cdat3 - real, layer cloud asymmetry factor nlay ! @@ -1628,7 +1628,7 @@ subroutine cldprop & use module_radsw_cldprtb ! --- inputs: - integer, intent(in) :: nlay, ipseed + integer, intent(in) :: nlay, ipseed, iswcliq real (kind=kind_phys), intent(in) :: cf1, delgth real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index c5cbe768a..49e9cc6b3 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -234,6 +234,30 @@ kind = kind_phys intent = in optional = F +[iswcliq] + standard_name = flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation + long_name = sw optical property for liquid clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovrsw] + standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation + long_name = control flag for cloud overlapping method for SW + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubcsw] + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F [cosz] standard_name = cosine_of_zenith_angle long_name = cosine of the solar zenit angle @@ -304,7 +328,7 @@ standard_name = total_cloud_fraction long_name = total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -372,7 +396,7 @@ standard_name = cloud_liquid_water_path long_name = cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -381,7 +405,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -390,7 +414,7 @@ standard_name = cloud_ice_water_path long_name = cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -399,7 +423,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -408,7 +432,7 @@ standard_name = cloud_rain_water_path long_name = cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -417,7 +441,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -426,7 +450,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -435,11 +459,27 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in optional = T +[mpirank] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From c47c2cbb85710dcbccc47c3360047cb178151859 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Sat, 21 Mar 2020 11:32:49 -0600 Subject: [PATCH 017/274] add progcld6 for GSD suite --- physics/GFS_rrtmg_pre.F90 | 69 ++-- physics/radiation_clouds.f | 788 +++++++++++++++++++++++++++---------- 2 files changed, 614 insertions(+), 243 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 92f21683a..7a5894f2e 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -36,41 +36,42 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input mpirank, mpiroot) use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, & - GFS_stateout_type, & - GFS_sfcprop_type, & - GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_tbd_type, & - GFS_cldprop_type, & - GFS_radtend_type, & + use GFS_typedefs, only: GFS_statein_type, & + GFS_stateout_type, & + GFS_sfcprop_type, & + GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_tbd_type, & + GFS_cldprop_type, & + GFS_radtend_type, & GFS_diag_type use physparam - use physcons, only: eps => con_eps, & - & epsm1 => con_epsm1, & - & fvirt => con_fvirt & - &, rog => con_rog & + use physcons, only: eps => con_eps, & + & epsm1 => con_epsm1, & + & fvirt => con_fvirt & + &, rog => con_rog & &, rocp => con_rocp - use radcons, only: itsfc,ltp, lextop, qmin, & + use radcons, only: itsfc,ltp, lextop, qmin, & qme5, qme6, epsq, prsmin use funcphys, only: fpvs - use module_radiation_astronomy,only: coszmn ! sol_init, sol_update - use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, - use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, + use module_radiation_astronomy,only: coszmn ! sol_init, sol_update + use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, + use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, & NSPC1 - use module_radiation_clouds, only: NF_CLDS, & ! cld_init - & progcld1, progcld3, & - & progcld2, & - & progcld4, progcld5, & + use module_radiation_clouds, only: NF_CLDS, & ! cld_init + & progcld1, progcld3, & + & progcld2, & + & progcld4, progcld5, & + & progcld6, & !F-A & progclduni, & & cal_cldfra3, find_cloudLayers,adjust_cloudIce,adjust_cloudH2O, & & adjust_cloudFinal - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & & profsw_type, NBDSW - use module_radlw_parameters, only: topflw_type, sfcflw_type, & + use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW use surface_perturbation, only: cdfnor @@ -835,8 +836,26 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 .or. & - Model%imp_physics == 15) then + elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 ) then + if (Model%kdt == 1) then + Tbd%phy_f3d(:,:,Model%nleffr) = 10. + Tbd%phy_f3d(:,:,Model%nieffr) = 50. + Tbd%phy_f3d(:,:,Model%nseffr) = 250. + endif + + !mz* this is original progcld5 - temporary + call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lmk, lmp, Model%uni_cld, & + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & + Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + + + elseif(Model%imp_physics == 15) then if (Model%kdt == 1) then Tbd%phy_f3d(:,:,Model%nleffr) = 10. Tbd%phy_f3d(:,:,Model%nieffr) = 50. diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 2a1184e99..41da8953f 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -244,6 +244,7 @@ module module_radiation_clouds public progcld1, progcld2, progcld3, progcld4, progclduni, & & cld_init, progcld5, progcld4o, & + & progcld6, & !mz- for GSL suite & cal_cldfra3, find_cloudLayers,adjust_cloudIce,adjust_cloudH2O, & & adjust_cloudFinal @@ -2767,6 +2768,358 @@ subroutine progcld5 & end subroutine progcld5 !................................... + +!mz: progcld5 benchmark + subroutine progcld6 & + & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: + & xlat,xlon,slmsk,dz,delp, & + & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & + & IX, NLAY, NLP1, & + & uni_cld, lmfshal, lmfdeep2, cldcov, & + & re_cloud,re_ice,re_snow, & + & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & ) + +! ================= subprogram documentation block ================ ! +! ! +! subprogram: progcld5 computes cloud related quantities using ! +! Thompson/WSM6 cloud microphysics scheme. ! +! ! +! abstract: this program computes cloud fractions from cloud ! +! condensates, ! +! and computes the low, mid, high, total and boundary layer cloud ! +! fractions and the vertical indices of low, mid, and high cloud ! +! top and base. the three vertical cloud domains are set up in the ! +! initial subroutine "cld_init". ! +! ! +! usage: call progcld5 ! +! ! +! subprograms called: gethml ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! ! +! ==================== definition of variables ==================== ! +! ! +! ! +! input variables: ! +! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! +! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! +! tlyr (IX,NLAY) : model layer mean temperature in k ! +! tvly (IX,NLAY) : model layer virtual temperature in k ! +! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! +! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! +! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! +! clw (IX,NLAY,ntrac) : layer cloud condensate amount ! +! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! +! range, otherwise see in-line comment ! +! xlon (IX) : grid longitude in radians (not used) ! +! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! +! IX : horizontal dimention ! +! NLAY,NLP1 : vertical layer/level dimensions ! +! uni_cld : logical - true for cloud fraction from shoc ! +! lmfshal : logical - true for mass flux shallow convection ! +! lmfdeep2 : logical - true for mass flux deep convection ! +! cldcov : layer cloud fraction (used when uni_cld=.true. ! +! ! +! output variables: ! +! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! +! clouds(:,:,1) - layer total cloud fraction ! +! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! +! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! +! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! +! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! +! clouds(:,:,6) - layer rain drop water path not assigned ! +! clouds(:,:,7) - mean eff radius for rain drop (micron) ! +! *** clouds(:,:,8) - layer snow flake water path not assigned ! +! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! +! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! +! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! +! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! +! ! +! module variables: ! +! ivflip : control flag of vertical index direction ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! lmfshal : mass-flux shallow conv scheme flag ! +! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! +! lcrick : control flag for eliminating CRICK ! +! =t: apply layer smoothing to eliminate CRICK ! +! =f: do not apply layer smoothing ! +! lcnorm : control flag for in-cld condensate ! +! =t: normalize cloud condensate ! +! =f: not normalize cloud condensate ! +! ! +! ==================== end of description ===================== ! +! + implicit none + +! --- inputs + integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl + + logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 + + real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & + & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, & + & re_cloud, re_ice, re_snow + + real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw + + real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & + & slmsk + +! --- outputs + real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds + + real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + + integer, dimension(:,:), intent(out) :: mtop,mbot + +! --- local variables: + real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf + + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) + + real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & + & tem1, tem2, tem3 + + integer :: i, k, id, nf + +! --- constant values +! real (kind=kind_phys), parameter :: xrc3 = 200. + real (kind=kind_phys), parameter :: xrc3 = 100. + +! +!===> ... begin here +! + do nf=1,nf_clds + do k=1,nlay + do i=1,ix + clouds(i,k,nf) = 0.0 + enddo + enddo + enddo +! clouds(:,:,:) = 0.0 + + do k = 1, NLAY + do i = 1, IX + cldtot(i,k) = 0.0 + cldcnv(i,k) = 0.0 + cwp (i,k) = 0.0 + cip (i,k) = 0.0 + crp (i,k) = 0.0 + csp (i,k) = 0.0 + rew (i,k) = re_cloud(i,k) + rei (i,k) = re_ice(i,k) + rer (i,k) = rrain_def ! default rain radius to 1000 micron + res (i,k) = re_snow(i,K) +! tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) + clwf(i,k) = 0.0 + enddo + enddo +! +! +! if ( lcrick ) then +! do i = 1, IX +! clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) +! clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) +! enddo +! do k = 2, NLAY-1 +! do i = 1, IX +! clwf(i,K) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) +! enddo +! enddo +! else +! do k = 1, NLAY +! do i = 1, IX +! clwf(i,k) = clw(i,k) +! enddo +! enddo +! endif + + do k = 1, NLAY + do i = 1, IX + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + enddo + enddo +!> - Find top pressure for each cloud domain for given latitude. +!! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; +!! i=1,2 are low-lat (<45 degree) and pole regions) + + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + + do id = 1, 4 + tem1 = ptopc(id,2) - ptopc(id,1) + + do i =1, IX + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) + enddo + enddo + +!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . + + do k = 1, NLAY + do i = 1, IX + cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) + cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) + crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) + csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * & + & gfac * delp(i,k)) + enddo + enddo + + if (uni_cld) then ! use unified sgs clouds generated outside + do k = 1, NLAY + do i = 1, IX + cldtot(i,k) = cldcov(i,k) + enddo + enddo + + else + +!> - Calculate layer cloud fraction. + + clwmin = 0.0 + if (.not. lmfshal) then + do k = 1, NLAY + do i = 1, IX + clwt = 1.0e-6 * (plyr(i,k)*0.001) +! clwt = 2.0e-6 * (plyr(i,k)*0.001) + + if (clwf(i,k) > clwt) then + + onemrh= max( 1.e-10, 1.0-rhly(i,k) ) + clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) + + tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) + tem1 = 2000.0 / tem1 + +! tem1 = 1000.0 / tem1 + + value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhly(i,k)) ) + + cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + else + do k = 1, NLAY + do i = 1, IX + clwt = 1.0e-6 * (plyr(i,k)*0.001) +! clwt = 2.0e-6 * (plyr(i,k)*0.001) + + if (clwf(i,k) > clwt) then + onemrh= max( 1.e-10, 1.0-rhly(i,k) ) + clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) +! + tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan + if (lmfdeep2) then + tem1 = xrc3 / tem1 + else + tem1 = 100.0 / tem1 + endif +! + value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhly(i,k)) ) + + cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + endif + + endif ! if (uni_cld) then + + do k = 1, NLAY + do i = 1, IX + if (cldtot(i,k) < climit) then + cldtot(i,k) = 0.0 + cwp(i,k) = 0.0 + cip(i,k) = 0.0 + crp(i,k) = 0.0 + csp(i,k) = 0.0 + endif + enddo + enddo + + if ( lcnorm ) then + do k = 1, NLAY + do i = 1, IX + if (cldtot(i,k) >= climit) then + tem1 = 1.0 / max(climit2, cldtot(i,k)) + cwp(i,k) = cwp(i,k) * tem1 + cip(i,k) = cip(i,k) * tem1 + crp(i,k) = crp(i,k) * tem1 + csp(i,k) = csp(i,k) * tem1 + endif + enddo + enddo + endif + +! + do k = 1, NLAY + do i = 1, IX + clouds(i,k,1) = cldtot(i,k) + clouds(i,k,2) = cwp(i,k) + clouds(i,k,3) = rew(i,k) + clouds(i,k,4) = cip(i,k) + clouds(i,k,5) = rei(i,k) + clouds(i,k,6) = crp(i,k) ! added for Thompson + clouds(i,k,7) = rer(i,k) + clouds(i,k,8) = csp(i,k) ! added for Thompson + clouds(i,k,9) = res(i,k) + enddo + enddo + +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later + + if ( iovr == 3 ) then + do i = 1, ix + de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) + enddo + endif + +!> - Call gethml() to compute low,mid,high,total, and boundary layer +!! cloud fractions and clouds top/bottom layer indices for low, mid, +!! and high clouds. +! --- compute low, mid, high, total, and boundary layer cloud fractions +! and clouds top/bottom layer indices for low, mid, and high clouds. +! The three cloud domain boundaries are defined by ptopc. The cloud +! overlapping method is defined by control flag 'iovr', which may +! be different for lw and sw radiation programs. + + call gethml & +! --- inputs: + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & IX,NLAY, & +! --- outputs: + & clds, mtop, mbot & + & ) + + +! + return + +!............................................ + end subroutine progcld6 +!............................................ +!mz + + !> \ingroup module_radiation_clouds !> This subroutine computes cloud related quantities using !! for unified cloud microphysics scheme. @@ -3715,91 +4068,90 @@ SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & k_m12C = 0 k_m40C = 0 - DO k = kte, kts, -1 - theta(k) = T1d(k)*((100000.0/P1d(k))**(287.05/1004.)) + DO k = kte, kts, -1 + theta(k) = T1d(k)*((100000.0/P1d(k))**(287.05/1004.)) if (T1d(k)-273.16 .gt. -40.0 .and. P1d(k).gt.7000.0) k_m40C = & - & MAX(k_m40C, k) + & MAX(k_m40C, k) if (T1d(k)-273.16 .gt. -12.0 .and. P1d(k).gt.10000.0) k_m12C = & - & MAX(k_m12C, k) - ENDDO - if (k_m40C .le. kts) k_m40C = kts - if (k_m12C .le. kts) k_m12C = kts - - Z2 = 44307.692 * (1.0 - (P1d(kte)/101325.)**0.190) - DO k = kte-1, kts, -1 - Z1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) - dz(k+1) = Z2 - Z1 - Z2 = Z1 - ENDDO - dz(kts) = dz(kts+1) - -!..Find tropopause height, best surrogate, because we would not really -!.. wish to put fake clouds into the stratosphere. The 10/1500 ratio -!.. d(Theta)/d(Z) approximates a vertical line on typical SkewT chart -!.. near typical (mid-latitude) tropopause height. Since messy data -!.. could give us a false signal of such a transition, do the check over -!.. three K-level change, not just a level-to-level check. This method -!.. has potential failure in arctic-like conditions with extremely low -!.. tropopause height, as would any other diagnostic, so ensure resulting -!.. k_tropo level is above 4km. - - DO k = kte-3, kts, -1 - theta1 = theta(k) - theta2 = theta(k+2) - ht1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) - ht2 = 44307.692 * (1.0 - (P1d(k+2)/101325.)**0.190) + & MAX(k_m12C, k) + ENDDO + if (k_m40C .le. kts) k_m40C = kts + if (k_m12C .le. kts) k_m12C = kts + + Z2 = 44307.692 * (1.0 - (P1d(kte)/101325.)**0.190) + DO k = kte-1, kts, -1 + Z1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) + dz(k+1) = Z2 - Z1 + Z2 = Z1 + ENDDO + dz(kts) = dz(kts+1) + +!..Find tropopause height, best surrogate, because we would not really +!.. wish to put fake clouds into the stratosphere. The 10/1500 ratio +!.. d(Theta)/d(Z) approximates a vertical line on typical SkewT chart +!.. near typical (mid-latitude) tropopause height. Since messy data +!.. could give us a false signal of such a transition, do the check over +!.. three K-level change, not just a level-to-level check. This method +!.. has potential failure in arctic-like conditions with extremely low +!.. tropopause height, as would any other diagnostic, so ensure resulting +!.. k_tropo level is above 4km. + + DO k = kte-3, kts, -1 + theta1 = theta(k) + theta2 = theta(k+2) + ht1 = 44307.692 * (1.0 - (P1d(k)/101325.)**0.190) + ht2 = 44307.692 * (1.0 - (P1d(k+2)/101325.)**0.190) if ( (((theta2-theta1)/(ht2-ht1)) .lt. 10./1500. ) .AND. & & (ht1.lt.19000.) .and. (ht1.gt.4000.) ) then - goto 86 - endif - ENDDO - 86 continue - k_tropo = MAX(kts+2, k+2) - -! if (debugfl) then -! print*, ' FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' -! WRITE (dbg_msg,*) 'DEBUG-GT: FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' -! CALL wrf_debug (150, dbg_msg) -! endif - -!..Eliminate possible fractional clouds above supposed tropopause. - DO k = k_tropo+1, kte - if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) then - cfr1d(k) = 0. - endif - ENDDO - -!..We would like to prevent fractional clouds below LCL in idealized -!.. situation with deep well-mixed convective PBL, that otherwise is -!.. likely to get clouds in more realistic capping inversion layer. - - kbot = kts+2 - DO k = kbot, k_m12C - if ( (theta(k)-theta(k-1)) .gt. 0.05E-3*dz(k)) EXIT - ENDDO - kbot = MAX(kts+1, k-2) - DO k = kts, kbot - if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) cfr1d(k) = 0. - ENDDO - - -!..Starting below tropo height, if cloud fraction greater than 1 -!percent, -!.. compute an approximate total layer depth of cloud, determine a total -!.. liquid water/ice path (LWP/IWP), then reduce that amount with tuning -!.. parameter to represent entrainment factor, then divide up LWP/IWP -!.. into delta-Z weighted amounts for individual levels per cloud layer. - - - k_cldb = k_tropo - in_cloud = .false. - k = k_tropo - DO WHILE (.not. in_cloud .AND. k.gt.k_m12C) - k_cldt = 0 - if (cfr1d(k).ge.0.01) then - in_cloud = .true. - k_cldt = MAX(k_cldt, k) - endif + goto 86 + endif + ENDDO + 86 continue + k_tropo = MAX(kts+2, k+2) + +! if (debugfl) then +! print*, ' FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' +! WRITE (dbg_msg,*) 'DEBUG-GT: FOUND TROPOPAUSE ', k_tropo, ' near ', ht2, ' m' +! CALL wrf_debug (150, dbg_msg) +! endif + +!..Eliminate possible fractional clouds above supposed tropopause. + DO k = k_tropo+1, kte + if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) then + cfr1d(k) = 0. + endif + ENDDO + +!..We would like to prevent fractional clouds below LCL in idealized +!.. situation with deep well-mixed convective PBL, that otherwise is +!.. likely to get clouds in more realistic capping inversion layer. + + kbot = kts+2 + DO k = kbot, k_m12C + if ( (theta(k)-theta(k-1)) .gt. 0.05E-3*dz(k)) EXIT + ENDDO + kbot = MAX(kts+1, k-2) + DO k = kts, kbot + if (cfr1d(k).gt.0.0 .and. cfr1d(k).lt.0.999) cfr1d(k) = 0. + ENDDO + + +!..Starting below tropo height, if cloud fraction greater than 1 percent, +!.. compute an approximate total layer depth of cloud, determine a total +!.. liquid water/ice path (LWP/IWP), then reduce that amount with tuning +!.. parameter to represent entrainment factor, then divide up LWP/IWP +!.. into delta-Z weighted amounts for individual levels per cloud layer. + + + k_cldb = k_tropo + in_cloud = .false. + k = k_tropo + DO WHILE (.not. in_cloud .AND. k.gt.k_m12C) + k_cldt = 0 + if (cfr1d(k).ge.0.01) then + in_cloud = .true. + k_cldt = MAX(k_cldt, k) + endif if (in_cloud) then DO k2 = k_cldt-1, k_m12C, -1 if (cfr1d(k2).lt.0.01 .or. k2.eq.k_m12C) then @@ -3898,149 +4250,149 @@ SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & END SUBROUTINE find_cloudLayers !+---+-----------------------------------------------------------------+ - + SUBROUTINE adjust_cloudIce(cfr,qi,qs,qvs, T,Rho,dz, entr, k1,k2, & - & kts,kte) -! - IMPLICIT NONE -! - INTEGER, INTENT(IN):: k1,k2, kts,kte - REAL, INTENT(IN):: entr - REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qvs, T, Rho, dz - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qi, qs - REAL:: iwc, max_iwc, tdz, this_iwc, this_dz, iwp_exists - INTEGER:: k, kmid - - tdz = 0. - do k = k1, k2 - tdz = tdz + dz(k) - enddo - kmid = NINT(0.5*(k1+k2)) - max_iwc = ABS(qvs(k2-1)-qvs(k1)) -! print*, ' max_iwc = ', max_iwc, ' over DZ=',tdz - - iwp_exists = 0. - do k = k1, k2 - iwp_exists = iwp_exists + (qi(k)+qs(k))*Rho(k)*dz(k) - enddo - if (iwp_exists .gt. 1.0) RETURN - - this_dz = 0.0 - do k = k1, k2 - if (k.eq.k1) then - this_dz = this_dz + 0.5*dz(k) - else - this_dz = this_dz + dz(k) - endif - this_iwc = max_iwc*this_dz/tdz - iwc = MAX(1.E-6, this_iwc*(1.-entr)) - if (cfr(k).gt.0.01.and.cfr(k).lt.0.99.and.T(k).ge.203.16) then - qi(k) = qi(k) + 0.1*cfr(k)*iwc + & kts,kte) +! + IMPLICIT NONE +! + INTEGER, INTENT(IN):: k1,k2, kts,kte + REAL, INTENT(IN):: entr + REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, qvs, T, Rho, dz + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qi, qs + REAL:: iwc, max_iwc, tdz, this_iwc, this_dz, iwp_exists + INTEGER:: k, kmid + + tdz = 0. + do k = k1, k2 + tdz = tdz + dz(k) + enddo + kmid = NINT(0.5*(k1+k2)) + max_iwc = ABS(qvs(k2-1)-qvs(k1)) +! print*, ' max_iwc = ', max_iwc, ' over DZ=',tdz + + iwp_exists = 0. + do k = k1, k2 + iwp_exists = iwp_exists + (qi(k)+qs(k))*Rho(k)*dz(k) + enddo + if (iwp_exists .gt. 1.0) RETURN + + this_dz = 0.0 + do k = k1, k2 + if (k.eq.k1) then + this_dz = this_dz + 0.5*dz(k) + else + this_dz = this_dz + dz(k) + endif + this_iwc = max_iwc*this_dz/tdz + iwc = MAX(1.E-6, this_iwc*(1.-entr)) + if (cfr(k).gt.0.01.and.cfr(k).lt.0.99.and.T(k).ge.203.16) then + qi(k) = qi(k) + 0.1*cfr(k)*iwc elseif (qi(k).lt.1.E-5.and.cfr(k).ge.0.99.and.T(k).ge.203.16) & - & then + & then qi(k) = qi(k) + 0.01*iwc - endif - enddo - - END SUBROUTINE adjust_cloudIce - -!+---+-----------------------------------------------------------------+ - + endif + enddo + + END SUBROUTINE adjust_cloudIce + +!+---+-----------------------------------------------------------------+ + SUBROUTINE adjust_cloudH2O(cfr, qc, qvs, T,Rho,dz, entr, k1,k2, & - & kts,kte) -! - IMPLICIT NONE -! - INTEGER, INTENT(IN):: k1,k2, kts,kte - REAL, INTENT(IN):: entr - REAL, DIMENSION(kts:kte):: cfr, qc, qvs, T, Rho, dz - REAL:: lwc, max_lwc, tdz, this_lwc, this_dz, lwp_exists - INTEGER:: k, kmid - - tdz = 0. - do k = k1, k2 - tdz = tdz + dz(k) - enddo - kmid = NINT(0.5*(k1+k2)) - max_lwc = ABS(qvs(k2-1)-qvs(k1)) -! print*, ' max_lwc = ', max_lwc, ' over DZ=',tdz - - lwp_exists = 0. - do k = k1, k2 - lwp_exists = lwp_exists + qc(k)*Rho(k)*dz(k) - enddo - if (lwp_exists .gt. 1.0) RETURN - - this_dz = 0.0 - do k = k1, k2 - if (k.eq.k1) then - this_dz = this_dz + 0.5*dz(k) - else - this_dz = this_dz + dz(k) - endif - this_lwc = max_lwc*this_dz/tdz - lwc = MAX(1.E-6, this_lwc*(1.-entr)) + & kts,kte) +! + IMPLICIT NONE +! + INTEGER, INTENT(IN):: k1,k2, kts,kte + REAL, INTENT(IN):: entr + REAL, DIMENSION(kts:kte):: cfr, qc, qvs, T, Rho, dz + REAL:: lwc, max_lwc, tdz, this_lwc, this_dz, lwp_exists + INTEGER:: k, kmid + + tdz = 0. + do k = k1, k2 + tdz = tdz + dz(k) + enddo + kmid = NINT(0.5*(k1+k2)) + max_lwc = ABS(qvs(k2-1)-qvs(k1)) +! print*, ' max_lwc = ', max_lwc, ' over DZ=',tdz + + lwp_exists = 0. + do k = k1, k2 + lwp_exists = lwp_exists + qc(k)*Rho(k)*dz(k) + enddo + if (lwp_exists .gt. 1.0) RETURN + + this_dz = 0.0 + do k = k1, k2 + if (k.eq.k1) then + this_dz = this_dz + 0.5*dz(k) + else + this_dz = this_dz + dz(k) + endif + this_lwc = max_lwc*this_dz/tdz + lwc = MAX(1.E-6, this_lwc*(1.-entr)) if (cfr(k).gt.0.01.and.cfr(k).lt.0.99.and.T(k).lt.298.16.and. & - & T(k).ge.253.16) then - qc(k) = qc(k) + cfr(k)*cfr(k)*lwc + & T(k).ge.253.16) then + qc(k) = qc(k) + cfr(k)*cfr(k)*lwc elseif (cfr(k).ge.0.99.and.qc(k).lt.1.E-5.and.T(k).lt.298.16 & - & .and.T(k).ge.253.16) then - qc(k) = qc(k) + 0.1*lwc - endif - enddo - - END SUBROUTINE adjust_cloudH2O - - -!+---+-----------------------------------------------------------------+ - -!..Do not alter any grid-explicitly resolved hydrometeors, rather only -!.. the supposed amounts due to the cloud fraction scheme. - - SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte,k_tropo) -! - IMPLICIT NONE -! - INTEGER, INTENT(IN):: kts,kte,k_tropo - REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, Rho, dz - REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc, qi - REAL:: lwp, iwp, xfac - INTEGER:: k - - lwp = 0. - do k = kts, k_tropo - if (cfr(k).gt.0.0) then - lwp = lwp + qc(k)*Rho(k)*dz(k) - endif - enddo - - iwp = 0. - do k = kts, k_tropo - if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then - iwp = iwp + qi(k)*Rho(k)*dz(k) - endif - enddo - - if (lwp .gt. 1.5) then - xfac = 1./lwp - do k = kts, k_tropo - if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then - qc(k) = qc(k)*xfac - endif - enddo - endif - - if (iwp .gt. 1.5) then - xfac = 1./iwp - do k = kts, k_tropo - if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then - qi(k) = qi(k)*xfac - endif - enddo - endif - - END SUBROUTINE adjust_cloudFinal - + & .and.T(k).ge.253.16) then + qc(k) = qc(k) + 0.1*lwc + endif + enddo + + END SUBROUTINE adjust_cloudH2O + + +!+---+-----------------------------------------------------------------+ + +!..Do not alter any grid-explicitly resolved hydrometeors, rather only +!.. the supposed amounts due to the cloud fraction scheme. + + SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte,k_tropo) +! + IMPLICIT NONE +! + INTEGER, INTENT(IN):: kts,kte,k_tropo + REAL, DIMENSION(kts:kte), INTENT(IN):: cfr, Rho, dz + REAL, DIMENSION(kts:kte), INTENT(INOUT):: qc, qi + REAL:: lwp, iwp, xfac + INTEGER:: k + + lwp = 0. + do k = kts, k_tropo + if (cfr(k).gt.0.0) then + lwp = lwp + qc(k)*Rho(k)*dz(k) + endif + enddo + + iwp = 0. + do k = kts, k_tropo + if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + iwp = iwp + qi(k)*Rho(k)*dz(k) + endif + enddo + + if (lwp .gt. 1.5) then + xfac = 1./lwp + do k = kts, k_tropo + if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + qc(k) = qc(k)*xfac + endif + enddo + endif + + if (iwp .gt. 1.5) then + xfac = 1./iwp + do k = kts, k_tropo + if (cfr(k).gt.0.01 .and. cfr(k).lt.0.99) then + qi(k) = qi(k)*xfac + endif + enddo + endif + + END SUBROUTINE adjust_cloudFinal + ! !........................................! end module module_radiation_clouds ! From ac32ce0297022819a2c984374a622fd71b8d1749 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 24 Mar 2020 11:23:01 -0600 Subject: [PATCH 018/274] remove the connection of iovrlw/iovrsw with physparam --- physics/GFS_rrtmg_pre.F90 | 67 +++++++++------- physics/radiation_clouds.f | 158 ++++++++++++++++++++++++------------- 2 files changed, 139 insertions(+), 86 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 7a5894f2e..952673f95 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -62,7 +62,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input & NSPC1 use module_radiation_clouds, only: NF_CLDS, & ! cld_init & progcld1, progcld3, & - & progcld2, & +! & progcld2, & & progcld4, progcld5, & & progcld6, & !F-A & progclduni, & @@ -787,11 +787,12 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! or unified cloud and/or with MG microphysics if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & - IM, LMK, LMP, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs + Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & + IM, LMK, LMP, cldcov, & + effrl, effri, effrr, effrs, Model%effr_in, & + Model%iovr_lw, Model%iovr_sw, & ! mz* for iovr=3 should come from + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ccnd(1:IM,1:LMK,1), Grid%xlat,Grid%xlon, & @@ -799,6 +800,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Model%uni_cld, Model%lmfshal, & Model%lmfdeep2, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & + Model%iovr_lw, Model%iovr_sw, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif @@ -809,23 +811,26 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input cnvw, cnvc, Grid%xlat, Grid%xlon, & Sfcprop%slmsk, dz, delp, im, lmk, lmp, deltaq, & Model%sup, Model%kdt, me, & + Model%iovr_lw, Model%iovr_sw, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs elseif (Model%imp_physics == 11) then ! GFDL cloud scheme if (.not.Model%lgfdlmprad) then - call progcld4 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs - ccnd(1:IM,1:LMK,1), cnvw, cnvc, & - Grid%xlat, Grid%xlon, Sfcprop%slmsk, & - cldcov, dz, delp, im, lmk, lmp, & + call progcld4 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs + ccnd(1:IM,1:LMK,1), cnvw, cnvc, & + Grid%xlat, Grid%xlon, Sfcprop%slmsk, & + cldcov, dz, delp, im, lmk, lmp, & + Model%iovr_lw, Model%iovr_sw, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else - call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & - IM, LMK, LMP, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs + Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & + IM, LMK, LMP, cldcov, & + effrl, effri, effrr, effrs, Model%effr_in, & + Model%iovr_lw, Model%iovr_sw, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs ! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ! tracer1, Grid%xlat, Grid%xlon, Sfcprop%slmsk, & @@ -844,14 +849,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif !mz* this is original progcld5 - temporary - call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & - Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lmk, lmp, Model%uni_cld, & + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & + Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + Model%iovr_lw, Model%iovr_sw, & clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs @@ -862,14 +868,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd%phy_f3d(:,:,Model%nseffr) = 250. endif - call progcld5 (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,tracer1,& ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & - ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & - im, lmk, lmp, Model%icloud,Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & - Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + call progcld5 (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,tracer1, & ! --- inputs + Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + ntrac-1, ntcw-1,ntiw-1,ntrw-1, & + ntsw-1,ntgl-1, & + im, lmk, lmp, Model%icloud,Model%uni_cld, & + Model%lmfshal,Model%lmfdeep2, & + cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & + Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + Model%iovr_lw, Model%iovr_sw, & clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs endif ! end if_imp_physics diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 41da8953f..b76d57eaf 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -194,14 +194,16 @@ !> This module computes cloud related quantities for radiation computations. module module_radiation_clouds ! - use physparam, only : icldflg, iovrsw, iovrlw, & +!mz* iovrsw, iovrlw need to come from NML + use physparam, only : icldflg, &!mz:iovrsw, iovrlw,& & lcrick, lcnorm, lnoprec, & - & ivflip, kind_phys, kind_io4 + & ivflip use physcons, only : con_fvirt, con_ttp, con_rocp, & & con_t0c, con_pi, con_g, con_rd, & & con_thgni use module_microphysics, only : rsipath2 use module_iounitdef, only : NICLTUN + use machine, only : kind_phys ! implicit none ! @@ -240,7 +242,7 @@ module module_radiation_clouds real (kind=kind_phys), parameter :: cldasy_def = 0.84 !< default cld asymmetry factor integer :: llyr = 2 !< upper limit of boundary layer clouds - integer :: iovr = 1 !< maximum-random cloud overlapping method +!mz integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & & cld_init, progcld5, progcld4o, & @@ -331,7 +333,7 @@ subroutine cld_init & ! ! --- set up module variables - iovr = max( iovrsw, iovrlw ) !cld ovlp used for diag HML cld output +!mz iovr = max( iovrsw, iovrlw ) !cld ovlp used for diag HML cld output if (me == 0) print *, VTAGCLD !print out version tag @@ -441,6 +443,7 @@ subroutine progcld1 & & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & effrl,effri,effrr,effrs,effr_in, & + & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -524,7 +527,7 @@ subroutine progcld1 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: IX, NLAY, NLP1,iovr_lw,iovr_sw logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, effr_in @@ -552,7 +555,7 @@ subroutine progcld1 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf + integer :: i, k, id, nf,iovrw ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -560,6 +563,8 @@ subroutine progcld1 & ! !===> ... begin here +!mz + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output ! do nf=1,nf_clds do k=1,nlay @@ -801,7 +806,7 @@ subroutine progcld1 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -815,7 +820,7 @@ subroutine progcld1 & call gethml & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & - & IX,NLAY, & + & IX,NLAY, iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -873,6 +878,7 @@ subroutine progcld2 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, & & IX, NLAY, NLP1, lmfshal, lmfdeep2, & + & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -961,7 +967,7 @@ subroutine progcld2 & ! --- constants ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: IX, NLAY, NLP1, iovr_lw,iovr_sw logical, intent(in) :: lmfshal, lmfdeep2 @@ -991,7 +997,7 @@ subroutine progcld2 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id + integer :: i, k, id, iovrw ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -1001,6 +1007,10 @@ subroutine progcld2 & !===> ... begin here ! ! clouds(:,:,:) = 0.0 +!zm +!mz$ + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output$ + !> - Assign water/ice/rain/snow cloud properties for Ferrier scheme. do k = 1, NLAY @@ -1247,7 +1257,7 @@ subroutine progcld2 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -1264,6 +1274,7 @@ subroutine progcld2 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & + & iovr_lw,iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -1322,6 +1333,7 @@ subroutine progcld3 & & xlat,xlon,slmsk, dz, delp, & & ix, nlay, nlp1, & & deltaq,sup,kdt,me, & + & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -1404,7 +1416,7 @@ subroutine progcld3 & implicit none ! --- inputs - integer, intent(in) :: ix, nlay, nlp1,kdt + integer, intent(in) :: ix, nlay, nlp1,kdt,iovr_lw,iovr_sw real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp @@ -1436,11 +1448,14 @@ subroutine progcld3 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf + integer :: i, k, id, nf, iovrw ! !===> ... begin here ! +!mz + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output + do nf=1,nf_clds do k=1,nlay do i=1,ix @@ -1644,7 +1659,7 @@ subroutine progcld3 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -1662,6 +1677,7 @@ subroutine progcld3 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & ix,nlay, & + & iovr_lw,iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -1718,7 +1734,8 @@ end subroutine progcld3 subroutine progcld4 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: & xlat,xlon,slmsk,cldtot, dz, delp, & - & IX, NLAY, NLP1, & + & IX, NLAY, NLP1, & + & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -1799,7 +1816,7 @@ subroutine progcld4 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: IX, NLAY, NLP1,iovr_lw,iovr_sw real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, clw, cldtot, cnvw, cnvc, & @@ -1825,11 +1842,14 @@ subroutine progcld4 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf + integer :: i, k, id, nf,iovrw ! !===> ... begin here ! +!mz + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output + do nf=1,nf_clds do k=1,nlay do i=1,ix @@ -1981,7 +2001,7 @@ subroutine progcld4 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -1997,6 +2017,7 @@ subroutine progcld4 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & + & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -2060,6 +2081,7 @@ subroutine progcld4o & & xlat,xlon,slmsk, dz, delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,ntclamt, & & IX, NLAY, NLP1, & + & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -2139,7 +2161,7 @@ subroutine progcld4o & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: IX, NLAY, NLP1, iovr_lw, iovr_sw integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, & & ntclamt @@ -2169,10 +2191,12 @@ subroutine progcld4o & & tem1, tem2, tem3 real (kind=kind_phys), dimension(IX,NLAY) :: cldtot - integer :: i, k, id, nf + integer :: i, k, id, nf, iovrw ! !===> ... begin here +!mz + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output ! do nf=1,nf_clds do k=1,nlay @@ -2309,7 +2333,7 @@ subroutine progcld4o & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -2325,6 +2349,7 @@ subroutine progcld4o & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & + & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -2343,11 +2368,12 @@ end subroutine progcld4o !! microphysics scheme. subroutine progcld5 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, & - & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & + & xlat,xlon,slmsk,dz,delp, & + & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & & IX, NLAY, NLP1,icloud, & - & uni_cld, lmfshal, lmfdeep2, cldcov, & - & re_cloud,re_ice,re_snow, & + & uni_cld, lmfshal, lmfdeep2, cldcov, & + & re_cloud,re_ice,re_snow, & + & iovr_lw,iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -2431,7 +2457,7 @@ subroutine progcld5 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1,ICLOUD + integer, intent(in) :: IX, NLAY, NLP1,ICLOUD,iovr_lw,iovr_sw integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 @@ -2466,7 +2492,7 @@ subroutine progcld5 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf + integer :: i, k, id, nf, iovrw ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -2474,6 +2500,8 @@ subroutine progcld5 & ! !===> ... begin here +!mz + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output ! do nf=1,nf_clds do k=1,nlay @@ -2738,7 +2766,7 @@ subroutine progcld5 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -2757,6 +2785,7 @@ subroutine progcld5 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & + & iovr_lw,iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -2772,11 +2801,12 @@ end subroutine progcld5 !mz: progcld5 benchmark subroutine progcld6 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, & - & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & + & xlat,xlon,slmsk,dz,delp, & + & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & & IX, NLAY, NLP1, & - & uni_cld, lmfshal, lmfdeep2, cldcov, & - & re_cloud,re_ice,re_snow, & + & uni_cld, lmfshal, lmfdeep2, cldcov, & + & re_cloud,re_ice,re_snow, & + & iovr_lw,iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -2858,12 +2888,12 @@ subroutine progcld6 & ! ! ! ==================== end of description ===================== ! ! - implicit none - -! --- inputs - integer, intent(in) :: IX, NLAY, NLP1 - integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl - + implicit none + +! --- inputs + integer, intent(in) :: IX, NLAY, NLP1,iovr_lw,iovr_sw + integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl + logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & @@ -2888,11 +2918,11 @@ subroutine progcld6 & & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) - - real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & - & tem1, tem2, tem3 - - integer :: i, k, id, nf + + real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & + & tem1, tem2, tem3 + + integer :: i, k, id, nf, iovrw ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -2900,7 +2930,10 @@ subroutine progcld6 & ! !===> ... begin here -! +!!mz$ + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output$ + +! do nf=1,nf_clds do k=1,nlay do i=1,ix @@ -3083,11 +3116,11 @@ subroutine progcld6 & clouds(i,k,9) = res(i,k) enddo enddo - + ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -3106,6 +3139,7 @@ subroutine progcld6 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & + & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -3163,6 +3197,7 @@ subroutine progclduni & & ( plyr,plvl,tlyr,tvly,ccnd,ncnd, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, cldtot, & & effrl,effri,effrr,effrs,effr_in, & + & iovr_lw,iovr_sw, & !mz* $ & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -3257,6 +3292,9 @@ subroutine progclduni & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk + !mz* for GFSv16 + integer, intent(in) :: iovr_lw, iovr_sw + ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds @@ -3267,6 +3305,7 @@ subroutine progclduni & integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: + integer :: iovrw real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, cwp, cip, & & crp, csp, rew, rei, res, rer real (kind=kind_phys), dimension(IX,NLAY,ncnd) :: cndf @@ -3288,6 +3327,9 @@ subroutine progclduni & ! enddo ! enddo ! +!mz* + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output + do k = 1, NLAY do i = 1, IX cldcnv(i,k) = 0.0 @@ -3457,7 +3499,7 @@ subroutine progclduni & !> -# Estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then + if ( iovrw == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -3476,6 +3518,7 @@ subroutine progclduni & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & + & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -3511,7 +3554,7 @@ end subroutine progclduni !! @{ subroutine gethml & & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & ! --- inputs: - & IX, NLAY, & + & IX, NLAY,iovr_lw,iovr_sw, & & clds, mtop, mbot & ! --- outputs: & ) @@ -3567,7 +3610,7 @@ subroutine gethml & implicit none! ! --- inputs: - integer, intent(in) :: IX, NLAY + integer, intent(in) :: IX, NLAY,iovr_sw,iovr_lw real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & & cldtot, cldcnv, dz @@ -3583,11 +3626,14 @@ subroutine gethml & real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 - integer :: i, k, id, id1, kstr, kend, kinc + integer :: i, k, id, id1, kstr, kend, kinc,iovrw ! !===> ... begin here ! +!mz* + iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output + clds(:,:) = 0.0 do i = 1, IX @@ -3611,7 +3657,7 @@ subroutine gethml & kinc = 1 endif ! end_if_ivflip - if ( iovr == 0 ) then ! random overlap + if ( iovrw == 0 ) then ! random overlap do k = kstr, kend, kinc do i = 1, IX @@ -3630,7 +3676,7 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) ! save total cloud enddo - elseif ( iovr == 1 ) then ! max/ran overlap + elseif ( iovrw == 1 ) then ! max/ran overlap do k = kstr, kend, kinc do i = 1, IX @@ -3654,7 +3700,7 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud enddo - elseif ( iovr == 2 ) then ! maximum overlap all levels + elseif ( iovrw == 2 ) then ! maximum overlap all levels cl1(:) = 0.0 @@ -3675,7 +3721,7 @@ subroutine gethml & clds(i,4) = cl1(i) ! save total cloud enddo - elseif ( iovr == 3 ) then ! random if clear-layer divided, + elseif ( iovrw == 3 ) then ! random if clear-layer divided, ! otherwise de-corrlength method do i = 1, ix dz1(i) = - dz(i,kstr) @@ -3761,7 +3807,7 @@ subroutine gethml & if (kth2(i) == 0) kbt2(i) = k kth2(i) = kth2(i) + 1 - if ( iovr == 0 ) then + if ( iovrw == 0 ) then cl2(i) = cl2(i) + ccur - cl2(i)*ccur else cl2(i) = max( cl2(i), ccur ) @@ -3843,7 +3889,7 @@ subroutine gethml & if (kth2(i) == 0) kbt2(i) = k kth2(i) = kth2(i) + 1 - if ( iovr == 0 ) then + if ( iovrw == 0 ) then cl2(i) = cl2(i) + ccur - cl2(i)*ccur else cl2(i) = max( cl2(i), ccur ) From 5404462a72fe10477595c25baab0ae28fe667f0f Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Tue, 7 Apr 2020 10:04:47 -0600 Subject: [PATCH 019/274] add new radlw/radsw main with modern fortran --- physics/radlw_main.F90 | 8976 ++++++++++++++++++++++++++++++++++++++++ physics/radsw_main.F90 | 6339 ++++++++++++++++++++++++++++ 2 files changed, 15315 insertions(+) create mode 100644 physics/radlw_main.F90 create mode 100644 physics/radsw_main.F90 diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 new file mode 100644 index 000000000..0596a987c --- /dev/null +++ b/physics/radlw_main.F90 @@ -0,0 +1,8976 @@ +!> \file radlw_main.f +!! This file contains NCEP's modifications of the rrtmg-lw radiation +!! code from AER. + +!!!!! ============================================================== !!!!! +!!!!! lw-rrtm3 radiation package description !!!!! +!!!!! ============================================================== !!!!! +! ! +! this package includes ncep's modifications of the rrtm-lw radiation ! +! code from aer inc. ! +! ! +! the lw-rrtm3 package includes these parts: ! +! ! +! 'radlw_rrtm3_param.f' ! +! 'radlw_rrtm3_datatb.f' ! +! 'radlw_rrtm3_main.f' ! +! ! +! the 'radlw_rrtm3_param.f' contains: ! +! ! +! 'module_radlw_parameters' -- band parameters set up ! +! ! +! the 'radlw_rrtm3_datatb.f' contains: ! +! ! +! 'module_radlw_avplank' -- plank flux data ! +! 'module_radlw_ref' -- reference temperature and pressure ! +! 'module_radlw_cldprlw' -- cloud property coefficients ! +! 'module_radlw_kgbnn' -- absorption coeffients for 16 ! +! bands, where nn = 01-16 ! +! ! +! the 'radlw_rrtm3_main.f' contains: ! +! ! +! 'rrtmg_lw' -- main lw radiation transfer ! +! ! +! in the main module 'rrtmg_lw' there are only two ! +! externally callable subroutines: ! +! ! +! ! +! 'lwrad' -- main lw radiation routine ! +! inputs: ! +! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! +! clouds,icseed,aerosols,sfemis,sfgtmp, ! +! dzlyr,delpin,de_lgth, ! +! npts, nlay, nlp1, lprnt, ! +! outputs: ! +! hlwc,topflx,sfcflx,cldtau, ! +!! optional outputs: ! +! HLW0,HLWB,FLXPRF) ! +! ! +! 'rlwinit' -- initialization routine ! +! inputs: ! +! ( me ) ! +! outputs: ! +! (none) ! +! ! +! all the lw radiation subprograms become contained subprograms ! +! in module 'rrtmg_lw' and many of them are not directly ! +! accessable from places outside the module. ! +! ! +! derived data type constructs used: ! +! ! +! 1. radiation flux at toa: (from module 'module_radlw_parameters') ! +! topflw_type - derived data type for toa rad fluxes ! +! upfxc total sky upward flux at toa ! +! upfx0 clear sky upward flux at toa ! +! ! +! 2. radiation flux at sfc: (from module 'module_radlw_parameters') ! +! sfcflw_type - derived data type for sfc rad fluxes ! +! upfxc total sky upward flux at sfc ! +! upfx0 clear sky upward flux at sfc ! +! dnfxc total sky downward flux at sfc ! +! dnfx0 clear sky downward flux at sfc ! +! ! +! 3. radiation flux profiles(from module 'module_radlw_parameters') ! +! proflw_type - derived data type for rad vertical prof ! +! upfxc level upward flux for total sky ! +! dnfxc level downward flux for total sky ! +! upfx0 level upward flux for clear sky ! +! dnfx0 level downward flux for clear sky ! +! ! +! external modules referenced: ! +! ! +! 'module physparam' ! +! 'module physcons' ! +! 'mersenne_twister' ! +! ! +! compilation sequence is: ! +! ! +! 'radlw_rrtm3_param.f' ! +! 'radlw_rrtm3_datatb.f' ! +! 'radlw_rrtm3_main.f' ! +! ! +! and all should be put in front of routines that use lw modules ! +! ! +!==========================================================================! +! ! +! the original aer's program declarations: ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! | +! Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). | +! This software may be used, copied, or redistributed as long as it is | +! not sold and this copyright notice is reproduced on each copy made. | +! This model is provided as is without any express or implied warranties. | +! (http://www.rtweb.aer.com/) | +! | +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! ************************************************************************ ! +! ! +! rrtmg_lw ! +! ! +! ! +! a rapid radiative transfer model ! +! for the longwave region ! +! for application to general circulation models ! +! ! +! ! +! atmospheric and environmental research, inc. ! +! 131 hartwell avenue ! +! lexington, ma 02421 ! +! ! +! eli j. mlawer ! +! jennifer s. delamere ! +! michael j. iacono ! +! shepard a. clough ! +! ! +! ! +! email: miacono@aer.com ! +! email: emlawer@aer.com ! +! email: jdelamer@aer.com ! +! ! +! the authors wish to acknowledge the contributions of the ! +! following people: steven j. taubman, karen cady-pereira, ! +! patrick d. brown, ronald e. farren, luke chen, robert bergstrom. ! +! ! +! ************************************************************************ ! +! ! +! references: ! +! (rrtm_lw/rrtmg_lw): ! +! clough, s.A., m.w. shephard, e.j. mlawer, j.s. delamere, ! +! m.j. iacono, k. cady-pereira, s. boukabara, and p.d. brown: ! +! atmospheric radiative transfer modeling: a summary of the aer ! +! codes, j. quant. spectrosc. radiat. transfer, 91, 233-244, 2005. ! +! ! +! mlawer, e.j., s.j. taubman, p.d. brown, m.j. iacono, and s.a. ! +! clough: radiative transfer for inhomogeneous atmospheres: rrtm, ! +! a validated correlated-k model for the longwave. j. geophys. res., ! +! 102, 16663-16682, 1997. ! +! ! +! (mcica): ! +! pincus, r., h. w. barker, and j.-j. morcrette: a fast, flexible, ! +! approximation technique for computing radiative transfer in ! +! inhomogeneous cloud fields, j. geophys. res., 108(d13), 4376, ! +! doi:10.1029/2002JD003322, 2003. ! +! ! +! ************************************************************************ ! +! ! +! aer's revision history: ! +! this version of rrtmg_lw has been modified from rrtm_lw to use a ! +! reduced set of g-points for application to gcms. ! +! ! +! -- original version (derived from rrtm_lw), reduction of g-points, ! +! other revisions for use with gcms. ! +! 1999: m. j. iacono, aer, inc. ! +! -- adapted for use with ncar/cam3. ! +! may 2004: m. j. iacono, aer, inc. ! +! -- revised to add mcica capability. ! +! nov 2005: m. j. iacono, aer, inc. ! +! -- conversion to f90 formatting for consistency with rrtmg_sw. ! +! feb 2007: m. j. iacono, aer, inc. ! +! -- modifications to formatting to use assumed-shape arrays. ! +! aug 2007: m. j. iacono, aer, inc. ! +! ! +! ************************************************************************ ! +! ! +! ncep modifications history log: ! +! ! +! nov 1999, ken campana -- received the original code from ! +! aer (1998 ncar ccm version), updated to link up with ! +! ncep mrf model ! +! jun 2000, ken campana -- added option to switch random and ! +! maximum/random cloud overlap ! +! 2001, shrinivas moorthi -- further updates for mrf model ! +! may 2001, yu-tai hou -- updated on trace gases and cloud ! +! property based on rrtm_v3.0 codes. ! +! dec 2001, yu-tai hou -- rewritten code into fortran 90 std ! +! set ncep radiation structure standard that contains ! +! three plug-in compatable fortran program files: ! +! 'radlw_param.f', 'radlw_datatb.f', 'radlw_main.f' ! +! fixed bugs in subprograms taugb14, taugb2, etc. added ! +! out-of-bounds protections. (a detailed note of ! +! up_to_date modifications/corrections by ncep was sent ! +! to aer in 2002) ! +! jun 2004, yu-tai hou -- added mike iacono's apr 2004 ! +! modification of variable diffusivity angles. ! +! apr 2005, yu-tai hou -- minor modifications on module ! +! structures include rain/snow effect (this version of ! +! code was given back to aer in jun 2006) ! +! mar 2007, yu-tai hou -- added aerosol effect for ncep ! +! models using the generallized aerosol optical property! +! scheme for gfs model. ! +! apr 2007, yu-tai hou -- added spectral band heating as an ! +! optional output to support the 500 km gfs model's ! +! upper stratospheric radiation calculations. and ! +! restructure optional outputs for easy access by ! +! different models. ! +! oct 2008, yu-tai hou -- modified to include new features ! +! from aer's newer release v4.4-v4.7, including the ! +! mcica sub-grid cloud option. add rain/snow optical ! +! properties support to cloudy sky calculations. ! +! correct errors in mcica cloud optical properties for ! +! ebert & curry scheme (ilwcice=1) that needs band ! +! index conversion. simplified and unified sw and lw ! +! sub-column cloud subroutines into one module by using ! +! optional parameters. ! +! mar 2009, yu-tai hou -- replaced the original random number! +! generator coming from the original code with ncep w3 ! +! library to simplify the program and moved sub-column ! +! cloud subroutines inside the main module. added ! +! option of user provided permutation seeds that could ! +! be randomly generated from forecast time stamp. ! +! oct 2009, yu-tai hou -- modified subrtines "cldprop" and ! +! "rlwinit" according updats from aer's rrtmg_lw v4.8. ! +! nov 2009, yu-tai hou -- modified subrtine "taumol" according +! updats from aer's rrtmg_lw version 4.82. notice the ! +! cloud ice/liquid are assumed as in-cloud quantities, ! +! not as grid averaged quantities. ! +! jun 2010, yu-tai hou -- optimized code to improve efficiency +! apr 2012, b. ferrier and y. hou -- added conversion factor to fu's! +! cloud-snow optical property scheme. ! +! nov 2012, yu-tai hou -- modified control parameters thru ! +! module 'physparam'. ! +! FEB 2017 A.Cheng - add odpth output, effective radius input ! +! jun 2018, h-m lin/y-t hou -- added new option of cloud overlap ! +! method 'de-correlation-length' for mcica application ! +! ! +!!!!! ============================================================== !!!!! +!!!!! end descriptions !!!!! +!!!!! ============================================================== !!!!! + +!> This module contains the CCPP-compliant NCEP's modifications of the +!! rrtm-lw radiation code from aer inc. + module rrtmg_lw +! + use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & + & icldflg, ivflip + use physcons, only : con_g, con_cp, con_avgd, con_amd, & + & con_amw, con_amo3 + use mersenne_twister, only : random_setseed, random_number, & + & random_stat +!mz + use machine, only : kind_phys, & + & im => kind_io4, rb => kind_phys + + use module_radlw_parameters +! + use module_radlw_avplank, only : totplnk + use module_radlw_ref, only : preflog, tref, chi_mls +! + implicit none +! + private +! +! ... version tag and last revision date + character(40), parameter :: & + & VTAGLW='NCEP LW v5.1 Nov 2012 -RRTMG-LW v4.82 ' +! & VTAGLW='NCEP LW v5.0 Aug 2012 -RRTMG-LW v4.82 ' +! & VTAGLW='RRTMG-LW v4.82 Nov 2009 ' +! & VTAGLW='RRTMG-LW v4.8 Oct 2009 ' +! & VTAGLW='RRTMG-LW v4.71 Mar 2009 ' +! & VTAGLW='RRTMG-LW v4.4 Oct 2008 ' +! & VTAGLW='RRTM-LW v2.3g Mar 2007 ' +! & VTAGLW='RRTM-LW v2.3g Apr 2004 ' + +! --- constant values + real (kind=kind_phys), parameter :: eps = 1.0e-6 + real (kind=kind_phys), parameter :: oneminus= 1.0-eps + real (kind=kind_phys), parameter :: cldmin = tiny(cldmin) + real (kind=kind_phys), parameter :: bpade = 1.0/0.278 ! pade approx constant + real (kind=kind_phys), parameter :: stpfac = 296.0/1013.0 + real (kind=kind_phys), parameter :: wtdiff = 0.5 ! weight for radiance to flux conversion + real (kind=kind_phys), parameter :: tblint = ntbl ! lookup table conversion factor + real (kind=kind_phys), parameter :: f_zero = 0.0 + real (kind=kind_phys), parameter :: f_one = 1.0 + +! ... atomic weights for conversion from mass to volume mixing ratios + real (kind=kind_phys), parameter :: amdw = con_amd/con_amw + real (kind=kind_phys), parameter :: amdo3 = con_amd/con_amo3 + +! ... band indices + integer, dimension(nbands) :: nspa, nspb + + data nspa / 1, 1, 9, 9, 9, 1, 9, 1, 9, 1, 1, 9, 9, 1, 9, 9 / + data nspb / 1, 1, 5, 5, 5, 0, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0 / + +! ... band wavenumber intervals +! real (kind=kind_phys) :: wavenum1(nbands), wavenum2(nbands) +! data wavenum1/ & +! & 10., 350., 500., 630., 700., 820., 980., 1080., & +!err & 1180., 1390., 1480., 1800., 2080., 2250., 2390., 2600. / +! & 1180., 1390., 1480., 1800., 2080., 2250., 2380., 2600. / +! data wavenum2/ & +! & 350., 500., 630., 700., 820., 980., 1080., 1180., & +!err & 1390., 1480., 1800., 2080., 2250., 2390., 2600., 3250. / +! & 1390., 1480., 1800., 2080., 2250., 2380., 2600., 3250. / +! real (kind=kind_phys) :: delwave(nbands) +! data delwave / 340., 150., 130., 70., 120., 160., 100., 100., & +! & 210., 90., 320., 280., 170., 130., 220., 650. / + +! --- reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 +! and 1.80) as a function of total column water vapor. the function +! has been defined to minimize flux and cooling rate errors in these bands +! over a wide range of precipitable water values. + real (kind=kind_phys), dimension(nbands) :: a0, a1, a2 + + data a0 / 1.66, 1.55, 1.58, 1.66, 1.54, 1.454, 1.89, 1.33, & + & 1.668, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66 / + data a1 / 0.00, 0.25, 0.22, 0.00, 0.13, 0.446, -0.10, 0.40, & + & -0.006, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + data a2 / 0.00, -12.0, -11.7, 0.00, -0.72,-0.243, 0.19,-0.062, & + & 0.414, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + +!! --- logical flags for optional output fields + + logical :: lhlwb = .false. + logical :: lhlw0 = .false. + logical :: lflxprf= .false. + +! --- those data will be set up only once by "rlwinit" + +! ... fluxfac, heatfac are factors for fluxes (in w/m**2) and heating +! rates (in k/day, or k/sec set by subroutine 'rlwinit') +! semiss0 are default surface emissivity for each bands + + real (kind=kind_phys) :: fluxfac, heatfac, semiss0(nbands) + data semiss0(:) / nbands*1.0 / + + real (kind=kind_phys) :: tau_tbl(0:ntbl) !< clr-sky opt dep (for cldy transfer) + real (kind=kind_phys) :: exp_tbl(0:ntbl) !< transmittance lookup table + real (kind=kind_phys) :: tfn_tbl(0:ntbl) !< tau transition function; i.e. the + !< transition of planck func from mean lyr + !< temp to lyr boundary temp as a func of + !< opt dep. "linear in tau" method is used. + +! --- the following variables are used for sub-column cloud scheme + + integer, parameter :: ipsdlw0 = ngptlw ! initial permutation seed + +! --- public accessable subprograms + + public rrtmg_lw_init, rrtmg_lw_run, rrtmg_lw_finalize, rlwinit + + +! ================ + contains +! ================ + + subroutine rrtmg_lw_init () + 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 +!! code from AER. +!! +!! The RRTM-LW package includes three files: +!! - radlw_param.f, which contains: +!! - module_radlw_parameters: band parameters set up +!! - radlw_datatb.f, which contains modules: +!! - module_radlw_avplank: plank flux data +!! - module_radlw_ref: reference temperature and pressure +!! - module_radlw_cldprlw: cloud property coefficients +!! - module_radlw_kgbnn: absorption coeffients for 16 bands, where nn = 01-16 +!! - radlw_main.f, which contains: +!! - rrtmg_lw_run(): the main LW radiation routine +!! - rlwinit(): the initialization routine +!! +!!\version NCEP LW v5.1 Nov 2012 -RRTMG-LW v4.82 +!! +!!\copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). +!! This software may be used, copied, or redistributed as long as it is +!! not sold and this copyright notice is reproduced on each copy made. +!! This model is provided as is without any express or implied warranties. +!! (http://www.rtweb.aer.com/) +!! \section arg_table_rrtmg_lw_run Argument Table +!! \htmlinclude rrtmg_lw_run.html +!! +!> \section gen_lwrad RRTMG Longwave Radiation Scheme General Algorithm +!> @{ + subroutine rrtmg_lw_run & + & ( plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr_co2, gasvmr_n2o, & ! --- inputs + & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & + & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & + & icseed,aeraod,aerssa,sfemis,sfgtmp, & + & dzlyr,delpin,de_lgth, iovrlw, isubclw, & + & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & + & hlwc,topflx,sfcflx,cldtau, & ! --- outputs + & HLW0,HLWB,FLXPRF, & ! --- optional + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od, mpirank,mpiroot,errmsg, errflg & + & ) + +! ==================== defination of variables ==================== ! +! ! +! input variables: ! +! plyr (npts,nlay) : layer mean pressures (mb) ! +! plvl (npts,nlp1) : interface pressures (mb) ! +! tlyr (npts,nlay) : layer mean temperature (k) ! +! tlvl (npts,nlp1) : interface temperatures (k) ! +! qlyr (npts,nlay) : layer specific humidity (gm/gm) *see inside ! +! olyr (npts,nlay) : layer ozone concentration (gm/gm) *see inside ! +! gasvmr(npts,nlay,:): atmospheric gases amount: ! +! (check module_radiation_gases for definition) ! +! gasvmr(:,:,1) - co2 volume mixing ratio ! +! gasvmr(:,:,2) - n2o volume mixing ratio ! +! gasvmr(:,:,3) - ch4 volume mixing ratio ! +! gasvmr(:,:,4) - o2 volume mixing ratio ! +! gasvmr(:,:,5) - co volume mixing ratio ! +! gasvmr(:,:,6) - cfc11 volume mixing ratio ! +! gasvmr(:,:,7) - cfc12 volume mixing ratio ! +! gasvmr(:,:,8) - cfc22 volume mixing ratio ! +! gasvmr(:,:,9) - ccl4 volume mixing ratio ! +! clouds(npts,nlay,:): layer cloud profiles: ! +! (check module_radiation_clouds for definition) ! +! clouds(:,:,1) - layer total cloud fraction ! +! clouds(:,:,2) - layer in-cloud liq water path (g/m**2) ! +! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! +! clouds(:,:,4) - layer in-cloud ice water path (g/m**2) ! +! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! +! clouds(:,:,6) - layer rain drop water path (g/m**2) ! +! clouds(:,:,7) - mean eff radius for rain drop (micron) ! +! clouds(:,:,8) - layer snow flake water path (g/m**2) ! +! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! icseed(npts) : auxiliary special cloud related array ! +! when module variable isubclw=2, it provides ! +! permutation seed for each column profile that ! +! are used for generating random numbers. ! +! when isubclw /=2, it will not be used. ! +! aerosols(npts,nlay,nbands,:) : aerosol optical properties ! +! (check module_radiation_aerosols for definition)! +! (:,:,:,1) - optical depth ! +! (:,:,:,2) - single scattering albedo ! +! (:,:,:,3) - asymmetry parameter ! +! sfemis (npts) : surface emissivity ! +! sfgtmp (npts) : surface ground temperature (k) ! +! dzlyr(npts,nlay) : layer thickness (km) ! +! delpin(npts,nlay): layer pressure thickness (mb) ! +! de_lgth(npts) : cloud decorrelation length (km) ! +! npts : total number of horizontal points ! +! nlay, nlp1 : total number of vertical layers, levels ! +! lprnt : cntl flag for diagnostic print out ! +! ! +! output variables: ! +! hlwc (npts,nlay): total sky heating rate (k/day or k/sec) ! +! topflx(npts) : radiation fluxes at top, component: ! +! (check module_radlw_paramters for definition) ! +! upfxc - total sky upward flux at top (w/m2) ! +! upfx0 - clear sky upward flux at top (w/m2) ! +! sfcflx(npts) : radiation fluxes at sfc, component: ! +! (check module_radlw_paramters for definition) ! +! upfxc - total sky upward flux at sfc (w/m2) ! +! upfx0 - clear sky upward flux at sfc (w/m2) ! +! dnfxc - total sky downward flux at sfc (w/m2) ! +! dnfx0 - clear sky downward flux at sfc (w/m2) ! +! cldtau(npts,nlay): approx 10mu band layer cloud optical depth ! +! ! +!! optional output variables: ! +! hlwb(npts,nlay,nbands): spectral band total sky heating rates ! +! hlw0 (npts,nlay): clear sky heating rate (k/day or k/sec) ! +! flxprf(npts,nlp1): level radiative fluxes (w/m2), components: ! +! (check module_radlw_paramters for definition) ! +! upfxc - total sky upward flux ! +! dnfxc - total sky dnward flux ! +! upfx0 - clear sky upward flux ! +! dnfx0 - clear sky dnward flux ! +! ! +! external module variables: (in physparam) ! +! ilwrgas - control flag for rare gases (ch4,n2o,o2,cfcs, etc.) ! +! =0: do not include rare gases ! +! >0: include all rare gases ! +! ilwcliq - control flag for liq-cloud optical properties ! +! =1: input cld liqp & reliq, hu & stamnes (1993) ! +! =2: not used ! +! ilwcice - control flag for ice-cloud optical properties ! +! =1: input cld icep & reice, ebert & curry (1997) ! +! =2: input cld icep & reice, streamer (1996) ! +! =3: input cld icep & reice, fu (1998) ! +! isubclw - sub-column cloud approximation control flag ! +! =0: no sub-col cld treatment, use grid-mean cld quantities ! +! =1: mcica sub-col, prescribed seeds to get random numbers ! +! =2: mcica sub-col, providing array icseed for random numbers! +! iovrlw - cloud overlapping control flag ! +! =0: random overlapping clouds ! +! =1: maximum/random overlapping clouds ! +! =2: maximum overlap cloud (used for isubclw>0 only) ! +! =3: decorrelation-length overlap (for isubclw>0 only) ! +! =4: exponential overlap cloud +! ivflip - control flag for vertical index direction ! +! =0: vertical index from toa to surface ! +! =1: vertical index from surface to toa ! +! ! +! module parameters, control variables: ! +! nbands - number of longwave spectral bands ! +! maxgas - maximum number of absorbing gaseous ! +! maxxsec - maximum number of cross-sections ! +! ngptlw - total number of g-point subintervals ! +! ng## - number of g-points in band (##=1-16) ! +! ngb(ngptlw) - band indices for each g-point ! +! bpade - pade approximation constant (1/0.278) ! +! nspa,nspb(nbands)- number of lower/upper ref atm's per band ! +! delwave(nbands) - longwave band width (wavenumbers) ! +! ipsdlw0 - permutation seed for mcica sub-col clds ! +! ! +! major local variables: ! +! pavel (nlay) - layer pressures (mb) ! +! delp (nlay) - layer pressure thickness (mb) ! +! tavel (nlay) - layer temperatures (k) ! +! tz (0:nlay) - level (interface) temperatures (k) ! +! semiss (nbands) - surface emissivity for each band ! +! wx (nlay,maxxsec) - cross-section molecules concentration ! +! coldry (nlay) - dry air column amount ! +! (1.e-20*molecules/cm**2) ! +! cldfrc (0:nlp1) - layer cloud fraction ! +! taucld (nbands,nlay) - layer cloud optical depth for each band ! +! cldfmc (ngptlw,nlay) - layer cloud fraction for each g-point ! +! tauaer (nbands,nlay) - aerosol optical depths ! +! fracs (ngptlw,nlay) - planck fractions ! +! tautot (ngptlw,nlay) - total optical depths (gaseous+aerosols) ! +! colamt (nlay,maxgas) - column amounts of absorbing gases ! +! 1-maxgas are for watervapor, carbon ! +! dioxide, ozone, nitrous oxide, methane, ! +! oxigen, carbon monoxide, respectively ! +! (molecules/cm**2) ! +! pwvcm - column precipitable water vapor (cm) ! +! secdiff(nbands) - variable diffusivity angle defined as ! +! an exponential function of the column ! +! water amount in bands 2-3 and 5-9. ! +! this reduces the bias of several w/m2 in ! +! downward surface flux in high water ! +! profiles caused by using the constant ! +! diffusivity angle of 1.66. (mji) ! +! facij (nlay) - indicator of interpolation factors ! +! =0/1: indicate lower/higher temp & height ! +! selffac(nlay) - scale factor for self-continuum, equals ! +! (w.v. density)/(atm density at 296K,1013 mb) ! +! selffrac(nlay) - factor for temp interpolation of ref ! +! self-continuum data ! +! indself(nlay) - index of the lower two appropriate ref ! +! temp for the self-continuum interpolation ! +! forfac (nlay) - scale factor for w.v. foreign-continuum ! +! forfrac(nlay) - factor for temp interpolation of ref ! +! w.v. foreign-continuum data ! +! indfor (nlay) - index of the lower two appropriate ref ! +! temp for the foreign-continuum interp ! +! laytrop - tropopause layer index at which switch is ! +! made from one conbination kew species to ! +! another. ! +! jp(nlay),jt(nlay),jt1(nlay) ! +! - lookup table indexes ! +! totuflux(0:nlay) - total-sky upward longwave flux (w/m2) ! +! totdflux(0:nlay) - total-sky downward longwave flux (w/m2) ! +! htr(nlay) - total-sky heating rate (k/day or k/sec) ! +! totuclfl(0:nlay) - clear-sky upward longwave flux (w/m2) ! +! totdclfl(0:nlay) - clear-sky downward longwave flux (w/m2) ! +! htrcl(nlay) - clear-sky heating rate (k/day or k/sec) ! +! fnet (0:nlay) - net longwave flux (w/m2) ! +! fnetc (0:nlay) - clear-sky net longwave flux (w/m2) ! +! ! +! ! +! ====================== end of definitions =================== ! + +! --- inputs: + integer, intent(in) :: npts, nlay, nlp1 + integer, intent(in) :: icseed(npts) + + logical, intent(in) :: lprnt + integer, intent(in) :: mpiroot + integer, intent(in) :: mpirank + integer, intent(in) :: iovrlw,isubclw + + real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: plvl, & + & tlvl + real (kind=kind_phys), dimension(npts,nlay), intent(in) :: plyr, & + & tlyr, qlyr, olyr, dzlyr, delpin + + real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2,& + & gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & + & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4 + + real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf + real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od + + real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & + & sfgtmp, de_lgth + + real (kind=kind_phys), dimension(npts,nlay,nbands),intent(in):: & + & aeraod, aerssa + +!mz* HWRF -- OUTPUT from mcica_subcol_lw + real(kind=kind_phys),dimension(ngptlw,npts,nlay) :: cldfmcl ! Cloud fraction + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=kind_phys),dimension(ngptlw,npts,nlay) :: ciwpmcl ! In-cloud ice water path (g/m2) + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=kind_phys),dimension(ngptlw,npts,nlay) :: clwpmcl ! In-cloud liquid water path (g/m2) + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=kind_phys),dimension(ngptlw,npts,nlay) :: cswpmcl ! In-cloud snow water path (g/m2) + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=kind_phys),dimension(npts,nlay) :: relqmcl ! Cloud water drop effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=kind_phys),dimension(npts,nlay) :: reicmcl ! Cloud ice effective size (microns) + ! Dimensions: (ncol,nlay) + real(kind=kind_phys),dimension(npts,nlay) :: resnmcl ! Snow effective size (microns) + ! Dimensions: (ncol,nlay) + real(kind=kind_phys),dimension(ngptlw,npts,nlay) :: taucmcl ! In-cloud optical depth + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=kind_phys),dimension(npts,nlay,nbands) :: tauaer ! Aerosol optical depth +! ! Dimensions: (ncol,nlay,nbndlw) +!mz* output from cldprmc + integer :: ncbands ! number of cloud spectral bands + real(kind=kind_phys),dimension(ngptlw,nlay) :: taucmc ! cloud optical depth [mcica] + ! Dimensions: (ngptlw,nlayers) +!mz + +! --- outputs: + real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hlwc + real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & + & cldtau + + type (topflw_type), dimension(npts), intent(inout) :: topflx + type (sfcflw_type), dimension(npts), intent(inout) :: sfcflx + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +!! --- optional outputs: + real (kind=kind_phys), dimension(npts,nlay,nbands),optional, & + & intent(inout) :: hlwb + real (kind=kind_phys), dimension(npts,nlay), optional, & + & intent(inout) :: hlw0 + type (proflw_type), dimension(npts,nlp1), optional, & + & intent(inout) :: flxprf + logical, intent(in) :: lslwr + +! --- locals: +! mz* - Add height of each layer for exponential-random cloud overlap +! This will be derived below from the dzlyr in each layer + real (kind=kind_phys), dimension( npts,nlay ) :: hgt + real (kind=kind_phys):: dzsum + + real (kind=kind_phys), dimension(0:nlp1) :: cldfrc + + real (kind=kind_phys), dimension(0:nlay) :: totuflux, totdflux, & + & totuclfl, totdclfl, tz + + real (kind=kind_phys), dimension(nlay) :: htr, htrcl + + real (kind=kind_phys), dimension(nlay) :: pavel, tavel, delp, & + & clwp, ciwp, relw, reiw, cda1, cda2, cda3, cda4, & + & coldry, colbrd, h2ovmr, o3vmr, fac00, fac01, fac10, fac11, & + & selffac, selffrac, forfac, forfrac, minorfrac, scaleminor, & + & scaleminorn2, temcol, dz + +!mz* + real(kind=rb),dimension(0:nlay,nbands) :: planklay,planklev + real(kind=rb),dimension(0:nlay) :: pz + +! real(kind=rb) :: plankbnd(nbndlw) + real (kind=kind_phys), dimension(nbands,0:nlay) :: pklev, pklay + + real (kind=kind_phys), dimension(nlay,nbands) :: htrb + real (kind=kind_phys), dimension(nbands,nlay) :: taucld, tauaer + real (kind=kind_phys), dimension(nbands,1,nlay) :: taucld3 + real (kind=kind_phys), dimension(ngptlw,nlay) :: fracs, tautot + real (kind=kind_phys), dimension(nlay,ngptlw) :: fracs_r +!mz rtrnmc_mcica + real (kind=kind_phys), dimension(nlay,ngptlw) :: taut +!mz* Atmosphere/clouds - cldprop + real(kind=kind_phys), dimension(ngptlw,nlay) :: cldfmc, & + & cldfmc_save ! cloud fraction [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=kind_phys), dimension(ngptlw,nlay) :: ciwpmc ! in-cloud ice water path [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=kind_phys), dimension(ngptlw,nlay) :: clwpmc ! in-cloud liquid water path [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=kind_phys), dimension(ngptlw,nlay) :: cswpmc ! in-cloud snow path [mcica] + ! Dimensions: (ngptlw,nlay) + real(kind=kind_phys), dimension(nlay) :: relqmc ! liquid particle effective radius (microns) + ! Dimensions: (nlay) + real(kind=kind_phys), dimension(nlay) :: reicmc ! ice particle effective size (microns) + ! Dimensions: (nlay) + real(kind=kind_phys), dimension(nlay) :: resnmc ! snow effective size (microns) + ! Dimensions: (nlay) + + + real (kind=kind_phys), dimension(nbands) :: semiss, secdiff + +! --- column amount of absorbing gases: +! (:,m) m = 1-h2o, 2-co2, 3-o3, 4-n2o, 5-ch4, 6-o2, 7-co + real (kind=kind_phys) :: colamt(nlay,maxgas) + +! --- column cfc cross-section amounts: +! (:,m) m = 1-ccl4, 2-cfc11, 3-cfc12, 4-cfc22 + real (kind=kind_phys) :: wx(nlay,maxxsec) + +! --- reference ratios of binary species parameter in lower atmosphere: +! (:,m,:) m = 1-h2o/co2, 2-h2o/o3, 3-h2o/n2o, 4-h2o/ch4, 5-n2o/co2, 6-o3/co2 + real (kind=kind_phys) :: rfrate(nlay,nrates,2) + + real (kind=kind_phys) :: tem0, tem1, tem2, pwvcm, summol, stemp, & + & delgth + + integer, dimension(npts) :: ipseed + integer, dimension(nlay) :: jp, jt, jt1, indself, indfor, indminor + integer :: laytrop, iplon, i, j, k, k1 + ! mz* added local arrays for RRTMG + integer :: irng, permuteseed,ig + integer :: inflglw, iceflglw, liqflglw + logical :: lcf1 + integer :: istart ! beginning band of calculation + integer :: iend ! ending band of calculation + integer :: iout ! output option flag (inactive) + + +! +!===> ... begin here +! + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +!mz* +! For passing in cloud physical properties; cloud optics parameterized +! in RRTMG: + inflglw = 2 + iceflglw = 3 + liqflglw = 1 + + istart = 1 + iend = 16 + iout = 0 + +! + if (.not. lslwr) return + +! --- ... initialization + + lhlwb = present ( hlwb ) + lhlw0 = present ( hlw0 ) + lflxprf= present ( flxprf ) + + colamt(:,:) = f_zero + cldtau(:,:) = f_zero + +!! --- check for optional input arguments, depending on cloud method + if (ilwcliq > 0) then ! use prognostic cloud method + if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & + & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & + & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & + & .not.present(cld_swp) .or. .not.present(cld_ref_snow)) then + write(errmsg,'(*(a))') & + & 'Logic error: ilwcliq>0 requires the following', & + & ' optional arguments to be present:', & + & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & + & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' + errflg = 1 + return + end if + else ! use diagnostic cloud method + if ( .not.present(cld_od) ) then + write(errmsg,'(*(a))') & + & 'Logic error: ilwcliq<=0 requires the following', & + & ' optional argument to be present: cld_od' + errflg = 1 + return + end if + endif ! end if_ilwcliq + +!> -# Change random number seed value for each radiation invocation +!! (isubclw =1 or 2). + + if ( isubclw == 1 ) then ! advance prescribed permutation seed + do i = 1, npts + ipseed(i) = ipsdlw0 + i + enddo + elseif ( isubclw == 2 ) then ! use input array of permutaion seeds + do i = 1, npts + ipseed(i) = icseed(i) + enddo + endif + +! if ( lprnt ) then +! print *,' In rrtmg_lw, isubclw, ipsdlw0,ipseed =', & +! & isubclw, ipsdlw0, ipseed +! endif + +! --- ... loop over horizontal npts profiles + + lab_do_iplon : do iplon = 1, npts + +!> -# Read surface emissivity. + if (sfemis(iplon) > eps .and. sfemis(iplon) <= 1.0) then ! input surface emissivity + do j = 1, nbands + semiss(j) = sfemis(iplon) + enddo + else ! use default values + do j = 1, nbands + semiss(j) = semiss0(j) + enddo + endif + + stemp = sfgtmp(iplon) ! surface ground temp + if (iovrlw == 3) delgth= de_lgth(iplon) ! clouds decorr-length + +! mz*: HWRF practice + if (iovrlw == 4 ) then + +!Add layer height needed for exponential (icld=4) and +! exponential-random (icld=5) overlap options + + !iplon = 1 + irng = 0 + permuteseed = 150 + +!mz* Derive height + dzsum =0.0 + do k = 1,nlay + hgt(iplon,k)= dzsum+0.5*dzlyr(iplon,k)*1000. !km->m + dzsum = dzsum+ dzlyr(iplon,k)*1000. + enddo + +! Zero out cloud optical properties here; not used when passing physical properties +! to radiation and taucld is calculated in radiation + do k = 1, nlay + do j = 1, nbands + taucld3(j,iplon,k) = 0.0 + enddo + enddo + + +! if(mpirank==mpiroot) then +! write(0,*) 'mcica_subcol_lw: max/min(cld_cf)=', & +! & maxval(cld_cf),minval(cld_cf) +! write(0,*) 'mcica_subcol_lw: max/min(cld_iwp)=', & +! & maxval(cld_iwp),minval(cld_iwp) +! write(0,*) 'mcica_subcol_lw: max/min(cld_lwp)=', & +! & maxval(cld_lwp),minval(cld_lwp) +! write(0,*) 'mcica_subcol_lw: max/min(cld_swp)=', & +! & maxval(cld_swp),minval(cld_swp) +! write(0,*) 'mcica_subcol_lw: max/min(cld_ref_ice)=', & +! & maxval(cld_ref_ice),minval(cld_ref_ice) +! write(0,*) 'mcica_subcol_lw: max/min(cld_ref_snow)=', & +! & maxval(cld_ref_snow),minval(cld_ref_snow) +! write(0,*) 'mcica_subcol_lw: max/min(cld_ref_liq)=', & +! & maxval(cld_ref_liq),minval(cld_ref_liq) + +! endif + + call mcica_subcol_lw(1, iplon, nlay, iovrlw, permuteseed, & + & irng, plyr, hgt, & + & cld_cf, cld_iwp, cld_lwp,cld_swp, & + & cld_ref_ice, cld_ref_liq, & + & cld_ref_snow, taucld3, & + & cldfmcl, & !--output + & ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, & + & resnmcl, taucmcl) + +!mz +! if(mpirank==mpiroot) then +! write(0,*) 'mcica_subcol_lw: max/min(cldfmcl)=', & +! & maxval(cldfmcl),minval(cldfmcl) +! write(0,*) 'mcica_subcol_lw: max/min(ciwpmcl)=', & +! & maxval(ciwpmcl),minval(ciwpmcl) +! write(0,*) 'mcica_subcol_lw: max/min(clwpmcl)=', & +! & maxval(clwpmcl),minval(clwpmcl) +! write(0,*) 'mcica_subcol_lw: max/min(cswpmcl)=', & +! & maxval(cswpmcl),minval(cswpmcl) +! write(0,*) 'mcica_subcol_lw: max/min(reicmcl)=', & +! & maxval(reicmcl),minval(reicmcl) +! write(0,*) 'mcica_subcol_lw: max/min(relqmcl)=', & +! & maxval(relqmcl),minval(relqmcl) +! write(0,*) 'mcica_subcol_lw: max/min(resnmcl)=', & +! & maxval(resnmcl),minval(resnmcl) +! write(0,*) 'mcica_subcol_lw: max/min(taucmcl)=', & +! & maxval(taucmcl),minval(taucmcl) + +! endif + endif +!mz* end + +!> -# Prepare atmospheric profile for use in rrtm. +! the vertical index of internal array is from surface to top + +! --- ... molecular amounts are input or converted to volume mixing ratio +! and later then converted to molecular amount (molec/cm2) by the +! dry air column coldry (in molec/cm2) which is calculated from the +! layer pressure thickness (in mb), based on the hydrostatic equation +! --- ... and includes a correction to account for h2o in the layer. + + if (ivflip == 0) then ! input from toa to sfc + + tem1 = 100.0 * con_g + tem2 = 1.0e-20 * 1.0e3 * con_avgd + tz(0) = tlvl(iplon,nlp1) + + do k = 1, nlay + k1 = nlp1 - k + pavel(k)= plyr(iplon,k1) + delp(k) = delpin(iplon,k1) + tavel(k)= tlyr(iplon,k1) + tz(k) = tlvl(iplon,k1) + dz(k) = dzlyr(iplon,k1) + +!> -# Set absorber amount for h2o, co2, and o3. + +!test use +! h2ovmr(k)= max(f_zero,qlyr(iplon,k1)*amdw) ! input mass mixing ratio +! h2ovmr(k)= max(f_zero,qlyr(iplon,k1)) ! input vol mixing ratio +! o3vmr (k)= max(f_zero,olyr(iplon,k1)) ! input vol mixing ratio +!ncep model use + h2ovmr(k)= max(f_zero,qlyr(iplon,k1) & + & *amdw/(f_one-qlyr(iplon,k1))) ! input specific humidity + o3vmr (k)= max(f_zero,olyr(iplon,k1)*amdo3) ! input mass mixing ratio + +! --- ... tem0 is the molecular weight of moist air + tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw + coldry(k) = tem2*delp(k) / (tem1*tem0*(f_one+h2ovmr(k))) + temcol(k) = 1.0e-12 * coldry(k) + + colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(iplon,k1)) ! co2 + colamt(k,3) = max(temcol(k), coldry(k)*o3vmr(k)) ! o3 + enddo + +!> -# Set up column amount for rare gases n2o,ch4,o2,co,ccl4,cf11,cf12, +!! cf22, convert from volume mixing ratio to molec/cm2 based on +!! coldry (scaled to 1.0e-20). + + if (ilwrgas > 0) then + do k = 1, nlay + k1 = nlp1 - k + colamt(k,4)=max(temcol(k), coldry(k)*gasvmr_n2o(iplon,k1)) ! n2o + colamt(k,5)=max(temcol(k), coldry(k)*gasvmr_ch4(iplon,k1)) ! ch4 + colamt(k,6)=max(f_zero, coldry(k)*gasvmr_o2(iplon,k1)) ! o2 + colamt(k,7)=max(f_zero, coldry(k)*gasvmr_co(iplon,k1)) ! co + + wx(k,1) = max( f_zero, coldry(k)*gasvmr_ccl4(iplon,k1) ) ! ccl4 + wx(k,2) = max( f_zero, coldry(k)*gasvmr_cfc11(iplon,k1) ) ! cf11 + wx(k,3) = max( f_zero, coldry(k)*gasvmr_cfc12(iplon,k1) ) ! cf12 + wx(k,4) = max( f_zero, coldry(k)*gasvmr_cfc22(iplon,k1) ) ! cf22 + enddo + else + do k = 1, nlay + colamt(k,4) = f_zero ! n2o + colamt(k,5) = f_zero ! ch4 + colamt(k,6) = f_zero ! o2 + colamt(k,7) = f_zero ! co + + wx(k,1) = f_zero + wx(k,2) = f_zero + wx(k,3) = f_zero + wx(k,4) = f_zero + enddo + endif + +!> -# Set aerosol optical properties. + + do k = 1, nlay + k1 = nlp1 - k + do j = 1, nbands + tauaer(j,k) = aeraod(iplon,k1,j) & + & * (f_one - aerssa(iplon,k1,j)) + enddo + enddo + +!> -# Read cloud optical properties. + if (ilwcliq > 0) then ! use prognostic cloud method +!mz: GFS operational + do k = 1, nlay + k1 = nlp1 - k + cldfrc(k)= cld_cf(iplon,k1) + clwp(k) = cld_lwp(iplon,k1) + relw(k) = cld_ref_liq(iplon,k1) + ciwp(k) = cld_iwp(iplon,k1) + reiw(k) = cld_ref_ice(iplon,k1) + cda1(k) = cld_rwp(iplon,k1) + cda2(k) = cld_ref_rain(iplon,k1) + cda3(k) = cld_swp(iplon,k1) + cda4(k) = cld_ref_snow(iplon,k1) + enddo + ! transfer + if (iovrlw .eq. 4) then !mz HWRF + do k = 1, nlay + k1 = nlp1 - k + do ig = 1, ngptlw + cldfmc(ig,k) = cldfmcl(ig,iplon,k1) + taucmc(ig,k) = taucmcl(ig,iplon,k1) + ciwpmc(ig,k) = ciwpmcl(ig,iplon,k1) + clwpmc(ig,k) = clwpmcl(ig,iplon,k1) + !mz cswpmc(ig,k) = cswpmcl(ig,iplon,k1) + cswpmc(ig,k) = 0.0 + enddo + reicmc(k) = reicmcl(iplon,k1) + relqmc(k) = relqmcl(iplon,k1) + resnmc(k) = resnmcl(iplon,k1) + enddo + endif + else ! use diagnostic cloud method + do k = 1, nlay + k1 = nlp1 - k + cldfrc(k)= cld_cf(iplon,k1) + cda1(k) = cld_od(iplon,k1) + enddo + endif ! end if_ilwcliq + + cldfrc(0) = f_one ! padding value only + cldfrc(nlp1) = f_zero ! padding value only + +!> -# Compute precipitable water vapor for diffusivity angle adjustments. + + tem1 = f_zero + tem2 = f_zero + do k = 1, nlay + tem1 = tem1 + coldry(k) + colamt(k,1) + tem2 = tem2 + colamt(k,1) + enddo + + tem0 = 10.0 * tem2 / (amdw * tem1 * con_g) + pwvcm = tem0 * plvl(iplon,nlp1) + + else ! input from sfc to toa + + tem1 = 100.0 * con_g + tem2 = 1.0e-20 * 1.0e3 * con_avgd + tz(0) = tlvl(iplon,1) + + do k = 1, nlay + pavel(k)= plyr(iplon,k) + delp(k) = delpin(iplon,k) + tavel(k)= tlyr(iplon,k) + tz(k) = tlvl(iplon,k+1) + dz(k) = dzlyr(iplon,k) + +! --- ... set absorber amount +!test use +! h2ovmr(k)= max(f_zero,qlyr(iplon,k)*amdw) ! input mass mixing ratio +! h2ovmr(k)= max(f_zero,qlyr(iplon,k)) ! input vol mixing ratio +! o3vmr (k)= max(f_zero,olyr(iplon,k)) ! input vol mixing ratio +!ncep model use + h2ovmr(k)= max(f_zero,qlyr(iplon,k) & + & *amdw/(f_one-qlyr(iplon,k))) ! input specific humidity + o3vmr (k)= max(f_zero,olyr(iplon,k)*amdo3) ! input mass mixing ratio + +! --- ... tem0 is the molecular weight of moist air + tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw + coldry(k) = tem2*delp(k) / (tem1*tem0*(f_one+h2ovmr(k))) + temcol(k) = 1.0e-12 * coldry(k) + + colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(iplon,k))! co2 + colamt(k,3) = max(temcol(k), coldry(k)*o3vmr(k)) ! o3 + enddo + +! --- ... set up col amount for rare gases, convert from volume mixing ratio +! to molec/cm2 based on coldry (scaled to 1.0e-20) + + if (ilwrgas > 0) then + do k = 1, nlay + colamt(k,4)=max(temcol(k), coldry(k)*gasvmr_n2o(iplon,k)) ! n2o + colamt(k,5)=max(temcol(k), coldry(k)*gasvmr_ch4(iplon,k)) ! ch4 + colamt(k,6)=max(f_zero, coldry(k)*gasvmr_o2(iplon,k)) ! o2 + colamt(k,7)=max(f_zero, coldry(k)*gasvmr_co(iplon,k)) ! co + + wx(k,1) = max( f_zero, coldry(k)*gasvmr_ccl4(iplon,k) ) ! ccl4 + wx(k,2) = max( f_zero, coldry(k)*gasvmr_cfc11(iplon,k) ) ! cf11 + wx(k,3) = max( f_zero, coldry(k)*gasvmr_cfc12(iplon,k) ) ! cf12 + wx(k,4) = max( f_zero, coldry(k)*gasvmr_cfc22(iplon,k) ) ! cf22 + enddo + else + do k = 1, nlay + colamt(k,4) = f_zero ! n2o + colamt(k,5) = f_zero ! ch4 + colamt(k,6) = f_zero ! o2 + colamt(k,7) = f_zero ! co + + wx(k,1) = f_zero + wx(k,2) = f_zero + wx(k,3) = f_zero + wx(k,4) = f_zero + enddo + endif + +! --- ... set aerosol optical properties + + do j = 1, nbands + do k = 1, nlay + tauaer(j,k) = aeraod(iplon,k,j) & + & * (f_one - aerssa(iplon,k,j)) + enddo + enddo + + if (ilwcliq > 0) then ! use prognostic cloud method +!mz* + !mz calculate input for cldprop + do k = 1, nlay + cldfrc(k)= cld_cf(iplon,k) + clwp(k) = cld_lwp(iplon,k) + relw(k) = cld_ref_liq(iplon,k) + ciwp(k) = cld_iwp(iplon,k) + reiw(k) = cld_ref_ice(iplon,k) + cda1(k) = cld_rwp(iplon,k) + cda2(k) = cld_ref_rain(iplon,k) + cda3(k) = cld_swp(iplon,k) + cda4(k) = cld_ref_snow(iplon,k) + enddo + if (iovrlw .eq. 4) then +!mz* Move incoming GCM cloud arrays to RRTMG cloud arrays. +!For GCM input, incoming reicmcl is defined based on selected +!ice parameterization (inflglw) + do k = 1, nlay + do ig = 1, ngptlw + cldfmc(ig,k) = cldfmcl(ig,iplon,k) + taucmc(ig,k) = taucmcl(ig,iplon,k) + ciwpmc(ig,k) = ciwpmcl(ig,iplon,k) + clwpmc(ig,k) = clwpmcl(ig,iplon,k) + !mz cswpmc(ig,k) = cswpmcl(ig,iplon,k) + cswpmc(ig,k) = 0.0 + enddo + reicmc(k) = reicmcl(iplon,k) + relqmc(k) = relqmcl(iplon,k) + resnmc(k) = resnmcl(iplon,k) + enddo + endif + else ! use diagnostic cloud method + do k = 1, nlay + cldfrc(k)= cld_cf(iplon,k) + cda1(k) = cld_od(iplon,k) + enddo + endif ! end if_ilwcliq + + cldfrc(0) = f_one ! padding value only + cldfrc(nlp1) = f_zero ! padding value only + +! --- ... compute precipitable water vapor for diffusivity angle adjustments + + tem1 = f_zero + tem2 = f_zero + do k = 1, nlay + tem1 = tem1 + coldry(k) + colamt(k,1) + tem2 = tem2 + colamt(k,1) + enddo + + tem0 = 10.0 * tem2 / (amdw * tem1 * con_g) + pwvcm = tem0 * plvl(iplon,1) + + endif ! if_ivflip + +!> -# Compute column amount for broadening gases. + + do k = 1, nlay + summol = f_zero + do i = 2, maxgas + summol = summol + colamt(k,i) + enddo + colbrd(k) = coldry(k) - summol + enddo + +!> -# Compute diffusivity angle adjustments. + + tem1 = 1.80 + tem2 = 1.50 + do j = 1, nbands + if (j==1 .or. j==4 .or. j==10) then + secdiff(j) = 1.66 + else + secdiff(j) = min( tem1, max( tem2, & + & a0(j)+a1(j)*exp(a2(j)*pwvcm) )) + endif + enddo + +! if (lprnt) then +! print *,' coldry',coldry +! print *,' wx(*,1) ',(wx(k,1),k=1,NLAY) +! print *,' wx(*,2) ',(wx(k,2),k=1,NLAY) +! print *,' wx(*,3) ',(wx(k,3),k=1,NLAY) +! print *,' wx(*,4) ',(wx(k,4),k=1,NLAY) +! print *,' iplon ',iplon +! print *,' pavel ',pavel +! print *,' delp ',delp +! print *,' tavel ',tavel +! print *,' tz ',tz +! print *,' h2ovmr ',h2ovmr +! print *,' o3vmr ',o3vmr +! endif + +!> -# For cloudy atmosphere, call cldprop() to set cloud optical +!! properties. + + lcf1 = .false. + lab_do_k0 : do k = 1, nlay + if ( cldfrc(k) > eps ) then + lcf1 = .true. + exit lab_do_k0 + endif + enddo lab_do_k0 + + if ( lcf1 ) then + + !mz* for HWRF, save cldfmc with mcica + if (iovrlw .eq.4) then + do k = 1, nlay + do ig = 1, ngptlw + cldfmc_save(ig,k)=cldfmc (ig,k) + enddo + enddo + endif + + call cldprop & +! --- inputs: + & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & + & nlay, nlp1, ipseed(iplon), dz, delgth,iovrlw, isubclw, & +! --- outputs: + & cldfmc, taucld & + & ) + + if (iovrlw .eq.4) then + !mz for HWRF, still using mcica cldfmc + do k = 1, nlay + do ig = 1, ngptlw + cldfmc(ig,k)=cldfmc_save(ig,k) + enddo + enddo + endif + +! --- ... save computed layer cloud optical depth for output +! rrtm band-7 is apprx 10mu channel (or use spectral mean of bands 6-8) + + if (ivflip == 0) then ! input from toa to sfc + do k = 1, nlay + k1 = nlp1 - k + cldtau(iplon,k1) = taucld( 7,k) + enddo + else ! input from sfc to toa + do k = 1, nlay + cldtau(iplon,k) = taucld( 7,k) + enddo + endif ! end if_ivflip_block + + else + cldfmc = f_zero + taucld = f_zero + endif + +!!mz* HWRF practice, calculate taucmc with mcica + if (iovrlw .eq.4) then + !mz* HWRF practice, calculate taucmc +! if(mpirank==mpiroot) then +! write(0,*) 'bfe cldprmc: nlay,inflglw,iceflglw,liqflglw',& +! & nlay,inflglw,iceflglw,liqflglw +! write(0,*) 'bfe cldprmc: max/min(taucmc)=', & +! & maxval(taucmc),minval(taucmc) +! endif + + call cldprmc(nlay, inflglw, iceflglw, liqflglw, & + & cldfmc, ciwpmc, & + & clwpmc, cswpmc, reicmc, relqmc, resnmc, & + & ncbands, taucmc) + endif +! if(mpirank==mpiroot) then +! write(0,*) 'aft cldprmc: ncbands', ncbands +! write(0,*) 'aft cldprmc: max/min(taucmc)=', & +! & maxval(taucmc),minval(taucmc) +! endif + + +!mz* end + + +! if (lprnt) then +! print *,' after cldprop' +! print *,' clwp',clwp +! print *,' ciwp',ciwp +! print *,' relw',relw +! print *,' reiw',reiw +! print *,' taucl',cda1 +! print *,' cldfrac',cldfrc +! endif + +!> -# Calling setcoef() to compute various coefficients needed in +!! radiative transfer calculations. + call setcoef & +! --- inputs: + & ( pavel,tavel,tz,stemp,h2ovmr,colamt,coldry,colbrd, & + & nlay, nlp1, & +! --- outputs: + & laytrop,pklay,pklev,jp,jt,jt1, & + & rfrate,fac00,fac01,fac10,fac11, & + & selffac,selffrac,indself,forfac,forfrac,indfor, & + & minorfrac,scaleminor,scaleminorn2,indminor & + & ) + +! if (lprnt) then +! print *,'laytrop',laytrop +! print *,'colh2o',(colamt(k,1),k=1,NLAY) +! print *,'colco2',(colamt(k,2),k=1,NLAY) +! print *,'colo3', (colamt(k,3),k=1,NLAY) +! print *,'coln2o',(colamt(k,4),k=1,NLAY) +! print *,'colch4',(colamt(k,5),k=1,NLAY) +! print *,'fac00',fac00 +! print *,'fac01',fac01 +! print *,'fac10',fac10 +! print *,'fac11',fac11 +! print *,'jp',jp +! print *,'jt',jt +! print *,'jt1',jt1 +! print *,'selffac',selffac +! print *,'selffrac',selffrac +! print *,'indself',indself +! print *,'forfac',forfac +! print *,'forfrac',forfrac +! print *,'indfor',indfor +! endif + +!> -# Call taumol() to calculte the gaseous optical depths and Plank +!! fractions for each longwave spectral band. + + call taumol & +! --- inputs: + & ( laytrop,pavel,coldry,colamt,colbrd,wx,tauaer, & + & rfrate,fac00,fac01,fac10,fac11,jp,jt,jt1, & + & selffac,selffrac,indself,forfac,forfrac,indfor, & + & minorfrac,scaleminor,scaleminorn2,indminor, & + & nlay, & +! --- outputs: + & fracs, tautot & + & ) + +! if (lprnt) then +! print *,' after taumol' +! do k = 1, nlay +! write(6,121) k +!121 format(' k =',i3,5x,'FRACS') +! write(6,122) (fracs(j,k),j=1,ngptlw) +!122 format(10e14.7) +! write(6,123) k +!123 format(' k =',i3,5x,'TAUTOT') +! write(6,122) (tautot(j,k),j=1,ngptlw) +! enddo +! endif + +!> -# Call the radiative transfer routine based on cloud scheme +!! selection. Compute the upward/downward radiative fluxes, and +!! heating rates for both clear or cloudy atmosphere. +!!\n - call rtrn(): clouds are assumed as randomly overlaping in a +!! vertical column +!!\n - call rtrnmr(): clouds are assumed as in maximum-randomly +!! overlaping in a vertical column; +!!\n - call rtrnmc(): clouds are treated with the mcica stochastic +!! approach. + + if (isubclw <= 0) then + + if (iovrlw <= 0) then + + call rtrn & +! --- inputs: + & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, & + & fracs,secdiff,nlay,nlp1, & +! --- outputs: + & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & + & ) + + else + + call rtrnmr & +! --- inputs: + & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, & + & fracs,secdiff,nlay,nlp1, & +! --- outputs: + & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & + & ) + + endif ! end if_iovrlw_block + + else + +! if(iovrlw == 4) then + +!mz*HWRF practice +! +! pz(0)=plyr(iplon,1) +! do k= 1,nlay +! pz(k)=plvl(iplon,k+1) +! enddo + +! do k = 0, nlay +! do j = 1, nbands +! ! taut (k,j) = tautot(j,k) +! planklay(k,j) = pklay(j,k) +! planklev(k,j) = pklev(j,k) +! enddo +! enddo + +! do k = 1, nlay +! do ig = 1, ngptlw +! fracs_r(k,ig) = fracs (ig,k) +! taut(k,ig)= tautot(ig,k) +! enddo +! enddo + +! call rtrnmc_mcica(nlay, istart, iend, iout, pz, & +! & semiss, ncbands, & +! & cldfmc, taucmc, planklay, planklev, & !plankbnd, & +! & pwvcm, fracs_r, taut, & +! & totuflux, totdflux, htr, & +! & totuclfl, totdclfl, htrcl ) + +! if(mpirank==mpiroot) then +! write(0,*) 'rtrnmc_mcica: max/min(htr)=', & +! & maxval(htr),minval(htr) +! endif + + +! else +!mz*end + +!mz*taucld(non-mcica) + call rtrnmc & +! --- inputs: + & ( semiss,delp,cldfmc,taucld,tautot,pklay,pklev, & + & fracs,secdiff,nlay,nlp1, & +! --- outputs: + & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & + & ) +! if(mpirank==mpiroot) then +! write(0,*) 'rtrnmc: max/min(htr)=', & +! & maxval(htr),minval(htr) +! endif + +! endif !end if_iovrlw block + + endif ! end if_isubclw_block + +!> -# Save outputs. + + topflx(iplon)%upfxc = totuflux(nlay) + topflx(iplon)%upfx0 = totuclfl(nlay) + + sfcflx(iplon)%upfxc = totuflux(0) + sfcflx(iplon)%upfx0 = totuclfl(0) + sfcflx(iplon)%dnfxc = totdflux(0) + sfcflx(iplon)%dnfx0 = totdclfl(0) + + if (ivflip == 0) then ! output from toa to sfc + +!! --- ... optional fluxes + if ( lflxprf ) then + do k = 0, nlay + k1 = nlp1 - k + flxprf(iplon,k1)%upfxc = totuflux(k) + flxprf(iplon,k1)%dnfxc = totdflux(k) + flxprf(iplon,k1)%upfx0 = totuclfl(k) + flxprf(iplon,k1)%dnfx0 = totdclfl(k) + enddo + endif + + do k = 1, nlay + k1 = nlp1 - k + hlwc(iplon,k1) = htr(k) + enddo + +!! --- ... optional clear sky heating rate + if ( lhlw0 ) then + do k = 1, nlay + k1 = nlp1 - k + hlw0(iplon,k1) = htrcl(k) + enddo + endif + +!! --- ... optional spectral band heating rate + if ( lhlwb ) then + do j = 1, nbands + do k = 1, nlay + k1 = nlp1 - k + hlwb(iplon,k1,j) = htrb(k,j) + enddo + enddo + endif + + else ! output from sfc to toa + +!! --- ... optional fluxes + if ( lflxprf ) then + do k = 0, nlay + flxprf(iplon,k+1)%upfxc = totuflux(k) + flxprf(iplon,k+1)%dnfxc = totdflux(k) + flxprf(iplon,k+1)%upfx0 = totuclfl(k) + flxprf(iplon,k+1)%dnfx0 = totdclfl(k) + enddo + endif + + do k = 1, nlay + hlwc(iplon,k) = htr(k) + enddo + +!! --- ... optional clear sky heating rate + if ( lhlw0 ) then + do k = 1, nlay + hlw0(iplon,k) = htrcl(k) + enddo + endif + +!! --- ... optional spectral band heating rate + if ( lhlwb ) then + do j = 1, nbands + do k = 1, nlay + hlwb(iplon,k,j) = htrb(k,j) + enddo + enddo + endif + + endif ! if_ivflip + + enddo lab_do_iplon + +!................................... + end subroutine rrtmg_lw_run +!----------------------------------- +!> @} + subroutine rrtmg_lw_finalize () + end subroutine rrtmg_lw_finalize + + + +!> \ingroup module_radlw_main +!> \brief This subroutine performs calculations necessary for the initialization +!! of the longwave model, which includes non-varying model variables, conversion +!! factors, and look-up tables +!! +!! Lookup tables are computed for use in the lw +!! radiative transfer, and input absorption coefficient data for each +!! spectral band are reduced from 256 g-point intervals to 140. +!!\param me print control for parallel process +!!\section rlwinit_gen rlwinit General Algorithm +!! @{ + subroutine rlwinit & + & (iovrlw,isubclw, me ) ! --- inputs +! --- outputs: (none) + +! =================== program usage description =================== ! +! ! +! purpose: initialize non-varying module variables, conversion factors,! +! and look-up tables. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: ! +! me - print control for parallel process ! +! ! +! outputs: (none) ! +! ! +! external module variables: (in physparam) ! +! ilwrate - heating rate unit selections ! +! =1: output in k/day ! +! =2: output in k/second ! +! ilwrgas - control flag for rare gases (ch4,n2o,o2,cfcs, etc.) ! +! =0: do not include rare gases ! +! >0: include all rare gases ! +! ilwcliq - liquid cloud optical properties contrl flag ! +! =0: input cloud opt depth from diagnostic scheme ! +! >0: input cwp,rew, and other cloud content parameters ! +! isubclw - sub-column cloud approximation control flag ! +! =0: no sub-col cld treatment, use grid-mean cld quantities ! +! =1: mcica sub-col, prescribed seeds to get random numbers ! +! =2: mcica sub-col, providing array icseed for random numbers! +! icldflg - cloud scheme control flag ! +! =0: diagnostic scheme gives cloud tau, omiga, and g. ! +! =1: prognostic scheme gives cloud liq/ice path, etc. ! +! iovrlw - clouds vertical overlapping control flag ! +! =0: random overlapping clouds ! +! =1: maximum/random overlapping clouds ! +! =2: maximum overlap cloud (isubcol>0 only) ! +! =3: decorrelation-length overlap (for isubclw>0 only) ! +! =4: exponential overlap cloud +! ! +! ******************************************************************* ! +! original code description ! +! ! +! original version: michael j. iacono; july, 1998 ! +! first revision for ncar ccm: september, 1998 ! +! second revision for rrtm_v3.0: september, 2002 ! +! ! +! this subroutine performs calculations necessary for the initialization +! of the longwave model. lookup tables are computed for use in the lw ! +! radiative transfer, and input absorption coefficient data for each ! +! spectral band are reduced from 256 g-point intervals to 140. ! +! ! +! ******************************************************************* ! +! ! +! definitions: ! +! arrays for 10000-point look-up tables: ! +! tau_tbl - clear-sky optical depth (used in cloudy radiative transfer! +! exp_tbl - exponential lookup table for tansmittance ! +! tfn_tbl - tau transition function; i.e. the transition of the Planck! +! function from that for the mean layer temperature to that ! +! for the layer boundary temperature as a function of optical +! depth. the "linear in tau" method is used to make the table +! ! +! ******************************************************************* ! +! ! +! ====================== end of description block ================= ! + +! --- inputs: + integer, intent(in) :: me,isubclw + integer, intent(inout) :: iovrlw + +! --- outputs: none + +! --- locals: + real (kind=kind_phys), parameter :: expeps = 1.e-20 + + real (kind=kind_phys) :: tfn, pival, explimit + + integer :: i + +! +!===> ... begin here +! + if ( iovrlw<0 .or. iovrlw>4 ) then + print *,' *** Error in specification of cloud overlap flag', & + & ' IOVRLW=',iovrlw,' in RLWINIT !!' + stop +!mz +! elseif ( iovrlw>=2 .and. isubclw==0 ) then + elseif ( (iovrlw.eq.2 .or. iovrlw.eq.3).and. isubclw==0 ) then + if (me == 0) then + print *,' *** IOVRLW=',iovrlw,' is not available for', & + & ' ISUBCLW=0 setting!!' + print *,' The program uses maximum/random overlap', & + & ' instead.' + endif + + iovrlw = 1 + endif + + if (me == 0) then + print *,' - Using AER Longwave Radiation, Version: ', VTAGLW + + if (ilwrgas > 0) then + print *,' --- Include rare gases N2O, CH4, O2, CFCs ', & + & 'absorptions in LW' + else + print *,' --- Rare gases effect is NOT included in LW' + endif + + if ( isubclw == 0 ) then + print *,' --- Using standard grid average clouds, no ', & + & 'sub-column clouds approximation applied' + elseif ( isubclw == 1 ) then + print *,' --- Using MCICA sub-colum clouds approximation ', & + & 'with a prescribed sequence of permutaion seeds' + elseif ( isubclw == 2 ) then + print *,' --- Using MCICA sub-colum clouds approximation ', & + & 'with provided input array of permutation seeds' + else + print *,' *** Error in specification of sub-column cloud ', & + & ' control flag isubclw =',isubclw,' !!' + stop + endif + endif + +!> -# Check cloud flags for consistency. + + if ((icldflg == 0 .and. ilwcliq /= 0) .or. & + & (icldflg == 1 .and. ilwcliq == 0)) then + print *,' *** Model cloud scheme inconsistent with LW', & + & ' radiation cloud radiative property setup !!' + stop + endif + +!> -# Setup default surface emissivity for each band. + + semiss0(:) = f_one + +!> -# Setup constant factors for flux and heating rate +!! the 1.0e-2 is to convert pressure from mb to \f$N/m^2\f$. + + pival = 2.0 * asin(f_one) + fluxfac = pival * 2.0d4 +! fluxfac = 62831.85307179586 ! = 2 * pi * 1.0e4 + + if (ilwrate == 1) then +! heatfac = 8.4391 +! heatfac = con_g * 86400. * 1.0e-2 / con_cp ! (in k/day) + heatfac = con_g * 864.0 / con_cp ! (in k/day) + else + heatfac = con_g * 1.0e-2 / con_cp ! (in k/second) + endif + +!> -# Compute lookup tables for transmittance, tau transition +!! function, and clear sky tau (for the cloudy sky radiative +!! transfer). tau is computed as a function of the tau +!! transition function, transmittance is calculated as a +!! function of tau, and the tau transition function is +!! calculated using the linear in tau formulation at values of +!! tau above 0.01. tf is approximated as tau/6 for tau < 0.01. +!! all tables are computed at intervals of 0.001. the inverse +!! of the constant used in the pade approximation to the tau +!! transition function is set to b. + + tau_tbl(0) = f_zero + exp_tbl(0) = f_one + tfn_tbl(0) = f_zero + + tau_tbl(ntbl) = 1.e10 + exp_tbl(ntbl) = expeps + tfn_tbl(ntbl) = f_one + + explimit = aint( -log(tiny(exp_tbl(0))) ) + + do i = 1, ntbl-1 +!org tfn = float(i) / float(ntbl) +!org tau_tbl(i) = bpade * tfn / (f_one - tfn) + tfn = real(i, kind_phys) / real(ntbl-i, kind_phys) + tau_tbl(i) = bpade * tfn + if (tau_tbl(i) >= explimit) then + exp_tbl(i) = expeps + else + exp_tbl(i) = exp( -tau_tbl(i) ) + endif + + if (tau_tbl(i) < 0.06) then + tfn_tbl(i) = tau_tbl(i) / 6.0 + else + tfn_tbl(i) = f_one - 2.0*( (f_one / tau_tbl(i)) & + & - ( exp_tbl(i) / (f_one - exp_tbl(i)) ) ) + endif + enddo + +!................................... + end subroutine rlwinit +!! @} +!----------------------------------- + + +!>\ingroup module_radlw_main +!> \brief This subroutine computes the cloud optical depth(s) for each cloudy +!! layer and g-point interval. +!!\param cfrac layer cloud fraction +!!\n --- for ilwcliq > 0 (prognostic cloud scheme) - - - +!!\param cliqp layer in-cloud liq water path (\f$g/m^2\f$) +!!\param reliq mean eff radius for liq cloud (micron) +!!\param cicep layer in-cloud ice water path (\f$g/m^2\f$) +!!\param reice mean eff radius for ice cloud (micron) +!!\param cdat1 layer rain drop water path (\f$g/m^2\f$) +!!\param cdat2 effective radius for rain drop (micron) +!!\param cdat3 layer snow flake water path(\f$g/m^2\f$) +!!\param cdat4 mean effective radius for snow flake(micron) +!!\n --- for ilwcliq = 0 (diagnostic cloud scheme) - - - +!!\param cliqp not used +!!\param cicep not used +!!\param reliq not used +!!\param reice not used +!!\param cdat1 layer cloud optical depth +!!\param cdat2 layer cloud single scattering albedo +!!\param cdat3 layer cloud asymmetry factor +!!\param cdat4 optional use +!!\param nlay number of layer number +!!\param nlp1 number of veritcal levels +!!\param ipseed permutation seed for generating random numbers (isubclw>0) +!!\param dz layer thickness (km) +!!\param de_lgth layer cloud decorrelation length (km) +!!\param cldfmc cloud fraction for each sub-column +!!\param taucld cloud optical depth for bands (non-mcica) +!!\section gen_cldprop cldprop General Algorithm +!> @{ + subroutine cldprop & + & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs + & nlay, nlp1, ipseed, dz, de_lgth,iovrlw,isubclw, & + & cldfmc, taucld & ! --- outputs + & ) + +! =================== program usage description =================== ! +! ! +! purpose: compute the cloud optical depth(s) for each cloudy layer ! +! and g-point interval. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: -size- ! +! cfrac - real, layer cloud fraction 0:nlp1 ! +! ..... for ilwcliq > 0 (prognostic cloud sckeme) - - - ! +! cliqp - real, layer in-cloud liq water path (g/m**2) nlay ! +! reliq - real, mean eff radius for liq cloud (micron) nlay ! +! cicep - real, layer in-cloud ice water path (g/m**2) nlay ! +! reice - real, mean eff radius for ice cloud (micron) nlay ! +! cdat1 - real, layer rain drop water path (g/m**2) nlay ! +! cdat2 - real, effective radius for rain drop (microm) nlay ! +! cdat3 - real, layer snow flake water path (g/m**2) nlay ! +! cdat4 - real, effective radius for snow flakes (micron) nlay ! +! ..... for ilwcliq = 0 (diagnostic cloud sckeme) - - - ! +! cdat1 - real, input cloud optical depth nlay ! +! cdat2 - real, layer cloud single scattering albedo nlay ! +! cdat3 - real, layer cloud asymmetry factor nlay ! +! cdat4 - real, optional use nlay ! +! cliqp - not used nlay ! +! reliq - not used nlay ! +! cicep - not used nlay ! +! reice - not used nlay ! +! ! +! dz - real, layer thickness (km) nlay ! +! de_lgth- real, layer cloud decorrelation length (km) 1 ! +! nlay - integer, number of vertical layers 1 ! +! nlp1 - integer, number of vertical levels 1 ! +! ipseed- permutation seed for generating random numbers (isubclw>0) ! +! ! +! outputs: ! +! cldfmc - real, cloud fraction for each sub-column ngptlw*nlay! +! taucld - real, cld opt depth for bands (non-mcica) nbands*nlay! +! ! +! explanation of the method for each value of ilwcliq, and ilwcice. ! +! set up in module "module_radlw_cntr_para" ! +! ! +! ilwcliq=0 : input cloud optical property (tau, ssa, asy). ! +! (used for diagnostic cloud method) ! +! ilwcliq>0 : input cloud liq/ice path and effective radius, also ! +! require the user of 'ilwcice' to specify the method ! +! used to compute aborption due to water/ice parts. ! +! ................................................................... ! +! ! +! ilwcliq=1: the water droplet effective radius (microns) is input! +! and the opt depths due to water clouds are computed ! +! as in hu and stamnes, j., clim., 6, 728-742, (1993). ! +! the values for absorption coefficients appropriate for +! the spectral bands in rrtm have been obtained for a ! +! range of effective radii by an averaging procedure ! +! based on the work of j. pinto (private communication). +! linear interpolation is used to get the absorption ! +! coefficients for the input effective radius. ! +! ! +! ilwcice=1: the cloud ice path (g/m2) and ice effective radius ! +! (microns) are input and the optical depths due to ice! +! clouds are computed as in ebert and curry, jgr, 97, ! +! 3831-3836 (1992). the spectral regions in this work ! +! have been matched with the spectral bands in rrtm to ! +! as great an extent as possible: ! +! e&c 1 ib = 5 rrtm bands 9-16 ! +! e&c 2 ib = 4 rrtm bands 6-8 ! +! e&c 3 ib = 3 rrtm bands 3-5 ! +! e&c 4 ib = 2 rrtm band 2 ! +! e&c 5 ib = 1 rrtm band 1 ! +! ilwcice=2: the cloud ice path (g/m2) and ice effective radius ! +! (microns) are input and the optical depths due to ice! +! clouds are computed as in rt code, streamer v3.0 ! +! (ref: key j., streamer user's guide, cooperative ! +! institute for meteorological satellite studies, 2001,! +! 96 pp.) valid range of values for re are between 5.0 ! +! and 131.0 micron. ! +! ilwcice=3: the ice generalized effective size (dge) is input and! +! the optical properties, are calculated as in q. fu, ! +! j. climate, (1998). q. fu provided high resolution ! +! tales which were appropriately averaged for the bands! +! in rrtm_lw. linear interpolation is used to get the ! +! coeff from the stored tables. valid range of values ! +! for deg are between 5.0 and 140.0 micron. ! +! ! +! other cloud control module variables: ! +! isubclw =0: standard cloud scheme, no sub-col cloud approximation ! +! >0: mcica sub-col cloud scheme using ipseed as permutation! +! seed for generating rundom numbers ! +! ! +! ====================== end of description block ================= ! +! + use module_radlw_cldprlw + +! --- inputs: + integer, intent(in) :: nlay, nlp1, ipseed,iovrlw,isubclw + + real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac + real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & + & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, dz + real (kind=kind_phys), intent(in) :: de_lgth + +! --- outputs: + real (kind=kind_phys), dimension(ngptlw,nlay),intent(out):: cldfmc + real (kind=kind_phys), dimension(nbands,nlay),intent(out):: taucld + +! --- locals: + real (kind=kind_phys), dimension(nbands) :: tauliq, tauice + real (kind=kind_phys), dimension(nlay) :: cldf + + real (kind=kind_phys) :: dgeice, factor, fint, tauran, tausnw, & + & cldliq, refliq, cldice, refice + + logical :: lcloudy(ngptlw,nlay) + integer :: ia, ib, ig, k, index + +! +!===> ... begin here +! + do k = 1, nlay + do ib = 1, nbands + taucld(ib,k) = f_zero + enddo + enddo + + do k = 1, nlay + do ig = 1, ngptlw + cldfmc(ig,k) = f_zero + enddo + enddo + +!> -# Compute cloud radiative properties for a cloudy column: +!!\n - Compute cloud radiative properties for rain and snow (tauran,tausnw) +!!\n - Calculation of absorption coefficients due to water clouds(tauliq) +!!\n - Calculation of absorption coefficients due to ice clouds (tauice). +!!\n - For prognostic cloud scheme: sum up the cloud optical property: +!!\n \f$ taucld=tauice+tauliq+tauran+tausnw \f$ + +! --- ... compute cloud radiative properties for a cloudy column + + lab_if_ilwcliq : if (ilwcliq > 0) then + + lab_do_k : do k = 1, nlay + lab_if_cld : if (cfrac(k) > cldmin) then + + tauran = absrain * cdat1(k) ! ncar formula +!! tausnw = abssnow1 * cdat3(k) ! ncar formula +! --- if use fu's formula it needs to be normalized by snow density +! !not use snow density = 0.1 g/cm**3 = 0.1 g/(mu * m**2) +! use ice density = 0.9167 g/cm**3 = 0.9167 g/(mu * m**2) +! factor 1.5396=8/(3*sqrt(3)) converts reff to generalized ice particle size +! use newer factor value 1.0315 +! 1/(0.9167*1.0315) = 1.05756 + if (cdat3(k)>f_zero .and. cdat4(k)>10.0_kind_phys) then + tausnw = abssnow0*1.05756*cdat3(k)/cdat4(k) ! fu's formula + else + tausnw = f_zero + endif + + cldliq = cliqp(k) + cldice = cicep(k) +! refliq = max(2.5e0, min(60.0e0, reliq(k) )) +! refice = max(5.0e0, reice(k) ) + refliq = reliq(k) + refice = reice(k) + +! --- ... calculation of absorption coefficients due to water clouds. + + if ( cldliq <= f_zero ) then + do ib = 1, nbands + tauliq(ib) = f_zero + enddo + else + if ( ilwcliq == 1 ) then + + factor = refliq - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + + do ib = 1, nbands + tauliq(ib) = max(f_zero, cldliq*(absliq1(index,ib) & + & + fint*(absliq1(index+1,ib)-absliq1(index,ib)) )) + enddo + endif ! end if_ilwcliq_block + endif ! end if_cldliq_block + +! --- ... calculation of absorption coefficients due to ice clouds. + + if ( cldice <= f_zero ) then + do ib = 1, nbands + tauice(ib) = f_zero + enddo + else + +! --- ... ebert and curry approach for all particle sizes though somewhat +! unjustified for large ice particles + + if ( ilwcice == 1 ) then + refice = min(130.0, max(13.0, real(refice) )) + + do ib = 1, nbands + ia = ipat(ib) ! eb_&_c band index for ice cloud coeff + tauice(ib) = max(f_zero, cldice*(absice1(1,ia) & + & + absice1(2,ia)/refice) ) + enddo + +! --- ... streamer approach for ice effective radius between 5.0 and 131.0 microns +! and ebert and curry approach for ice eff radius greater than 131.0 microns. +! no smoothing between the transition of the two methods. + + elseif ( ilwcice == 2 ) then + + factor = (refice - 2.0) / 3.0 + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + + do ib = 1, nbands + tauice(ib) = max(f_zero, cldice*(absice2(index,ib) & + & + fint*(absice2(index+1,ib) - absice2(index,ib)) )) + enddo + +! --- ... fu's approach for ice effective radius between 4.8 and 135 microns +! (generalized effective size from 5 to 140 microns) + + elseif ( ilwcice == 3 ) then + +! dgeice = max(5.0, 1.5396*refice) ! v4.4 value + dgeice = max(5.0, 1.0315*refice) ! v4.71 value + factor = (dgeice - 2.0) / 3.0 + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + + do ib = 1, nbands + tauice(ib) = max(f_zero, cldice*(absice3(index,ib) & + & + fint*(absice3(index+1,ib) - absice3(index,ib)) )) + enddo + + endif ! end if_ilwcice_block + endif ! end if_cldice_block + + do ib = 1, nbands + taucld(ib,k) = tauice(ib) + tauliq(ib) + tauran + tausnw + enddo + + endif lab_if_cld + enddo lab_do_k + + else lab_if_ilwcliq + + do k = 1, nlay + if (cfrac(k) > cldmin) then + do ib = 1, nbands + taucld(ib,k) = cdat1(k) + enddo + endif + enddo + + endif lab_if_ilwcliq + +!> -# if isubclw > 0, call mcica_subcol() to distribute +!! cloud properties to each g-point. + + if ( isubclw > 0 ) then ! mcica sub-col clouds approx + do k = 1, nlay + if ( cfrac(k) < cldmin ) then + cldf(k) = f_zero + else + cldf(k) = cfrac(k) + endif + enddo + +! --- ... call sub-column cloud generator + + call mcica_subcol & +! --- inputs: + & ( cldf, nlay, ipseed, dz, de_lgth, iovrlw, & +! --- output: + & lcloudy & + & ) + + do k = 1, nlay + do ig = 1, ngptlw + if ( lcloudy(ig,k) ) then + cldfmc(ig,k) = f_one + else + cldfmc(ig,k) = f_zero + endif + enddo + enddo + + endif ! end if_isubclw_block + + return +! .................................. + end subroutine cldprop +! ---------------------------------- +!> @} + +!>\ingroup module_radlw_main +!>\brief This suroutine computes sub-colum cloud profile flag array. +!!\param cldf layer cloud fraction +!!\param nlay number of model vertical layers +!!\param ipseed permute seed for random num generator +!!\param dz layer thickness +!!\param de_lgth layer cloud decorrelation length (km) +!!\param lcloudy sub-colum cloud profile flag array +!!\section mcica_subcol_gen mcica_subcol General Algorithm +!! @{ + subroutine mcica_subcol & + & ( cldf, nlay, ipseed, dz, de_lgth, iovrlw, & ! --- inputs + & lcloudy & ! --- outputs + & ) + +! ==================== defination of variables ==================== ! +! ! +! input variables: size ! +! cldf - real, layer cloud fraction nlay ! +! nlay - integer, number of model vertical layers 1 ! +! ipseed - integer, permute seed for random num generator 1 ! +! ** note : if the cloud generator is called multiple times, need ! +! to permute the seed between each call; if between calls ! +! for lw and sw, use values differ by the number of g-pts. ! +! dz - real, layer thickness (km) nlay ! +! de_lgth - real, layer cloud decorrelation length (km) 1 ! +! ! +! output variables: ! +! lcloudy - logical, sub-colum cloud profile flag array ngptlw*nlay! +! ! +! other control flags from module variables: ! +! iovrlw : control flag for cloud overlapping method ! +! =0:random; =1:maximum/random: =2:maximum; =3:decorr ! +! ! +! ===================== end of definitions ==================== ! + + implicit none + +! --- inputs: + integer, intent(in) :: nlay, ipseed, iovrlw + + real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz + real (kind=kind_phys), intent(in) :: de_lgth + +! --- outputs: + logical, dimension(ngptlw,nlay), intent(out) :: lcloudy + +! --- locals: + real (kind=kind_phys) :: cdfunc(ngptlw,nlay), rand1d(ngptlw), & + & rand2d(nlay*ngptlw), tem1, fac_lcf(nlay), & + & cdfun2(ngptlw,nlay) + + type (random_stat) :: stat ! for thread safe random generator + + integer :: k, n, k1 +! +!===> ... begin here +! +!> -# Call random_setseed() to advance randum number generator by ipseed values. + + call random_setseed & +! --- inputs: + & ( ipseed, & +! --- outputs: + & stat & + & ) + +!> -# Sub-column set up according to overlapping assumption: +!! - For random overlap, pick a random value at every level +!! - For max-random overlap, pick a random value at every level +!! - For maximum overlap, pick same random numebr at every level + + select case ( iovrlw ) + + case( 0 ) ! random overlap, pick a random value at every level + + call random_number & +! --- inputs: ( none ) +! --- outputs: + & ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptlw + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + case( 1 ) ! max-ran overlap + + call random_number & +! --- inputs: ( none ) +! --- outputs: + & ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptlw + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + +! --- first pick a random number for bottom (or top) layer. +! then walk up the column: (aer's code) +! if layer below is cloudy, use the same rand num in the layer below +! if layer below is clear, use a new random number + +! --- from bottom up + do k = 2, nlay + k1 = k - 1 + tem1 = f_one - cldf(k1) + + do n = 1, ngptlw + if ( cdfunc(n,k1) > tem1 ) then + cdfunc(n,k) = cdfunc(n,k1) + else + cdfunc(n,k) = cdfunc(n,k) * tem1 + endif + enddo + enddo + +! --- or walk down the column: (if use original author's method) +! if layer above is cloudy, use the same rand num in the layer above +! if layer above is clear, use a new random number + +! --- from top down +! do k = nlay-1, 1, -1 +! k1 = k + 1 +! tem1 = f_one - cldf(k1) + +! do n = 1, ngptlw +! if ( cdfunc(n,k1) > tem1 ) then +! cdfunc(n,k) = cdfunc(n,k1) +! else +! cdfunc(n,k) = cdfunc(n,k) * tem1 +! endif +! enddo +! enddo + + case( 2 ) !< - For maximum overlap, pick same random numebr at every level + + call random_number & +! --- inputs: ( none ) +! --- outputs: + & ( rand1d, stat ) + + do n = 1, ngptlw + tem1 = rand1d(n) + + do k = 1, nlay + cdfunc(n,k) = tem1 + enddo + enddo + + case( 3 ) ! decorrelation length overlap + +! --- compute overlapping factors based on layer midpoint distances +! and decorrelation depths + + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dz(k)+dz(k-1)) / de_lgth ) + enddo + +! --- setup 2 sets of random numbers + + call random_number ( rand2d, stat ) + + k1 = 0 + do k = 1, nlay + do n = 1, ngptlw + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + call random_number ( rand2d, stat ) + + k1 = 0 + do k = 1, nlay + do n = 1, ngptlw + k1 = k1 + 1 + cdfun2(n,k) = rand2d(k1) + enddo + enddo + +! --- then working from the top down: +! if a random number (from an independent set -cdfun2) is smaller then the +! scale factor: use the upper layer's number, otherwise use a new random +! number (keep the original assigned one). + + do k = nlay-1, 1, -1 + k1 = k + 1 + + do n = 1, ngptlw + if ( cdfun2(n,k) <= fac_lcf(k1) ) then + cdfunc(n,k) = cdfunc(n,k1) + endif + enddo + enddo + + end select + +!> -# Generate subcolumns for homogeneous clouds. + + do k = 1, nlay + tem1 = f_one - cldf(k) + + do n = 1, ngptlw + lcloudy(n,k) = cdfunc(n,k) >= tem1 + enddo + enddo + + return +! .................................. + end subroutine mcica_subcol +!! @} +! ---------------------------------- + +!>\ingroup module_radlw_main +!> This subroutine computes various coefficients needed in radiative +!! transfer calculations. +!!\param pavel layer pressure (mb) +!!\param tavel layer temperature (K) +!!\param tz level(interface) temperatures (K) +!!\param stemp surface ground temperature (K) +!!\param h2ovmr layer w.v. volumn mixing ratio (kg/kg) +!!\param colamt column amounts of absorbing gases. +!! 2nd indices range: 1-maxgas, for watervapor,carbon dioxide, ozone, +!! nitrous oxide, methane,oxigen, carbon monoxide,etc. \f$(mol/cm^2)\f$ +!!\param coldry dry air column amount +!!\param colbrd column amount of broadening gases +!!\param nlay total number of vertical layers +!!\param nlp1 total number of vertical levels +!!\param laytrop tropopause layer index (unitless) +!!\param pklay integrated planck func at lay temp +!!\param pklev integrated planck func at lev temp +!!\param jp indices of lower reference pressure +!!\param jt, jt1 indices of lower reference temperatures +!!\param rfrate ref ratios of binary species param +!!\n (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o, +!! 4-h2o/ch4,5-n2o/co2,6-o3/co2 +!!\n (:,:,n)n=1,2: the rates of ref press at +!! the 2 sides of the layer +!!\param fac00,fac01,fac10,fac11 factors multiply the reference ks, i,j=0/1 for +!! lower/higher of the 2 appropriate temperatures +!! and altitudes. +!!\param selffac scale factor for w. v. self-continuum equals +!! (w. v. density)/(atmospheric density at 296k and 1013 mb) +!!\param selffrac factor for temperature interpolation of +!! reference w. v. self-continuum data +!!\param indself index of lower ref temp for selffac +!!\param forfac scale factor for w. v. foreign-continuum +!!\param forfrac factor for temperature interpolation of +!! reference w.v. foreign-continuum data +!!\param indfor index of lower ref temp for forfac +!!\param minorfrac factor for minor gases +!!\param scaleminor,scaleminorn2 scale factors for minor gases +!!\param indminor index of lower ref temp for minor gases +!>\section setcoef_gen setcoef General Algorithm +!> @{ + subroutine setcoef & + & ( pavel,tavel,tz,stemp,h2ovmr,colamt,coldry,colbrd, & ! --- inputs: + & nlay, nlp1, & + & laytrop,pklay,pklev,jp,jt,jt1, & ! --- outputs: + & rfrate,fac00,fac01,fac10,fac11, & + & selffac,selffrac,indself,forfac,forfrac,indfor, & + & minorfrac,scaleminor,scaleminorn2,indminor & + & ) + +! =================== program usage description =================== ! +! ! +! purpose: compute various coefficients needed in radiative transfer ! +! calculations. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: -size- ! +! pavel - real, layer pressures (mb) nlay ! +! tavel - real, layer temperatures (k) nlay ! +! tz - real, level (interface) temperatures (k) 0:nlay ! +! stemp - real, surface ground temperature (k) 1 ! +! h2ovmr - real, layer w.v. volum mixing ratio (kg/kg) nlay ! +! colamt - real, column amounts of absorbing gases nlay*maxgas! +! 2nd indices range: 1-maxgas, for watervapor, ! +! carbon dioxide, ozone, nitrous oxide, methane, ! +! oxigen, carbon monoxide,etc. (molecules/cm**2) ! +! coldry - real, dry air column amount nlay ! +! colbrd - real, column amount of broadening gases nlay ! +! nlay/nlp1 - integer, total number of vertical layers, levels 1 ! +! ! +! outputs: ! +! laytrop - integer, tropopause layer index (unitless) 1 ! +! pklay - real, integrated planck func at lay temp nbands*0:nlay! +! pklev - real, integrated planck func at lev temp nbands*0:nlay! +! jp - real, indices of lower reference pressure nlay ! +! jt, jt1 - real, indices of lower reference temperatures nlay ! +! rfrate - real, ref ratios of binary species param nlay*nrates*2! +! (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o,4-h2o/ch4,5-n2o/co2,6-o3/co2! +! (:,:,n)n=1,2: the rates of ref press at the 2 sides of the layer ! +! facij - real, factors multiply the reference ks, nlay ! +! i,j=0/1 for lower/higher of the 2 appropriate ! +! temperatures and altitudes. ! +! selffac - real, scale factor for w. v. self-continuum nlay ! +! equals (w. v. density)/(atmospheric density ! +! at 296k and 1013 mb) ! +! selffrac - real, factor for temperature interpolation of nlay ! +! reference w. v. self-continuum data ! +! indself - integer, index of lower ref temp for selffac nlay ! +! forfac - real, scale factor for w. v. foreign-continuum nlay ! +! forfrac - real, factor for temperature interpolation of nlay ! +! reference w.v. foreign-continuum data ! +! indfor - integer, index of lower ref temp for forfac nlay ! +! minorfrac - real, factor for minor gases nlay ! +! scaleminor,scaleminorn2 ! +! - real, scale factors for minor gases nlay ! +! indminor - integer, index of lower ref temp for minor gases nlay ! +! ! +! ====================== end of definitions =================== ! + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(nlay,maxgas),intent(in):: colamt + real (kind=kind_phys), dimension(0:nlay), intent(in):: tz + + real (kind=kind_phys), dimension(nlay), intent(in) :: pavel, & + & tavel, h2ovmr, coldry, colbrd + + real (kind=kind_phys), intent(in) :: stemp + +! --- outputs: + integer, dimension(nlay), intent(out) :: jp, jt, jt1, indself, & + & indfor, indminor + + integer, intent(out) :: laytrop + + real (kind=kind_phys), dimension(nlay,nrates,2), intent(out) :: & + & rfrate + real (kind=kind_phys), dimension(nbands,0:nlay), intent(out) :: & + & pklev, pklay + + real (kind=kind_phys), dimension(nlay), intent(out) :: & + & fac00, fac01, fac10, fac11, selffac, selffrac, forfac, & + & forfrac, minorfrac, scaleminor, scaleminorn2 + +! --- locals: + real (kind=kind_phys) :: tlvlfr, tlyrfr, plog, fp, ft, ft1, & + & tem1, tem2 + + integer :: i, k, jp1, indlev, indlay +! +!===> ... begin here +! +!> -# Calculate information needed by the radiative transfer routine +!! that is specific to this atmosphere, especially some of the +!! coefficients and indices needed to compute the optical depths +!! by interpolating data from stored reference atmospheres. + + indlay = min(180, max(1, int(stemp-159.0) )) + indlev = min(180, max(1, int(tz(0)-159.0) )) + tlyrfr = stemp - int(stemp) + tlvlfr = tz(0) - int(tz(0)) + do i = 1, nbands + tem1 = totplnk(indlay+1,i) - totplnk(indlay,i) + tem2 = totplnk(indlev+1,i) - totplnk(indlev,i) + pklay(i,0) = delwave(i) * (totplnk(indlay,i) + tlyrfr*tem1) + pklev(i,0) = delwave(i) * (totplnk(indlev,i) + tlvlfr*tem2) + enddo + +! --- ... begin layer loop +!> -# Calculate the integrated Planck functions for each band at the +!! surface, level, and layer temperatures. + + laytrop = 0 + + do k = 1, nlay + + indlay = min(180, max(1, int(tavel(k)-159.0) )) + tlyrfr = tavel(k) - int(tavel(k)) + + indlev = min(180, max(1, int(tz(k)-159.0) )) + tlvlfr = tz(k) - int(tz(k)) + +! --- ... begin spectral band loop + + do i = 1, nbands +!mz* +! plankbnd(iband) = semiss(iband) * & +! (totplnk(indbound,iband) + tbndfrac * dbdtlev) +!mz + + pklay(i,k) = delwave(i) * (totplnk(indlay,i) + tlyrfr & + & * (totplnk(indlay+1,i) - totplnk(indlay,i)) ) + pklev(i,k) = delwave(i) * (totplnk(indlev,i) + tlvlfr & + & * (totplnk(indlev+1,i) - totplnk(indlev,i)) ) + enddo + +!> -# Find the two reference pressures on either side of the +!! layer pressure. store them in jp and jp1. store in fp the +!! fraction of the difference (in ln(pressure)) between these +!! two values that the layer pressure lies. + + plog = log(pavel(k)) + jp(k)= max(1, min(58, int(36.0 - 5.0*(plog+0.04)) )) + jp1 = jp(k) + 1 +! --- ... limit pressure extrapolation at the top + fp = max(f_zero, min(f_one, 5.0*(preflog(jp(k))-plog) )) +!org fp = 5.0 * (preflog(jp(k)) - plog) + +!> -# Determine, for each reference pressure (jp and jp1), which +!! reference temperature (these are different for each +!! reference pressure) is nearest the layer temperature but does +!! not exceed it. store these indices in jt and jt1, resp. +!! store in ft (resp. ft1) the fraction of the way between jt +!! (jt1) and the next highest reference temperature that the +!! layer temperature falls. + + tem1 = (tavel(k)-tref(jp(k))) / 15.0 + tem2 = (tavel(k)-tref(jp1 )) / 15.0 + jt (k) = max(1, min(4, int(3.0 + tem1) )) + jt1(k) = max(1, min(4, int(3.0 + tem2) )) +! --- ... restrict extrapolation ranges by limiting abs(det t) < 37.5 deg + ft = max(-0.5, min(1.5, tem1 - float(jt (k) - 3) )) + ft1 = max(-0.5, min(1.5, tem2 - float(jt1(k) - 3) )) +!org ft = tem1 - float(jt (k) - 3) +!org ft1 = tem2 - float(jt1(k) - 3) + +!> -# We have now isolated the layer ln pressure and temperature, +!! between two reference pressures and two reference temperatures +!!(for each reference pressure). we multiply the pressure +!! fraction fp with the appropriate temperature fractions to get +!! the factors that will be needed for the interpolation that yields +!! the optical depths (performed in routines taugbn for band n). + + tem1 = f_one - fp + fac10(k) = tem1 * ft + fac00(k) = tem1 * (f_one - ft) + fac11(k) = fp * ft1 + fac01(k) = fp * (f_one - ft1) + + forfac(k) = pavel(k)*stpfac / (tavel(k)*(1.0 + h2ovmr(k))) + selffac(k) = h2ovmr(k) * forfac(k) + +!> -# Set up factors needed to separately include the minor gases +!! in the calculation of absorption coefficient. + + scaleminor(k) = pavel(k) / tavel(k) + scaleminorn2(k) = (pavel(k) / tavel(k)) & + & * (colbrd(k)/(coldry(k) + colamt(k,1))) + tem1 = (tavel(k) - 180.8) / 7.2 + indminor(k) = min(18, max(1, int(tem1))) + minorfrac(k) = tem1 - float(indminor(k)) + +!> -# If the pressure is less than ~100mb, perform a different +!! set of species interpolations. + + if (plog > 4.56) then + + laytrop = laytrop + 1 + + tem1 = (332.0 - tavel(k)) / 36.0 + indfor(k) = min(2, max(1, int(tem1))) + forfrac(k) = tem1 - float(indfor(k)) + +!> -# Set up factors needed to separately include the water vapor +!! self-continuum in the calculation of absorption coefficient. + + tem1 = (tavel(k) - 188.0) / 7.2 + indself(k) = min(9, max(1, int(tem1)-7)) + selffrac(k) = tem1 - float(indself(k) + 7) + +!> -# Setup reference ratio to be used in calculation of binary +!! species parameter in lower atmosphere. + + rfrate(k,1,1) = chi_mls(1,jp(k)) / chi_mls(2,jp(k)) + rfrate(k,1,2) = chi_mls(1,jp(k)+1) / chi_mls(2,jp(k)+1) + + rfrate(k,2,1) = chi_mls(1,jp(k)) / chi_mls(3,jp(k)) + rfrate(k,2,2) = chi_mls(1,jp(k)+1) / chi_mls(3,jp(k)+1) + + rfrate(k,3,1) = chi_mls(1,jp(k)) / chi_mls(4,jp(k)) + rfrate(k,3,2) = chi_mls(1,jp(k)+1) / chi_mls(4,jp(k)+1) + + rfrate(k,4,1) = chi_mls(1,jp(k)) / chi_mls(6,jp(k)) + rfrate(k,4,2) = chi_mls(1,jp(k)+1) / chi_mls(6,jp(k)+1) + + rfrate(k,5,1) = chi_mls(4,jp(k)) / chi_mls(2,jp(k)) + rfrate(k,5,2) = chi_mls(4,jp(k)+1) / chi_mls(2,jp(k)+1) + + else + + tem1 = (tavel(k) - 188.0) / 36.0 + indfor(k) = 3 + forfrac(k) = tem1 - f_one + + indself(k) = 0 + selffrac(k) = f_zero + +!> -# Setup reference ratio to be used in calculation of binary +!! species parameter in upper atmosphere. + + rfrate(k,1,1) = chi_mls(1,jp(k)) / chi_mls(2,jp(k)) + rfrate(k,1,2) = chi_mls(1,jp(k)+1) / chi_mls(2,jp(k)+1) + + rfrate(k,6,1) = chi_mls(3,jp(k)) / chi_mls(2,jp(k)) + rfrate(k,6,2) = chi_mls(3,jp(k)+1) / chi_mls(2,jp(k)+1) + + endif + +!> -# Rescale \a selffac and \a forfac for use in taumol. + + selffac(k) = colamt(k,1) * selffac(k) + forfac(k) = colamt(k,1) * forfac(k) + + enddo ! end do_k layer loop + + return +! .................................. + end subroutine setcoef +!> @} +! ---------------------------------- + +!>\ingroup module_radlw_main +!> This subroutine computes the upward/downward radiative fluxes, and +!! heating rates for both clear or cloudy atmosphere. Clouds assumed as +!! randomly overlaping in a vertical column. +!!\brief Original Code Description: this program calculates the upward +!! fluxes, downward fluxes, and heating rates for an arbitrary clear or +!! cloudy atmosphere. The input to this program is the atmospheric +!! profile, all Planck function information, and the cloud fraction by +!! layer. A variable diffusivity angle (secdif) is used for the angle +!! integration. Bands 2-3 and 5-9 use a value for secdif that varies +!! from 1.50 to 1.80 as a function of the column water vapor, and other +!! bands use a value of 1.66. The gaussian weight appropriate to this +!! angle (wtdiff =0.5) is applied here. Note that use of the emissivity +!! angle for the flux integration can cause errors of 1 to 4 \f$W/m^2\f$ +!! within cloudy layers. Clouds are treated with a random cloud overlap +!! method. +!!\param semiss lw surface emissivity +!!\param delp layer pressure thickness (mb) +!!\param cldfrc layer cloud fraction +!!\param taucld layer cloud opt depth +!!\param tautot total optical depth (gas+aerosols) +!!\param pklay integrated planck function at lay temp +!!\param pklev integrated planck func at lev temp +!!\param fracs planck fractions +!!\param secdif secant of diffusivity angle +!!\param nlay number of vertical layers +!!\param nlp1 number of vertical levels (interfaces) +!!\param totuflux total sky upward flux \f$(w/m^2)\f$ +!!\param totdflux total sky downward flux \f$(w/m^2)\f$ +!!\param htr total sky heating rate (k/sec or k/day) +!!\param totuclfl clear sky upward flux \f$(w/m^2)\f$ +!!\param totdclfl clear sky downward flux \f$(w/m^2)\f$ +!!\param htrcl clear sky heating rate (k/sec or k/day) +!!\param htrb spectral band lw heating rate (k/day) +!>\section gen_rtrn rtrn General Algorithm +!! @{ +! ---------------------------------- + subroutine rtrn & + & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, & ! --- inputs + & fracs,secdif, nlay,nlp1, & + & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & ! --- outputs + & ) + +! =================== program usage description =================== ! +! ! +! purpose: compute the upward/downward radiative fluxes, and heating ! +! rates for both clear or cloudy atmosphere. clouds are assumed as ! +! randomly overlaping in a vertical colum. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: -size- ! +! semiss - real, lw surface emissivity nbands! +! delp - real, layer pressure thickness (mb) nlay ! +! cldfrc - real, layer cloud fraction 0:nlp1 ! +! taucld - real, layer cloud opt depth nbands,nlay! +! tautot - real, total optical depth (gas+aerosols) ngptlw,nlay! +! pklay - real, integrated planck func at lay temp nbands*0:nlay! +! pklev - real, integrated planck func at lev temp nbands*0:nlay! +! fracs - real, planck fractions ngptlw,nlay! +! secdif - real, secant of diffusivity angle nbands! +! nlay - integer, number of vertical layers 1 ! +! nlp1 - integer, number of vertical levels (interfaces) 1 ! +! ! +! outputs: ! +! totuflux- real, total sky upward flux (w/m2) 0:nlay ! +! totdflux- real, total sky downward flux (w/m2) 0:nlay ! +! htr - real, total sky heating rate (k/sec or k/day) nlay ! +! totuclfl- real, clear sky upward flux (w/m2) 0:nlay ! +! totdclfl- real, clear sky downward flux (w/m2) 0:nlay ! +! htrcl - real, clear sky heating rate (k/sec or k/day) nlay ! +! htrb - real, spectral band lw heating rate (k/day) nlay*nbands! +! ! +! module veriables: ! +! ngb - integer, band index for each g-value ngptlw! +! fluxfac - real, conversion factor for fluxes (pi*2.e4) 1 ! +! heatfac - real, conversion factor for heating rates (g/cp*1e-2) 1 ! +! tblint - real, conversion factor for look-up tbl (float(ntbl) 1 ! +! bpade - real, pade approx constant (1/0.278) 1 ! +! wtdiff - real, weight for radiance to flux conversion 1 ! +! ntbl - integer, dimension of look-up tables 1 ! +! tau_tbl - real, clr-sky opt dep lookup table 0:ntbl ! +! exp_tbl - real, transmittance lookup table 0:ntbl ! +! tfn_tbl - real, tau transition function 0:ntbl ! +! ! +! local variables: ! +! itgas - integer, index for gases contribution look-up table 1 ! +! ittot - integer, index for gases plus clouds look-up table 1 ! +! reflct - real, surface reflectance 1 ! +! atrgas - real, gaseous absorptivity 1 ! +! atrtot - real, gaseous and cloud absorptivity 1 ! +! odcld - real, cloud optical depth 1 ! +! efclrfr- real, effective clear sky fraction (1-efcldfr) nlay ! +! odepth - real, optical depth of gaseous only 1 ! +! odtot - real, optical depth of gas and cloud 1 ! +! gasfac - real, gas-only pade factor, used for planck fn 1 ! +! totfac - real, gas+cld pade factor, used for planck fn 1 ! +! bbdgas - real, gas-only planck function for downward rt 1 ! +! bbugas - real, gas-only planck function for upward rt 1 ! +! bbdtot - real, gas and cloud planck function for downward rt 1 ! +! bbutot - real, gas and cloud planck function for upward rt 1 ! +! gassrcu- real, upwd source radiance due to gas only nlay! +! totsrcu- real, upwd source radiance due to gas+cld nlay! +! gassrcd- real, dnwd source radiance due to gas only 1 ! +! totsrcd- real, dnwd source radiance due to gas+cld 1 ! +! radtotu- real, spectrally summed total sky upwd radiance 1 ! +! radclru- real, spectrally summed clear sky upwd radiance 1 ! +! radtotd- real, spectrally summed total sky dnwd radiance 1 ! +! radclrd- real, spectrally summed clear sky dnwd radiance 1 ! +! toturad- real, total sky upward radiance by layer 0:nlay*nbands! +! clrurad- real, clear sky upward radiance by layer 0:nlay*nbands! +! totdrad- real, total sky downward radiance by layer 0:nlay*nbands! +! clrdrad- real, clear sky downward radiance by layer 0:nlay*nbands! +! fnet - real, net longwave flux (w/m2) 0:nlay ! +! fnetc - real, clear sky net longwave flux (w/m2) 0:nlay ! +! ! +! ! +! ******************************************************************* ! +! original code description ! +! ! +! original version: e. j. mlawer, et al. rrtm_v3.0 ! +! revision for gcms: michael j. iacono; october, 2002 ! +! revision for f90: michael j. iacono; june, 2006 ! +! ! +! this program calculates the upward fluxes, downward fluxes, and ! +! heating rates for an arbitrary clear or cloudy atmosphere. the input ! +! to this program is the atmospheric profile, all Planck function ! +! information, and the cloud fraction by layer. a variable diffusivity! +! angle (secdif) is used for the angle integration. bands 2-3 and 5-9 ! +! use a value for secdif that varies from 1.50 to 1.80 as a function ! +! of the column water vapor, and other bands use a value of 1.66. the ! +! gaussian weight appropriate to this angle (wtdiff=0.5) is applied ! +! here. note that use of the emissivity angle for the flux integration! +! can cause errors of 1 to 4 W/m2 within cloudy layers. ! +! clouds are treated with a random cloud overlap method. ! +! ! +! ******************************************************************* ! +! ====================== end of description block ================= ! + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cldfrc + real (kind=kind_phys), dimension(nbands), intent(in) :: semiss, & + & secdif + real (kind=kind_phys), dimension(nlay), intent(in) :: delp + + real (kind=kind_phys), dimension(nbands,nlay),intent(in):: taucld + real (kind=kind_phys), dimension(ngptlw,nlay),intent(in):: fracs, & + & tautot + + real (kind=kind_phys), dimension(nbands,0:nlay), intent(in) :: & + & pklev, pklay + +! --- outputs: + real (kind=kind_phys), dimension(nlay), intent(out) :: htr, htrcl + + real (kind=kind_phys), dimension(nlay,nbands),intent(out) :: htrb + + real (kind=kind_phys), dimension(0:nlay), intent(out) :: & + & totuflux, totdflux, totuclfl, totdclfl + +! --- locals: + real (kind=kind_phys), parameter :: rec_6 = 0.166667 + + real (kind=kind_phys), dimension(0:nlay,nbands) :: clrurad, & + & clrdrad, toturad, totdrad + + real (kind=kind_phys), dimension(nlay) :: gassrcu, totsrcu, & + & trngas, efclrfr, rfdelp + real (kind=kind_phys), dimension(0:nlay) :: fnet, fnetc + + real (kind=kind_phys) :: totsrcd, gassrcd, tblind, odepth, odtot, & + & odcld, atrtot, atrgas, reflct, totfac, gasfac, flxfac, & + & plfrac, blay, bbdgas, bbdtot, bbugas, bbutot, dplnku, & + & dplnkd, radtotu, radclru, radtotd, radclrd, rad0, & + & clfr, trng, gasu + + integer :: ittot, itgas, ib, ig, k +! +!===> ... begin here +! + do ib = 1, NBANDS + do k = 0, NLAY + toturad(k,ib) = f_zero + totdrad(k,ib) = f_zero + clrurad(k,ib) = f_zero + clrdrad(k,ib) = f_zero + enddo + enddo + + do k = 0, nlay + totuflux(k) = f_zero + totdflux(k) = f_zero + totuclfl(k) = f_zero + totdclfl(k) = f_zero + enddo + +! --- ... loop over all g-points + + do ig = 1, ngptlw + ib = ngb(ig) + + radtotd = f_zero + radclrd = f_zero + +!> -# Downward radiative transfer loop. + + do k = nlay, 1, -1 + +!!\n - clear sky, gases contribution + + odepth = max( f_zero, secdif(ib)*tautot(ig,k) ) + if (odepth <= 0.06) then + atrgas = odepth - 0.5*odepth*odepth + trng = f_one - atrgas + gasfac = rec_6 * odepth + else + tblind = odepth / (bpade + odepth) + itgas = tblint*tblind + 0.5 + trng = exp_tbl(itgas) + atrgas = f_one - trng + gasfac = tfn_tbl(itgas) + odepth = tau_tbl(itgas) + endif + + plfrac = fracs(ig,k) + blay = pklay(ib,k) + + dplnku = pklev(ib,k ) - blay + dplnkd = pklev(ib,k-1) - blay + bbdgas = plfrac * (blay + dplnkd*gasfac) + bbugas = plfrac * (blay + dplnku*gasfac) + gassrcd= bbdgas * atrgas + gassrcu(k)= bbugas * atrgas + trngas(k) = trng + +!!\n - total sky, gases+clouds contribution + + clfr = cldfrc(k) + if (clfr >= eps) then +!!\n - cloudy layer + + odcld = secdif(ib) * taucld(ib,k) + efclrfr(k) = f_one-(f_one - exp(-odcld))*clfr + odtot = odepth + odcld + if (odtot < 0.06) then + totfac = rec_6 * odtot + atrtot = odtot - 0.5*odtot*odtot + else + tblind = odtot / (bpade + odtot) + ittot = tblint*tblind + 0.5 + totfac = tfn_tbl(ittot) + atrtot = f_one - exp_tbl(ittot) + endif + + bbdtot = plfrac * (blay + dplnkd*totfac) + bbutot = plfrac * (blay + dplnku*totfac) + totsrcd= bbdtot * atrtot + totsrcu(k)= bbutot * atrtot + +! --- ... total sky radiance + radtotd = radtotd*trng*efclrfr(k) + gassrcd & + & + clfr*(totsrcd - gassrcd) + totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd + +! --- ... clear sky radiance + radclrd = radclrd*trng + gassrcd + clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd + + else +! --- ... clear layer + +! --- ... total sky radiance + radtotd = radtotd*trng + gassrcd + totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd + +! --- ... clear sky radiance + radclrd = radclrd*trng + gassrcd + clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd + + endif ! end if_clfr_block + + enddo ! end do_k_loop + +!> -# Compute spectral emissivity & reflectance, include the +!! contribution of spectrally varying longwave emissivity and +!! reflection from the surface to the upward radiative transfer. + +! note: spectral and Lambertian reflection are identical for the +! diffusivity angle flux integration used here. + + reflct = f_one - semiss(ib) + rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) + +!> -# Compute total sky radiance. + radtotu = rad0 + reflct*radtotd + toturad(0,ib) = toturad(0,ib) + radtotu + +!> -# Compute clear sky radiance + radclru = rad0 + reflct*radclrd + clrurad(0,ib) = clrurad(0,ib) + radclru + +!> -# Upward radiative transfer loop. + + do k = 1, nlay + clfr = cldfrc(k) + trng = trngas(k) + gasu = gassrcu(k) + + if (clfr >= eps) then +! --- ... cloudy layer + +! --- ... total sky radiance + radtotu = radtotu*trng*efclrfr(k) + gasu & + & + clfr*(totsrcu(k) - gasu) + toturad(k,ib) = toturad(k,ib) + radtotu + +! --- ... clear sky radiance + radclru = radclru*trng + gasu + clrurad(k,ib) = clrurad(k,ib) + radclru + + else +! --- ... clear layer + +! --- ... total sky radiance + radtotu = radtotu*trng + gasu + toturad(k,ib) = toturad(k,ib) + radtotu + +! --- ... clear sky radiance + radclru = radclru*trng + gasu + clrurad(k,ib) = clrurad(k,ib) + radclru + + endif ! end if_clfr_block + + enddo ! end do_k_loop + + enddo ! end do_ig_loop + +!> -# Process longwave output from band for total and clear streams. +!! Calculate upward, downward, and net flux. + + flxfac = wtdiff * fluxfac + + do k = 0, nlay + do ib = 1, nbands + totuflux(k) = totuflux(k) + toturad(k,ib) + totdflux(k) = totdflux(k) + totdrad(k,ib) + totuclfl(k) = totuclfl(k) + clrurad(k,ib) + totdclfl(k) = totdclfl(k) + clrdrad(k,ib) + enddo + + totuflux(k) = totuflux(k) * flxfac + totdflux(k) = totdflux(k) * flxfac + totuclfl(k) = totuclfl(k) * flxfac + totdclfl(k) = totdclfl(k) * flxfac + enddo + +! --- ... calculate net fluxes and heating rates + fnet(0) = totuflux(0) - totdflux(0) + + do k = 1, nlay + rfdelp(k) = heatfac / delp(k) + fnet(k) = totuflux(k) - totdflux(k) + htr (k) = (fnet(k-1) - fnet(k)) * rfdelp(k) + enddo + +!! --- ... optional clear sky heating rates + if ( lhlw0 ) then + fnetc(0) = totuclfl(0) - totdclfl(0) + + do k = 1, nlay + fnetc(k) = totuclfl(k) - totdclfl(k) + htrcl(k) = (fnetc(k-1) - fnetc(k)) * rfdelp(k) + enddo + endif + +!! --- ... optional spectral band heating rates + if ( lhlwb ) then + do ib = 1, nbands + fnet(0) = (toturad(0,ib) - totdrad(0,ib)) * flxfac + + do k = 1, nlay + fnet(k) = (toturad(k,ib) - totdrad(k,ib)) * flxfac + htrb(k,ib) = (fnet(k-1) - fnet(k)) * rfdelp(k) + enddo + enddo + endif + +! .................................. + end subroutine rtrn +!! @} +! ---------------------------------- + + +!>\ingroup module_radlw_main +!> This subroutine computes the upward/downward radiative fluxes, and +!! heating rates for both clear or cloudy atmosphere. Clouds are +!! assumed as in maximum-randomly overlaping in a vertical column. +!!\param semiss lw surface emissivity +!!\param delp layer pressure thickness (mb) +!!\param cldfrc layer cloud fraction +!!\param taucld layer cloud opt depth +!!\param tautot total optical depth (gas+aerosols) +!!\param pklay integrated planck func at lay temp +!!\param pklev integrated planck func at lev temp +!!\param fracs planck fractions +!!\param secdif secant of diffusivity angle +!!\param nlay number of vertical layers +!!\param nlp1 number of vertical levels (interfaces) +!!\param totuflux total sky upward flux (\f$w/m^2\f$) +!!\param totdflux total sky downward flux (\f$w/m^2\f$) +!!\param htr total sky heating rate (k/sec or k/day) +!!\param totuclfl clear sky upward flux (\f$w/m^2\f$) +!!\param totdclfl clear sky downward flux (\f$w/m^2\f$) +!!\param htrcl clear sky heating rate (k/sec or k/day) +!!\param htrb spectral band lw heating rate (k/day) +!!\section gen_rtrnmr rtrnmr General Algorithm +!> @{ +! ---------------------------------- + subroutine rtrnmr & + & ( semiss,delp,cldfrc,taucld,tautot,pklay,pklev, &! --- inputs + & fracs,secdif, nlay,nlp1, & + & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & ! --- outputs: + & ) + +! =================== program usage description =================== ! +! ! +! purpose: compute the upward/downward radiative fluxes, and heating ! +! rates for both clear or cloudy atmosphere. clouds are assumed as in ! +! maximum-randomly overlaping in a vertical colum. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: -size- ! +! semiss - real, lw surface emissivity nbands! +! delp - real, layer pressure thickness (mb) nlay ! +! cldfrc - real, layer cloud fraction 0:nlp1 ! +! taucld - real, layer cloud opt depth nbands,nlay! +! tautot - real, total optical depth (gas+aerosols) ngptlw,nlay! +! pklay - real, integrated planck func at lay temp nbands*0:nlay! +! pklev - real, integrated planck func at lev temp nbands*0:nlay! +! fracs - real, planck fractions ngptlw,nlay! +! secdif - real, secant of diffusivity angle nbands! +! nlay - integer, number of vertical layers 1 ! +! nlp1 - integer, number of vertical levels (interfaces) 1 ! +! ! +! outputs: ! +! totuflux- real, total sky upward flux (w/m2) 0:nlay ! +! totdflux- real, total sky downward flux (w/m2) 0:nlay ! +! htr - real, total sky heating rate (k/sec or k/day) nlay ! +! totuclfl- real, clear sky upward flux (w/m2) 0:nlay ! +! totdclfl- real, clear sky downward flux (w/m2) 0:nlay ! +! htrcl - real, clear sky heating rate (k/sec or k/day) nlay ! +! htrb - real, spectral band lw heating rate (k/day) nlay*nbands! +! ! +! module veriables: ! +! ngb - integer, band index for each g-value ngptlw! +! fluxfac - real, conversion factor for fluxes (pi*2.e4) 1 ! +! heatfac - real, conversion factor for heating rates (g/cp*1e-2) 1 ! +! tblint - real, conversion factor for look-up tbl (float(ntbl) 1 ! +! bpade - real, pade approx constant (1/0.278) 1 ! +! wtdiff - real, weight for radiance to flux conversion 1 ! +! ntbl - integer, dimension of look-up tables 1 ! +! tau_tbl - real, clr-sky opt dep lookup table 0:ntbl ! +! exp_tbl - real, transmittance lookup table 0:ntbl ! +! tfn_tbl - real, tau transition function 0:ntbl ! +! ! +! local variables: ! +! itgas - integer, index for gases contribution look-up table 1 ! +! ittot - integer, index for gases plus clouds look-up table 1 ! +! reflct - real, surface reflectance 1 ! +! atrgas - real, gaseous absorptivity 1 ! +! atrtot - real, gaseous and cloud absorptivity 1 ! +! odcld - real, cloud optical depth 1 ! +! odepth - real, optical depth of gaseous only 1 ! +! odtot - real, optical depth of gas and cloud 1 ! +! gasfac - real, gas-only pade factor, used for planck fn 1 ! +! totfac - real, gas+cld pade factor, used for planck fn 1 ! +! bbdgas - real, gas-only planck function for downward rt 1 ! +! bbugas - real, gas-only planck function for upward rt 1 ! +! bbdtot - real, gas and cloud planck function for downward rt 1 ! +! bbutot - real, gas and cloud planck function for upward rt 1 ! +! gassrcu- real, upwd source radiance due to gas only nlay! +! totsrcu- real, upwd source radiance due to gas + cld nlay! +! gassrcd- real, dnwd source radiance due to gas only 1 ! +! totsrcd- real, dnwd source radiance due to gas + cld 1 ! +! radtotu- real, spectrally summed total sky upwd radiance 1 ! +! radclru- real, spectrally summed clear sky upwd radiance 1 ! +! radtotd- real, spectrally summed total sky dnwd radiance 1 ! +! radclrd- real, spectrally summed clear sky dnwd radiance 1 ! +! toturad- real, total sky upward radiance by layer 0:nlay*nbands! +! clrurad- real, clear sky upward radiance by layer 0:nlay*nbands! +! totdrad- real, total sky downward radiance by layer 0:nlay*nbands! +! clrdrad- real, clear sky downward radiance by layer 0:nlay*nbands! +! fnet - real, net longwave flux (w/m2) 0:nlay ! +! fnetc - real, clear sky net longwave flux (w/m2) 0:nlay ! +! ! +! ! +! ******************************************************************* ! +! original code description ! +! ! +! original version: e. j. mlawer, et al. rrtm_v3.0 ! +! revision for gcms: michael j. iacono; october, 2002 ! +! revision for f90: michael j. iacono; june, 2006 ! +! ! +! this program calculates the upward fluxes, downward fluxes, and ! +! heating rates for an arbitrary clear or cloudy atmosphere. the input ! +! to this program is the atmospheric profile, all Planck function ! +! information, and the cloud fraction by layer. a variable diffusivity! +! angle (secdif) is used for the angle integration. bands 2-3 and 5-9 ! +! use a value for secdif that varies from 1.50 to 1.80 as a function ! +! of the column water vapor, and other bands use a value of 1.66. the ! +! gaussian weight appropriate to this angle (wtdiff=0.5) is applied ! +! here. note that use of the emissivity angle for the flux integration! +! can cause errors of 1 to 4 W/m2 within cloudy layers. ! +! clouds are treated with a maximum-random cloud overlap method. ! +! ! +! ******************************************************************* ! +! ====================== end of description block ================= ! + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cldfrc + real (kind=kind_phys), dimension(nbands), intent(in) :: semiss, & + & secdif + real (kind=kind_phys), dimension(nlay), intent(in) :: delp + + real (kind=kind_phys), dimension(nbands,nlay),intent(in):: taucld + real (kind=kind_phys), dimension(ngptlw,nlay),intent(in):: fracs, & + & tautot + + real (kind=kind_phys), dimension(nbands,0:nlay), intent(in) :: & + & pklev, pklay + +! --- outputs: + real (kind=kind_phys), dimension(nlay), intent(out) :: htr, htrcl + + real (kind=kind_phys), dimension(nlay,nbands),intent(out) :: htrb + + real (kind=kind_phys), dimension(0:nlay), intent(out) :: & + & totuflux, totdflux, totuclfl, totdclfl + +! --- locals: + real (kind=kind_phys), parameter :: rec_6 = 0.166667 + + real (kind=kind_phys), dimension(0:nlay,nbands) :: clrurad, & + & clrdrad, toturad, totdrad + + real (kind=kind_phys), dimension(nlay) :: gassrcu, totsrcu, & + & trngas, trntot, rfdelp + real (kind=kind_phys), dimension(0:nlay) :: fnet, fnetc + + real (kind=kind_phys) :: totsrcd, gassrcd, tblind, odepth, odtot, & + & odcld, atrtot, atrgas, reflct, totfac, gasfac, flxfac, & + & plfrac, blay, bbdgas, bbdtot, bbugas, bbutot, dplnku, & + & dplnkd, radtotu, radclru, radtotd, radclrd, rad0, rad, & + & totradd, clrradd, totradu, clrradu, fmax, fmin, rat1, rat2,& + & radmod, clfr, trng, trnt, gasu, totu + + integer :: ittot, itgas, ib, ig, k + +! dimensions for cloud overlap adjustment + real (kind=kind_phys), dimension(nlp1) :: faccld1u, faccld2u, & + & facclr1u, facclr2u, faccmb1u, faccmb2u + real (kind=kind_phys), dimension(0:nlay) :: faccld1d, faccld2d, & + & facclr1d, facclr2d, faccmb1d, faccmb2d + + logical :: lstcldu(nlay), lstcldd(nlay) +! +!===> ... begin here +! + do k = 1, nlp1 + faccld1u(k) = f_zero + faccld2u(k) = f_zero + facclr1u(k) = f_zero + facclr2u(k) = f_zero + faccmb1u(k) = f_zero + faccmb2u(k) = f_zero + enddo + + lstcldu(1) = cldfrc(1) > eps + rat1 = f_zero + rat2 = f_zero + + do k = 1, nlay-1 + + lstcldu(k+1) = cldfrc(k+1)>eps .and. cldfrc(k)<=eps + + if (cldfrc(k) > eps) then + +!> -# Setup maximum/random cloud overlap. + + if (cldfrc(k+1) >= cldfrc(k)) then + if (lstcldu(k)) then + if (cldfrc(k) < f_one) then + facclr2u(k+1) = (cldfrc(k+1) - cldfrc(k)) & + & / (f_one - cldfrc(k)) + endif + facclr2u(k) = f_zero + faccld2u(k) = f_zero + else + fmax = max(cldfrc(k), cldfrc(k-1)) + if (cldfrc(k+1) > fmax) then + facclr1u(k+1) = rat2 + facclr2u(k+1) = (cldfrc(k+1) - fmax)/(f_one - fmax) + elseif (cldfrc(k+1) < fmax) then + facclr1u(k+1) = (cldfrc(k+1) - cldfrc(k)) & + & / (cldfrc(k-1) - cldfrc(k)) + else + facclr1u(k+1) = rat2 + endif + endif + + if (facclr1u(k+1)>f_zero .or. facclr2u(k+1)>f_zero) then + rat1 = f_one + rat2 = f_zero + else + rat1 = f_zero + rat2 = f_zero + endif + else + if (lstcldu(k)) then + faccld2u(k+1) = (cldfrc(k) - cldfrc(k+1)) / cldfrc(k) + facclr2u(k) = f_zero + faccld2u(k) = f_zero + else + fmin = min(cldfrc(k), cldfrc(k-1)) + if (cldfrc(k+1) <= fmin) then + faccld1u(k+1) = rat1 + faccld2u(k+1) = (fmin - cldfrc(k+1)) / fmin + else + faccld1u(k+1) = (cldfrc(k) - cldfrc(k+1)) & + & / (cldfrc(k) - fmin) + endif + endif + + if (faccld1u(k+1)>f_zero .or. faccld2u(k+1)>f_zero) then + rat1 = f_zero + rat2 = f_one + else + rat1 = f_zero + rat2 = f_zero + endif + endif + + faccmb1u(k+1) = facclr1u(k+1) * faccld2u(k) * cldfrc(k-1) + faccmb2u(k+1) = faccld1u(k+1) * facclr2u(k) & + & * (f_one - cldfrc(k-1)) + endif + + enddo + + do k = 0, nlay + faccld1d(k) = f_zero + faccld2d(k) = f_zero + facclr1d(k) = f_zero + facclr2d(k) = f_zero + faccmb1d(k) = f_zero + faccmb2d(k) = f_zero + enddo + + lstcldd(nlay) = cldfrc(nlay) > eps + rat1 = f_zero + rat2 = f_zero + + do k = nlay, 2, -1 + + lstcldd(k-1) = cldfrc(k-1) > eps .and. cldfrc(k)<=eps + + if (cldfrc(k) > eps) then + + if (cldfrc(k-1) >= cldfrc(k)) then + if (lstcldd(k)) then + if (cldfrc(k) < f_one) then + facclr2d(k-1) = (cldfrc(k-1) - cldfrc(k)) & + & / (f_one - cldfrc(k)) + endif + + facclr2d(k) = f_zero + faccld2d(k) = f_zero + else + fmax = max(cldfrc(k), cldfrc(k+1)) + + if (cldfrc(k-1) > fmax) then + facclr1d(k-1) = rat2 + facclr2d(k-1) = (cldfrc(k-1) - fmax) / (f_one - fmax) + elseif (cldfrc(k-1) < fmax) then + facclr1d(k-1) = (cldfrc(k-1) - cldfrc(k)) & + & / (cldfrc(k+1) - cldfrc(k)) + else + facclr1d(k-1) = rat2 + endif + endif + + if (facclr1d(k-1)>f_zero .or. facclr2d(k-1)>f_zero) then + rat1 = f_one + rat2 = f_zero + else + rat1 = f_zero + rat2 = f_zero + endif + else + if (lstcldd(k)) then + faccld2d(k-1) = (cldfrc(k) - cldfrc(k-1)) / cldfrc(k) + facclr2d(k) = f_zero + faccld2d(k) = f_zero + else + fmin = min(cldfrc(k), cldfrc(k+1)) + + if (cldfrc(k-1) <= fmin) then + faccld1d(k-1) = rat1 + faccld2d(k-1) = (fmin - cldfrc(k-1)) / fmin + else + faccld1d(k-1) = (cldfrc(k) - cldfrc(k-1)) & + & / (cldfrc(k) - fmin) + endif + endif + + if (faccld1d(k-1)>f_zero .or. faccld2d(k-1)>f_zero) then + rat1 = f_zero + rat2 = f_one + else + rat1 = f_zero + rat2 = f_zero + endif + endif + + faccmb1d(k-1) = facclr1d(k-1) * faccld2d(k) * cldfrc(k+1) + faccmb2d(k-1) = faccld1d(k-1) * facclr2d(k) & + & * (f_one - cldfrc(k+1)) + endif + + enddo + +!> -# Initialize for radiative transfer + + do ib = 1, NBANDS + do k = 0, NLAY + toturad(k,ib) = f_zero + totdrad(k,ib) = f_zero + clrurad(k,ib) = f_zero + clrdrad(k,ib) = f_zero + enddo + enddo + + do k = 0, nlay + totuflux(k) = f_zero + totdflux(k) = f_zero + totuclfl(k) = f_zero + totdclfl(k) = f_zero + enddo + +! --- ... loop over all g-points + + do ig = 1, ngptlw + ib = ngb(ig) + + radtotd = f_zero + radclrd = f_zero + +!> -# Downward radiative transfer loop: + + do k = nlay, 1, -1 + +! --- ... clear sky, gases contribution + + odepth = max( f_zero, secdif(ib)*tautot(ig,k) ) + if (odepth <= 0.06) then + atrgas = odepth - 0.5*odepth*odepth + trng = f_one - atrgas + gasfac = rec_6 * odepth + else + tblind = odepth / (bpade + odepth) + itgas = tblint*tblind + 0.5 + trng = exp_tbl(itgas) + atrgas = f_one - trng + gasfac = tfn_tbl(itgas) + odepth = tau_tbl(itgas) + endif + + plfrac = fracs(ig,k) + blay = pklay(ib,k) + + dplnku = pklev(ib,k ) - blay + dplnkd = pklev(ib,k-1) - blay + bbdgas = plfrac * (blay + dplnkd*gasfac) + bbugas = plfrac * (blay + dplnku*gasfac) + gassrcd = bbdgas * atrgas + gassrcu(k)= bbugas * atrgas + trngas(k) = trng + +! --- ... total sky, gases+clouds contribution + + clfr = cldfrc(k) + if (lstcldd(k)) then + totradd = clfr * radtotd + clrradd = radtotd - totradd + rad = f_zero + endif + + if (clfr >= eps) then +!> - cloudy layer + + odcld = secdif(ib) * taucld(ib,k) + odtot = odepth + odcld + if (odtot < 0.06) then + totfac = rec_6 * odtot + atrtot = odtot - 0.5*odtot*odtot + trnt = f_one - atrtot + else + tblind = odtot / (bpade + odtot) + ittot = tblint*tblind + 0.5 + totfac = tfn_tbl(ittot) + trnt = exp_tbl(ittot) + atrtot = f_one - trnt + endif + + bbdtot = plfrac * (blay + dplnkd*totfac) + bbutot = plfrac * (blay + dplnku*totfac) + totsrcd = bbdtot * atrtot + totsrcu(k)= bbutot * atrtot + trntot(k) = trnt + + totradd = totradd*trnt + clfr*totsrcd + clrradd = clrradd*trng + (f_one - clfr)*gassrcd + +!> - total sky radiance + radtotd = totradd + clrradd + totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd + +!> - clear sky radiance + radclrd = radclrd*trng + gassrcd + clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd + + radmod = rad*(facclr1d(k-1)*trng + faccld1d(k-1)*trnt) & + & - faccmb1d(k-1)*gassrcd + faccmb2d(k-1)*totsrcd + + rad = -radmod + facclr2d(k-1)*(clrradd + radmod) & + & - faccld2d(k-1)*(totradd - radmod) + totradd = totradd + rad + clrradd = clrradd - rad + + else +! --- ... clear layer + +! --- ... total sky radiance + radtotd = radtotd*trng + gassrcd + totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd + +! --- ... clear sky radiance + radclrd = radclrd*trng + gassrcd + clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd + + endif ! end if_clfr_block + + enddo ! end do_k_loop + +!> -# Compute spectral emissivity & reflectance, include the +!! contribution of spectrally varying longwave emissivity and +!! reflection from the surface to the upward radiative transfer. + +! note: spectral and Lambertian reflection are identical for the +! diffusivity angle flux integration used here. + + reflct = f_one - semiss(ib) + rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) + +!> -# Compute total sky radiance. + radtotu = rad0 + reflct*radtotd + toturad(0,ib) = toturad(0,ib) + radtotu + +!> -# Compute clear sky radiance. + radclru = rad0 + reflct*radclrd + clrurad(0,ib) = clrurad(0,ib) + radclru + +!> -# Upward radiative transfer loop: + + do k = 1, nlay + + clfr = cldfrc(k) + trng = trngas(k) + gasu = gassrcu(k) + + if (lstcldu(k)) then + totradu = clfr * radtotu + clrradu = radtotu - totradu + rad = f_zero + endif + + if (clfr >= eps) then +!> - cloudy layer radiance + + trnt = trntot(k) + totu = totsrcu(k) + totradu = totradu*trnt + clfr*totu + clrradu = clrradu*trng + (f_one - clfr)*gasu + +!> - total sky radiance + radtotu = totradu + clrradu + toturad(k,ib) = toturad(k,ib) + radtotu + +!> - clear sky radiance + radclru = radclru*trng + gasu + clrurad(k,ib) = clrurad(k,ib) + radclru + + radmod = rad*(facclr1u(k+1)*trng + faccld1u(k+1)*trnt) & + & - faccmb1u(k+1)*gasu + faccmb2u(k+1)*totu + rad = -radmod + facclr2u(k+1)*(clrradu + radmod) & + & - faccld2u(k+1)*(totradu - radmod) + totradu = totradu + rad + clrradu = clrradu - rad + + else +! --- ... clear layer + +! --- ... total sky radiance + radtotu = radtotu*trng + gasu + toturad(k,ib) = toturad(k,ib) + radtotu + +! --- ... clear sky radiance + radclru = radclru*trng + gasu + clrurad(k,ib) = clrurad(k,ib) + radclru + + endif ! end if_clfr_block + + enddo ! end do_k_loop + + enddo ! end do_ig_loop + +!> -# Process longwave output from band for total and clear streams. +!! calculate upward, downward, and net flux. + + flxfac = wtdiff * fluxfac + + do k = 0, nlay + do ib = 1, nbands + totuflux(k) = totuflux(k) + toturad(k,ib) + totdflux(k) = totdflux(k) + totdrad(k,ib) + totuclfl(k) = totuclfl(k) + clrurad(k,ib) + totdclfl(k) = totdclfl(k) + clrdrad(k,ib) + enddo + + totuflux(k) = totuflux(k) * flxfac + totdflux(k) = totdflux(k) * flxfac + totuclfl(k) = totuclfl(k) * flxfac + totdclfl(k) = totdclfl(k) * flxfac + enddo + +! --- ... calculate net fluxes and heating rates + fnet(0) = totuflux(0) - totdflux(0) + + do k = 1, nlay + rfdelp(k) = heatfac / delp(k) + fnet(k) = totuflux(k) - totdflux(k) + htr (k) = (fnet(k-1) - fnet(k)) * rfdelp(k) + enddo + +!! --- ... optional clear sky heating rates + if ( lhlw0 ) then + fnetc(0) = totuclfl(0) - totdclfl(0) + + do k = 1, nlay + fnetc(k) = totuclfl(k) - totdclfl(k) + htrcl(k) = (fnetc(k-1) - fnetc(k)) * rfdelp(k) + enddo + endif + +!! --- ... optional spectral band heating rates + if ( lhlwb ) then + do ib = 1, nbands + fnet(0) = (toturad(0,ib) - totdrad(0,ib)) * flxfac + + do k = 1, nlay + fnet(k) = (toturad(k,ib) - totdrad(k,ib)) * flxfac + htrb(k,ib) = (fnet(k-1) - fnet(k)) * rfdelp(k) + enddo + enddo + endif + +! ................................. + end subroutine rtrnmr +! --------------------------------- +!> @} + +!>\ingroup module_radlw_main +!> \brief This subroutine computes the upward/downward radiative fluxes, and +!! heating rates for both clear or cloudy atmosphere.Clouds are treated +!! with the mcica stochastic approach. +!! +!!\param semiss lw surface emissivity +!!\param delp layer pressure thickness (mb) +!!\param cldfmc layer cloud fraction (sub-column) +!!\param taucld layer cloud opt depth +!!\param tautot total optical depth (gas+aerosols) +!!\param pklay integrated planck func at lay temp +!!\param pklev integrated planck func at lev temp +!!\param fracs planck fractions +!!\param secdif secant of diffusivity angle +!!\param nlay number of vertical layers +!!\param nlp1 number of vertical levels (interfaces) +!!\param totuflux total sky upward flux \f$(w/m^2)\f$ +!!\param totdflux total sky downward flux \f$(w/m^2)\f$ +!!\param htr total sky heating rate (k/sec or k/day) +!!\param totuclfl clear sky upward flux \f$(w/m^2)\f$ +!!\param totdclfl clear sky downward flux \f$(w/m^2)\f$ +!!\param htrcl clear sky heating rate (k/sec or k/day) +!!\param htrb spectral band lw heating rate (k/day) +!!\section gen_rtrnmc rtrnmc General Algorithm +!> @{ +! --------------------------------- + subroutine rtrnmc & + & ( semiss,delp,cldfmc,taucld,tautot,pklay,pklev, & ! --- inputs: + & fracs,secdif, nlay,nlp1, & + & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & ! --- outputs: + & ) + +! =================== program usage description =================== ! +! ! +! purpose: compute the upward/downward radiative fluxes, and heating ! +! rates for both clear or cloudy atmosphere. clouds are treated with ! +! the mcica stochastic approach. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: -size- ! +! semiss - real, lw surface emissivity nbands! +! delp - real, layer pressure thickness (mb) nlay ! +! cldfmc - real, layer cloud fraction (sub-column) ngptlw*nlay! +! taucld - real, layer cloud opt depth nbands*nlay! +! tautot - real, total optical depth (gas+aerosols) ngptlw*nlay! +! pklay - real, integrated planck func at lay temp nbands*0:nlay! +! pklev - real, integrated planck func at lev temp nbands*0:nlay! +! fracs - real, planck fractions ngptlw*nlay! +! secdif - real, secant of diffusivity angle nbands! +! nlay - integer, number of vertical layers 1 ! +! nlp1 - integer, number of vertical levels (interfaces) 1 ! +! ! +! outputs: ! +! totuflux- real, total sky upward flux (w/m2) 0:nlay ! +! totdflux- real, total sky downward flux (w/m2) 0:nlay ! +! htr - real, total sky heating rate (k/sec or k/day) nlay ! +! totuclfl- real, clear sky upward flux (w/m2) 0:nlay ! +! totdclfl- real, clear sky downward flux (w/m2) 0:nlay ! +! htrcl - real, clear sky heating rate (k/sec or k/day) nlay ! +! htrb - real, spectral band lw heating rate (k/day) nlay*nbands! +! ! +! module veriables: ! +! ngb - integer, band index for each g-value ngptlw! +! fluxfac - real, conversion factor for fluxes (pi*2.e4) 1 ! +! heatfac - real, conversion factor for heating rates (g/cp*1e-2) 1 ! +! tblint - real, conversion factor for look-up tbl (float(ntbl) 1 ! +! bpade - real, pade approx constant (1/0.278) 1 ! +! wtdiff - real, weight for radiance to flux conversion 1 ! +! ntbl - integer, dimension of look-up tables 1 ! +! tau_tbl - real, clr-sky opt dep lookup table 0:ntbl ! +! exp_tbl - real, transmittance lookup table 0:ntbl ! +! tfn_tbl - real, tau transition function 0:ntbl ! +! ! +! local variables: ! +! itgas - integer, index for gases contribution look-up table 1 ! +! ittot - integer, index for gases plus clouds look-up table 1 ! +! reflct - real, surface reflectance 1 ! +! atrgas - real, gaseous absorptivity 1 ! +! atrtot - real, gaseous and cloud absorptivity 1 ! +! odcld - real, cloud optical depth 1 ! +! efclrfr- real, effective clear sky fraction (1-efcldfr) nlay! +! odepth - real, optical depth of gaseous only 1 ! +! odtot - real, optical depth of gas and cloud 1 ! +! gasfac - real, gas-only pade factor, used for planck function 1 ! +! totfac - real, gas and cloud pade factor, used for planck fn 1 ! +! bbdgas - real, gas-only planck function for downward rt 1 ! +! bbugas - real, gas-only planck function for upward rt 1 ! +! bbdtot - real, gas and cloud planck function for downward rt 1 ! +! bbutot - real, gas and cloud planck function for upward rt 1 ! +! gassrcu- real, upwd source radiance due to gas nlay! +! totsrcu- real, upwd source radiance due to gas+cld nlay! +! gassrcd- real, dnwd source radiance due to gas 1 ! +! totsrcd- real, dnwd source radiance due to gas+cld 1 ! +! radtotu- real, spectrally summed total sky upwd radiance 1 ! +! radclru- real, spectrally summed clear sky upwd radiance 1 ! +! radtotd- real, spectrally summed total sky dnwd radiance 1 ! +! radclrd- real, spectrally summed clear sky dnwd radiance 1 ! +! toturad- real, total sky upward radiance by layer 0:nlay*nbands! +! clrurad- real, clear sky upward radiance by layer 0:nlay*nbands! +! totdrad- real, total sky downward radiance by layer 0:nlay*nbands! +! clrdrad- real, clear sky downward radiance by layer 0:nlay*nbands! +! fnet - real, net longwave flux (w/m2) 0:nlay ! +! fnetc - real, clear sky net longwave flux (w/m2) 0:nlay ! +! ! +! ! +! ******************************************************************* ! +! original code description ! +! ! +! original version: e. j. mlawer, et al. rrtm_v3.0 ! +! revision for gcms: michael j. iacono; october, 2002 ! +! revision for f90: michael j. iacono; june, 2006 ! +! ! +! this program calculates the upward fluxes, downward fluxes, and ! +! heating rates for an arbitrary clear or cloudy atmosphere. the input ! +! to this program is the atmospheric profile, all Planck function ! +! information, and the cloud fraction by layer. a variable diffusivity! +! angle (secdif) is used for the angle integration. bands 2-3 and 5-9 ! +! use a value for secdif that varies from 1.50 to 1.80 as a function ! +! of the column water vapor, and other bands use a value of 1.66. the ! +! gaussian weight appropriate to this angle (wtdiff=0.5) is applied ! +! here. note that use of the emissivity angle for the flux integration! +! can cause errors of 1 to 4 W/m2 within cloudy layers. ! +! clouds are treated with the mcica stochastic approach and ! +! maximum-random cloud overlap. ! +! ! +! ******************************************************************* ! +! ====================== end of description block ================= ! + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(nbands), intent(in) :: semiss, & + & secdif + real (kind=kind_phys), dimension(nlay), intent(in) :: delp + + real (kind=kind_phys), dimension(nbands,nlay),intent(in):: taucld + real (kind=kind_phys), dimension(ngptlw,nlay),intent(in):: fracs, & + & tautot, cldfmc + + real (kind=kind_phys), dimension(nbands,0:nlay), intent(in) :: & + & pklev, pklay + +! --- outputs: + real (kind=kind_phys), dimension(nlay), intent(out) :: htr, htrcl + + real (kind=kind_phys), dimension(nlay,nbands),intent(out) :: htrb + + real (kind=kind_phys), dimension(0:nlay), intent(out) :: & + & totuflux, totdflux, totuclfl, totdclfl + +! --- locals: + real (kind=kind_phys), parameter :: rec_6 = 0.166667 + + real (kind=kind_phys), dimension(0:nlay,nbands) :: clrurad, & + & clrdrad, toturad, totdrad + + real (kind=kind_phys), dimension(nlay) :: gassrcu, totsrcu, & + & trngas, efclrfr, rfdelp + real (kind=kind_phys), dimension(0:nlay) :: fnet, fnetc + + real (kind=kind_phys) :: totsrcd, gassrcd, tblind, odepth, odtot, & + & odcld, atrtot, atrgas, reflct, totfac, gasfac, flxfac, & + & plfrac, blay, bbdgas, bbdtot, bbugas, bbutot, dplnku, & + & dplnkd, radtotu, radclru, radtotd, radclrd, rad0, & + & clfm, trng, gasu + + integer :: ittot, itgas, ib, ig, k +! +!===> ... begin here +! + do ib = 1, NBANDS + do k = 0, NLAY + toturad(k,ib) = f_zero + totdrad(k,ib) = f_zero + clrurad(k,ib) = f_zero + clrdrad(k,ib) = f_zero + enddo + enddo + + do k = 0, nlay + totuflux(k) = f_zero + totdflux(k) = f_zero + totuclfl(k) = f_zero + totdclfl(k) = f_zero + enddo + +! --- ... loop over all g-points + + do ig = 1, ngptlw + ib = ngb(ig) + + radtotd = f_zero + radclrd = f_zero + +!> -# Downward radiative transfer loop. +!!\n - Clear sky, gases contribution +!!\n - Total sky, gases+clouds contribution +!!\n - Cloudy layer +!!\n - Total sky radiance +!!\n - Clear sky radiance + + do k = nlay, 1, -1 + +! --- ... clear sky, gases contribution + + odepth = max( f_zero, secdif(ib)*tautot(ig,k) ) + if (odepth <= 0.06) then + atrgas = odepth - 0.5*odepth*odepth + trng = f_one - atrgas + gasfac = rec_6 * odepth + else + tblind = odepth / (bpade + odepth) + itgas = tblint*tblind + 0.5 + trng = exp_tbl(itgas) + atrgas = f_one - trng + gasfac = tfn_tbl(itgas) + odepth = tau_tbl(itgas) + endif + + plfrac = fracs(ig,k) + blay = pklay(ib,k) + + dplnku = pklev(ib,k ) - blay + dplnkd = pklev(ib,k-1) - blay + bbdgas = plfrac * (blay + dplnkd*gasfac) + bbugas = plfrac * (blay + dplnku*gasfac) + gassrcd= bbdgas * atrgas + gassrcu(k)= bbugas * atrgas + trngas(k) = trng + +! --- ... total sky, gases+clouds contribution + + clfm = cldfmc(ig,k) + if (clfm >= eps) then +! --- ... cloudy layer + + odcld = secdif(ib) * taucld(ib,k) + efclrfr(k) = f_one - (f_one - exp(-odcld))*clfm + odtot = odepth + odcld + if (odtot < 0.06) then + totfac = rec_6 * odtot + atrtot = odtot - 0.5*odtot*odtot + else + tblind = odtot / (bpade + odtot) + ittot = tblint*tblind + 0.5 + totfac = tfn_tbl(ittot) + atrtot = f_one - exp_tbl(ittot) + endif + + bbdtot = plfrac * (blay + dplnkd*totfac) + bbutot = plfrac * (blay + dplnku*totfac) + totsrcd= bbdtot * atrtot + totsrcu(k)= bbutot * atrtot + +! --- ... total sky radiance + radtotd = radtotd*trng*efclrfr(k) + gassrcd & + & + clfm*(totsrcd - gassrcd) + totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd + +! --- ... clear sky radiance + radclrd = radclrd*trng + gassrcd + clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd + + else +! --- ... clear layer + +! --- ... total sky radiance + radtotd = radtotd*trng + gassrcd + totdrad(k-1,ib) = totdrad(k-1,ib) + radtotd + +! --- ... clear sky radiance + radclrd = radclrd*trng + gassrcd + clrdrad(k-1,ib) = clrdrad(k-1,ib) + radclrd + + endif ! end if_clfm_block + + enddo ! end do_k_loop + +!> -# Compute spectral emissivity & reflectance, include the +!! contribution of spectrally varying longwave emissivity and +!! reflection from the surface to the upward radiative transfer. + +! note: spectral and Lambertian reflection are identical for the +! diffusivity angle flux integration used here. + + reflct = f_one - semiss(ib) + rad0 = semiss(ib) * fracs(ig,1) * pklay(ib,0) + +!> -# Compute total sky radiance. + radtotu = rad0 + reflct*radtotd + toturad(0,ib) = toturad(0,ib) + radtotu + +!> -# Compute clear sky radiance. + radclru = rad0 + reflct*radclrd + clrurad(0,ib) = clrurad(0,ib) + radclru + +!> -# Upward radiative transfer loop. +!!\n - Compute total sky radiance +!!\n - Compute clear sky radiance + +! toturad holds summed radiance for total sky stream +! clrurad holds summed radiance for clear sky stream + + do k = 1, nlay + clfm = cldfmc(ig,k) + trng = trngas(k) + gasu = gassrcu(k) + + if (clfm > eps) then +! --- ... cloudy layer + +! --- ... total sky radiance + radtotu = radtotu*trng*efclrfr(k) + gasu & + & + clfm*(totsrcu(k) - gasu) + toturad(k,ib) = toturad(k,ib) + radtotu + +! --- ... clear sky radiance + radclru = radclru*trng + gasu + clrurad(k,ib) = clrurad(k,ib) + radclru + + else +! --- ... clear layer + +! --- ... total sky radiance + radtotu = radtotu*trng + gasu + toturad(k,ib) = toturad(k,ib) + radtotu + +! --- ... clear sky radiance + radclru = radclru*trng + gasu + clrurad(k,ib) = clrurad(k,ib) + radclru + + endif ! end if_clfm_block + + enddo ! end do_k_loop + + enddo ! end do_ig_loop + +!> -# Process longwave output from band for total and clear streams. +!! Calculate upward, downward, and net flux. + + flxfac = wtdiff * fluxfac + + do k = 0, nlay + do ib = 1, nbands + totuflux(k) = totuflux(k) + toturad(k,ib) + totdflux(k) = totdflux(k) + totdrad(k,ib) + totuclfl(k) = totuclfl(k) + clrurad(k,ib) + totdclfl(k) = totdclfl(k) + clrdrad(k,ib) + enddo + + totuflux(k) = totuflux(k) * flxfac + totdflux(k) = totdflux(k) * flxfac + totuclfl(k) = totuclfl(k) * flxfac + totdclfl(k) = totdclfl(k) * flxfac + enddo + +!> -# Calculate net fluxes and heating rates. + fnet(0) = totuflux(0) - totdflux(0) + + do k = 1, nlay + rfdelp(k) = heatfac / delp(k) + fnet(k) = totuflux(k) - totdflux(k) + htr (k) = (fnet(k-1) - fnet(k)) * rfdelp(k) + enddo + +!> -# Optional clear sky heating rates. + if ( lhlw0 ) then + fnetc(0) = totuclfl(0) - totdclfl(0) + + do k = 1, nlay + fnetc(k) = totuclfl(k) - totdclfl(k) + htrcl(k) = (fnetc(k-1) - fnetc(k)) * rfdelp(k) + enddo + endif + +!> -# Optional spectral band heating rates. + if ( lhlwb ) then + do ib = 1, nbands + fnet(0) = (toturad(0,ib) - totdrad(0,ib)) * flxfac + + do k = 1, nlay + fnet(k) = (toturad(k,ib) - totdrad(k,ib)) * flxfac + htrb(k,ib) = (fnet(k-1) - fnet(k)) * rfdelp(k) + enddo + enddo + endif + +! .................................. + end subroutine rtrnmc +! ---------------------------------- +!> @} + +!>\ingroup module_radlw_main +!>\brief This subroutine contains optical depths developed for the rapid +!! radiative transfer model. +!! +!! It contains the subroutines \a taugbn (where n goes from +!! 1 to 16). \a taugbn calculates the optical depths and planck fractions +!! per g-value and layer for band n. +!!\param laytrop tropopause layer index (unitless) layer at +!! which switch is made for key species +!!\param pavel layer pressures (mb) +!!\param coldry column amount for dry air \f$(mol/cm^2)\f$ +!!\param colamt column amounts of h2o, co2, o3, n2o, ch4,o2, +!! co \f$(mol/cm^2)\f$ +!!\param colbrd column amount of broadening gases +!!\param wx cross-section amounts \f$(mol/cm^2)\f$ +!!\param tauaer aerosol optical depth +!!\param rfrate reference ratios of binary species parameter +!!\n (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o,4-h2o/ch4, +!! 5-n2o/co2,6-o3/co2 +!!\n (:,:,n)n=1,2: the rates of ref press at the 2 +!! sides of the layer +!!\param fac00,fac01,fac10,fac11 factors multiply the reference ks, i,j of 0/1 +!! for lower/higher of the 2 appropriate +!! temperatures and altitudes +!!\param jp index of lower reference pressure +!!\param jt, jt1 indices of lower reference temperatures for +!! pressure levels jp and jp+1, respectively +!!\param selffac scale factor for water vapor self-continuum +!! equals (water vapor density)/(atmospheric +!! density at 296k and 1013 mb) +!!\param selffrac factor for temperature interpolation of +!! reference water vapor self-continuum data +!!\param indself index of lower reference temperature for the +!! self-continuum interpolation +!!\param forfac scale factor for w. v. foreign-continuum +!!\param forfrac factor for temperature interpolation of +!! reference w.v. foreign-continuum data +!!\param indfor index of lower reference temperature for the +!! foreign-continuum interpolation +!!\param minorfrac factor for minor gases +!!\param scaleminor,scaleminorn2 scale factors for minor gases +!!\param indminor index of lower reference temperature for +!! minor gases +!!\param nlay total number of layers +!!\param fracs planck fractions +!!\param tautot total optical depth (gas+aerosols) +!>\section taumol_gen taumol General Algorithm +!! @{ +!! subprograms called: taugb## (## = 01 -16) + subroutine taumol & + & ( laytrop,pavel,coldry,colamt,colbrd,wx,tauaer, & ! --- inputs + & rfrate,fac00,fac01,fac10,fac11,jp,jt,jt1, & + & selffac,selffrac,indself,forfac,forfrac,indfor, & + & minorfrac,scaleminor,scaleminorn2,indminor, & + & nlay, & + & fracs, tautot & ! --- outputs + & ) + +! ************ original subprogram description *************** ! +! ! +! optical depths developed for the ! +! ! +! rapid radiative transfer model (rrtm) ! +! ! +! atmospheric and environmental research, inc. ! +! 131 hartwell avenue ! +! lexington, ma 02421 ! +! ! +! eli j. mlawer ! +! jennifer delamere ! +! steven j. taubman ! +! shepard a. clough ! +! ! +! email: mlawer@aer.com ! +! email: jdelamer@aer.com ! +! ! +! the authors wish to acknowledge the contributions of the ! +! following people: karen cady-pereira, patrick d. brown, ! +! michael j. iacono, ronald e. farren, luke chen, ! +! robert bergstrom. ! +! ! +! revision for g-point reduction: michael j. iacono; aer, inc. ! +! ! +! taumol ! +! ! +! this file contains the subroutines taugbn (where n goes from ! +! 1 to 16). taugbn calculates the optical depths and planck ! +! fractions per g-value and layer for band n. ! +! ! +! ******************************************************************* ! +! ================== program usage description ================== ! +! ! +! call taumol ! +! inputs: ! +! ( laytrop,pavel,coldry,colamt,colbrd,wx,tauaer, ! +! rfrate,fac00,fac01,fac10,fac11,jp,jt,jt1, ! +! selffac,selffrac,indself,forfac,forfrac,indfor, ! +! minorfrac,scaleminor,scaleminorn2,indminor, ! +! nlay, ! +! outputs: ! +! fracs, tautot ) ! +! ! +! subprograms called: taugb## (## = 01 -16) ! +! ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! laytrop - integer, tropopause layer index (unitless) 1 ! +! layer at which switch is made for key species ! +! pavel - real, layer pressures (mb) nlay ! +! coldry - real, column amount for dry air (mol/cm2) nlay ! +! colamt - real, column amounts of h2o, co2, o3, n2o, ch4, ! +! o2, co (mol/cm**2) nlay*maxgas! +! colbrd - real, column amount of broadening gases nlay ! +! wx - real, cross-section amounts(mol/cm2) nlay*maxxsec! +! tauaer - real, aerosol optical depth nbands*nlay ! +! rfrate - real, reference ratios of binary species parameter ! +! (:,m,:)m=1-h2o/co2,2-h2o/o3,3-h2o/n2o,4-h2o/ch4,5-n2o/co2,6-o3/co2! +! (:,:,n)n=1,2: the rates of ref press at the 2 sides of the layer ! +! nlay*nrates*2! +! facij - real, factors multiply the reference ks, i,j of 0/1 ! +! for lower/higher of the 2 appropriate temperatures ! +! and altitudes nlay ! +! jp - real, index of lower reference pressure nlay ! +! jt, jt1 - real, indices of lower reference temperatures nlay ! +! for pressure levels jp and jp+1, respectively ! +! selffac - real, scale factor for water vapor self-continuum ! +! equals (water vapor density)/(atmospheric density ! +! at 296k and 1013 mb) nlay ! +! selffrac - real, factor for temperature interpolation of ! +! reference water vapor self-continuum data nlay ! +! indself - integer, index of lower reference temperature for ! +! the self-continuum interpolation nlay ! +! forfac - real, scale factor for w. v. foreign-continuum nlay ! +! forfrac - real, factor for temperature interpolation of ! +! reference w.v. foreign-continuum data nlay ! +! indfor - integer, index of lower reference temperature for ! +! the foreign-continuum interpolation nlay ! +! minorfrac - real, factor for minor gases nlay ! +! scaleminor,scaleminorn2 ! +! - real, scale factors for minor gases nlay ! +! indminor - integer, index of lower reference temperature for ! +! minor gases nlay ! +! nlay - integer, total number of layers 1 ! +! ! +! outputs: ! +! fracs - real, planck fractions ngptlw,nlay! +! tautot - real, total optical depth (gas+aerosols) ngptlw,nlay! +! ! +! internal variables: ! +! ng## - integer, number of g-values in band ## (##=01-16) 1 ! +! nspa - integer, for lower atmosphere, the number of ref ! +! atmos, each has different relative amounts of the ! +! key species for the band nbands! +! nspb - integer, same but for upper atmosphere nbands! +! absa - real, k-values for lower ref atmospheres (no w.v. ! +! self-continuum) (cm**2/molecule) nspa(##)*5*13*ng##! +! absb - real, k-values for high ref atmospheres (all sources) ! +! (cm**2/molecule) nspb(##)*5*13:59*ng##! +! ka_m'mgas'- real, k-values for low ref atmospheres minor species ! +! (cm**2/molecule) mmn##*ng##! +! kb_m'mgas'- real, k-values for high ref atmospheres minor species ! +! (cm**2/molecule) mmn##*ng##! +! selfref - real, k-values for w.v. self-continuum for ref atmos ! +! used below laytrop (cm**2/mol) 10*ng##! +! forref - real, k-values for w.v. foreign-continuum for ref atmos +! used below/above laytrop (cm**2/mol) 4*ng##! +! ! +! ****************************************************************** ! + +! --- inputs: + integer, intent(in) :: nlay, laytrop + + integer, dimension(nlay), intent(in) :: jp, jt, jt1, indself, & + & indfor, indminor + + real (kind=kind_phys), dimension(nlay), intent(in) :: pavel, & + & coldry, colbrd, fac00, fac01, fac10, fac11, selffac, & + & selffrac, forfac, forfrac, minorfrac, scaleminor, & + & scaleminorn2 + + real (kind=kind_phys), dimension(nlay,maxgas), intent(in):: colamt + real (kind=kind_phys), dimension(nlay,maxxsec),intent(in):: wx + + real (kind=kind_phys), dimension(nbands,nlay), intent(in):: tauaer + + real (kind=kind_phys), dimension(nlay,nrates,2), intent(in) :: & + & rfrate + +! --- outputs: + real (kind=kind_phys), dimension(ngptlw,nlay), intent(out) :: & + & fracs, tautot + +! --- locals + real (kind=kind_phys), dimension(ngptlw,nlay) :: taug + + integer :: ib, ig, k +! +!===> ... begin here +! + call taugb01 + call taugb02 + call taugb03 + call taugb04 + call taugb05 + call taugb06 + call taugb07 + call taugb08 + call taugb09 + call taugb10 + call taugb11 + call taugb12 + call taugb13 + call taugb14 + call taugb15 + call taugb16 + +! --- combine gaseous and aerosol optical depths + + do ig = 1, ngptlw + ib = ngb(ig) + + do k = 1, nlay + tautot(ig,k) = taug(ig,k) + tauaer(ib,k) + enddo + enddo + +! ================= + contains +! ================= + +!>\ingroup module_radlw_main +!> band 1: 10-350 cm-1 (low key - h2o; low minor - n2); +!! (high key - h2o; high minor - n2) +! ---------------------------------- + subroutine taugb01 +! .................................. + +! ------------------------------------------------------------------ ! +! written by eli j. mlawer, atmospheric & environmental research. ! +! revised by michael j. iacono, atmospheric & environmental research. ! +! ! +! band 1: 10-350 cm-1 (low key - h2o; low minor - n2) ! +! (high key - h2o; high minor - n2) ! +! ! +! compute the optical depth by interpolating in ln(pressure) and ! +! temperature. below laytrop, the water vapor self-continuum and ! +! foreign continuum is interpolated (in temperature) separately. ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb01 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & indm, indmp, ig + + real (kind=kind_phys) :: pp, corradj, scalen2, tauself, taufor, & + & taun2 +! +!===> ... begin here +! +! --- minor gas mapping levels: +! lower - n2, p = 142.5490 mbar, t = 215.70 k +! upper - n2, p = 142.5490 mbar, t = 215.70 k + +! --- ... lower atmosphere loop + + do k = 1, laytrop + ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(1) + 1 + ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(1) + 1 + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + + pp = pavel(k) + scalen2 = colbrd(k) * scaleminorn2(k) + if (pp < 250.0) then + corradj = f_one - 0.15 * (250.0-pp) / 154.4 + else + corradj = f_one + endif + + do ig = 1, ng01 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + taun2 = scalen2 * (ka_mn2(ig,indm) + minorfrac(k) & + & * (ka_mn2(ig,indmp) - ka_mn2(ig,indm))) + + taug(ig,k) = corradj * (colamt(k,1) & + & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & + & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & + & + tauself + taufor + taun2) + + fracs(ig,k) = fracrefa(ig) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(1) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(1) + 1 + indf = indfor(k) + indm = indminor(k) + + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indfp = indf + 1 + indmp = indm + 1 + + scalen2 = colbrd(k) * scaleminorn2(k) + corradj = f_one - 0.15 * (pavel(k) / 95.6) + + do ig = 1, ng01 + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + taun2 = scalen2 * (kb_mn2(ig,indm) + minorfrac(k) & + & * (kb_mn2(ig,indmp) - kb_mn2(ig,indm))) + + taug(ig,k) = corradj * (colamt(k,1) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & + & + taufor + taun2) + + fracs(ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb01 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 2: 350-500 cm-1 (low key - h2o; high key - h2o) +! ---------------------------------- + subroutine taugb02 +! .................................. + +! ------------------------------------------------------------------ ! +! band 2: 350-500 cm-1 (low key - h2o; high key - h2o) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb02 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & ig + + real (kind=kind_phys) :: corradj, tauself, taufor +! +!===> ... begin here +! +! --- ... lower atmosphere loop + + do k = 1, laytrop + ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(2) + 1 + ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(2) + 1 + inds = indself(k) + indf = indfor(k) + + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indsp = inds + 1 + indfp = indf + 1 + + corradj = f_one - 0.05 * (pavel(k) - 100.0) / 900.0 + + do ig = 1, ng02 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + taug(ns02+ig,k) = corradj * (colamt(k,1) & + & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & + & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & + & + tauself + taufor) + + fracs(ns02+ig,k) = fracrefa(ig) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(2) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(2) + 1 + indf = indfor(k) + + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indfp = indf + 1 + + do ig = 1, ng02 + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + taug(ns02+ig,k) = colamt(k,1) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & + & + taufor + + fracs(ns02+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb02 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o); +!! (high key - h2o,co2; high minor - n2o) +! ---------------------------------- + subroutine taugb03 +! .................................. + +! ------------------------------------------------------------------ ! +! band 3: 500-630 cm-1 (low key - h2o,co2; low minor - n2o) ! +! (high key - h2o,co2; high minor - n2o) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb03 + +! --- locals: + integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & + & id000, id010, id100, id110, id200, id210, jmn2o, jmn2op, & + & id001, id011, id101, id111, id201, id211, jpl, jplp, & + & ig, js, js1 + + real (kind=kind_phys) :: absn2o, ratn2o, adjfac, adjcoln2o, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & refrat_planck_a, refrat_planck_b, refrat_m_a, refrat_m_b, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & tau_major, tau_major1, tauself, taufor, n2om1, n2om2, & + & p, p4, fk0, fk1, fk2 +! +!===> ... begin here +! +! --- ... minor gas mapping levels: +! lower - n2o, p = 706.272 mbar, t = 278.94 k +! upper - n2o, p = 95.58 mbar, t = 215.7 k + + refrat_planck_a = chi_mls(1,9)/chi_mls(2,9) ! P = 212.725 mb + refrat_planck_b = chi_mls(1,13)/chi_mls(2,13) ! P = 95.58 mb + refrat_m_a = chi_mls(1,3)/chi_mls(2,3) ! P = 706.270 mb + refrat_m_b = chi_mls(1,13)/chi_mls(2,13) ! P = 95.58 mb + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(3) + js + + speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(3) + js1 + + speccomb_mn2o = colamt(k,1) + refrat_m_a*colamt(k,2) + specparm_mn2o = colamt(k,1) / speccomb_mn2o + specmult_mn2o = 8.0 * min(specparm_mn2o, oneminus) + jmn2o = 1 + int(specmult_mn2o) + fmn2o = mod(specmult_mn2o, f_one) + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + jmn2op= jmn2o+ 1 + jplp = jpl + 1 + +! --- ... in atmospheres where the amount of n2O is too great to be considered +! a minor species, adjust the column amount of n2O by an empirical factor +! to obtain the proper contribution. + + p = coldry(k) * chi_mls(4,jp(k)+1) + ratn2o = colamt(k,4) / p + if (ratn2o > 1.5) then + adjfac = 0.5 + (ratn2o - 0.5)**0.65 + adjcoln2o = adjfac * p + else + adjcoln2o = colamt(k,4) + endif + + if (specparm < 0.125) then + p = fs - f_one + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + else if (specparm > 0.875) then + p = -fs + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk0 = f_one - fs + fk1 = fs + fk2 = f_zero + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk0*fac00(k) + fac100 = fk1*fac00(k) + fac200 = fk2*fac00(k) + fac010 = fk0*fac10(k) + fac110 = fk1*fac10(k) + fac210 = fk2*fac10(k) + + if (specparm1 < 0.125) then + p = fs1 - f_one + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p = -fs1 + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk0 = f_one - fs1 + fk1 = fs1 + fk2 = f_zero + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk0*fac01(k) + fac101 = fk1*fac01(k) + fac201 = fk2*fac01(k) + fac011 = fk0*fac11(k) + fac111 = fk1*fac11(k) + fac211 = fk2*fac11(k) + + do ig = 1, ng03 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + n2om1 = ka_mn2o(ig,jmn2o,indm) + fmn2o & + & * (ka_mn2o(ig,jmn2op,indm) - ka_mn2o(ig,jmn2o,indm)) + n2om2 = ka_mn2o(ig,jmn2o,indmp) + fmn2o & + & * (ka_mn2o(ig,jmn2op,indmp) - ka_mn2o(ig,jmn2o,indmp)) + absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1) + + tau_major = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) + + tau_major1 = speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) + + taug(ns03+ig,k) = tau_major + tau_major1 & + & + tauself + taufor + adjcoln2o*absn2o + + fracs(ns03+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo ! end do_k_loop + enddo ! end do_ig_loop + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) + specparm = colamt(k,1) / speccomb + specmult = 4.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(3) + js + + speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 4.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(3) + js1 + + speccomb_mn2o = colamt(k,1) + refrat_m_b*colamt(k,2) + specparm_mn2o = colamt(k,1) / speccomb_mn2o + specmult_mn2o = 4.0 * min(specparm_mn2o, oneminus) + jmn2o = 1 + int(specmult_mn2o) + fmn2o = mod(specmult_mn2o, f_one) + + speccomb_planck = colamt(k,1) + refrat_planck_b*colamt(k,2) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 4.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + indf = indfor(k) + indm = indminor(k) + indfp = indf + 1 + indmp = indm + 1 + jmn2op= jmn2o+ 1 + jplp = jpl + 1 + + id000 = ind0 + id010 = ind0 + 5 + id100 = ind0 + 1 + id110 = ind0 + 6 + id001 = ind1 + id011 = ind1 + 5 + id101 = ind1 + 1 + id111 = ind1 + 6 + +! --- ... in atmospheres where the amount of n2o is too great to be considered +! a minor species, adjust the column amount of N2O by an empirical factor +! to obtain the proper contribution. + + p = coldry(k) * chi_mls(4,jp(k)+1) + ratn2o = colamt(k,4) / p + if (ratn2o > 1.5) then + adjfac = 0.5 + (ratn2o - 0.5)**0.65 + adjcoln2o = adjfac * p + else + adjcoln2o = colamt(k,4) + endif + + fk0 = f_one - fs + fk1 = fs + fac000 = fk0*fac00(k) + fac010 = fk0*fac10(k) + fac100 = fk1*fac00(k) + fac110 = fk1*fac10(k) + + fk0 = f_one - fs1 + fk1 = fs1 + fac001 = fk0*fac01(k) + fac011 = fk0*fac11(k) + fac101 = fk1*fac01(k) + fac111 = fk1*fac11(k) + + do ig = 1, ng03 + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + n2om1 = kb_mn2o(ig,jmn2o,indm) + fmn2o & + & * (kb_mn2o(ig,jmn2op,indm) - kb_mn2o(ig,jmn2o,indm)) + n2om2 = kb_mn2o(ig,jmn2o,indmp) + fmn2o & + & * (kb_mn2o(ig,jmn2op,indmp) - kb_mn2o(ig,jmn2o,indmp)) + absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1) + + tau_major = speccomb & + & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) & + & + fac100*absb(ig,id100) + fac110*absb(ig,id110)) + + tau_major1 = speccomb1 & + & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) & + & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) + + taug(ns03+ig,k) = tau_major + tau_major1 & + & + taufor + adjcoln2o*absn2o + + fracs(ns03+ig,k) = fracrefb(ig,jpl) + fpl & + & * (fracrefb(ig,jplp) - fracrefb(ig,jpl)) + enddo + enddo + +! .................................. + end subroutine taugb03 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2) +! ---------------------------------- + subroutine taugb04 +! .................................. + +! ------------------------------------------------------------------ ! +! band 4: 630-700 cm-1 (low key - h2o,co2; high key - o3,co2) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb04 + +! --- locals: + integer :: k, ind0, ind1, inds, indsp, indf, indfp, jpl, jplp, & + & id000, id010, id100, id110, id200, id210, ig, js, js1, & + & id001, id011, id101, id111, id201, id211 + + real (kind=kind_phys) :: tauself, taufor, p, p4, fk0, fk1, fk2, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & refrat_planck_a, refrat_planck_b, tau_major, tau_major1 +! +!===> ... begin here +! + refrat_planck_a = chi_mls(1,11)/chi_mls(2,11) ! P = 142.5940 mb + refrat_planck_b = chi_mls(3,13)/chi_mls(2,13) ! P = 95.58350 mb + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(4) + js + + speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = ( jp(k)*5 + (jt1(k)-1)) * nspa(4) + js1 + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, 1.0) + + inds = indself(k) + indf = indfor(k) + indsp = inds + 1 + indfp = indf + 1 + jplp = jpl + 1 + + if (specparm < 0.125) then + p = fs - f_one + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p = -fs + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk0 = f_one - fs + fk1 = fs + fk2 = f_zero + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk0*fac00(k) + fac100 = fk1*fac00(k) + fac200 = fk2*fac00(k) + fac010 = fk0*fac10(k) + fac110 = fk1*fac10(k) + fac210 = fk2*fac10(k) + + if (specparm1 < 0.125) then + p = fs1 - f_one + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p = -fs1 + p4 = p**4 + fk0 = p4 + fk1 = f_one - p - 2.0*p4 + fk2 = p + p4 + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk0 = f_one - fs1 + fk1 = fs1 + fk2 = f_zero + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk0*fac01(k) + fac101 = fk1*fac01(k) + fac201 = fk2*fac01(k) + fac011 = fk0*fac11(k) + fac111 = fk1*fac11(k) + fac211 = fk2*fac11(k) + + do ig = 1, ng04 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + tau_major = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) + + tau_major1 = speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) + + taug(ns04+ig,k) = tau_major + tau_major1 + tauself + taufor + + fracs(ns04+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo ! end do_k_loop + enddo ! end do_ig_loop + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + speccomb = colamt(k,3) + rfrate(k,6,1)*colamt(k,2) + specparm = colamt(k,3) / speccomb + specmult = 4.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(4) + js + + speccomb1 = colamt(k,3) + rfrate(k,6,2)*colamt(k,2) + specparm1 = colamt(k,3) / speccomb1 + specmult1 = 4.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(4) + js1 + + speccomb_planck = colamt(k,3) + refrat_planck_b*colamt(k,2) + specparm_planck = colamt(k,3) / speccomb_planck + specmult_planck = 4.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + jplp = jpl + 1 + + id000 = ind0 + id010 = ind0 + 5 + id100 = ind0 + 1 + id110 = ind0 + 6 + id001 = ind1 + id011 = ind1 + 5 + id101 = ind1 + 1 + id111 = ind1 + 6 + + fk0 = f_one - fs + fk1 = fs + fac000 = fk0*fac00(k) + fac010 = fk0*fac10(k) + fac100 = fk1*fac00(k) + fac110 = fk1*fac10(k) + + fk0 = f_one - fs1 + fk1 = fs1 + fac001 = fk0*fac01(k) + fac011 = fk0*fac11(k) + fac101 = fk1*fac01(k) + fac111 = fk1*fac11(k) + + do ig = 1, ng04 + tau_major = speccomb & + & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) & + & + fac100*absb(ig,id100) + fac110*absb(ig,id110)) + tau_major1 = speccomb1 & + & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) & + & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) + + taug(ns04+ig,k) = tau_major + tau_major1 + + fracs(ns04+ig,k) = fracrefb(ig,jpl) + fpl & + & * (fracrefb(ig,jplp) - fracrefb(ig,jpl)) + enddo + +! --- ... empirical modification to code to improve stratospheric cooling rates +! for co2. revised to apply weighting for g-point reduction in this band. + + taug(ns04+ 8,k) = taug(ns04+ 8,k) * 0.92 + taug(ns04+ 9,k) = taug(ns04+ 9,k) * 0.88 + taug(ns04+10,k) = taug(ns04+10,k) * 1.07 + taug(ns04+11,k) = taug(ns04+11,k) * 1.1 + taug(ns04+12,k) = taug(ns04+12,k) * 0.99 + taug(ns04+13,k) = taug(ns04+13,k) * 0.88 + taug(ns04+14,k) = taug(ns04+14,k) * 0.943 + enddo + +! .................................. + end subroutine taugb04 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) +!! (high key - o3,co2) +! ---------------------------------- + subroutine taugb05 +! .................................. + +! ------------------------------------------------------------------ ! +! band 5: 700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4) ! +! (high key - o3,co2) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb05 + +! --- locals: + integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & + & id000, id010, id100, id110, id200, id210, jmo3, jmo3p, & + & id001, id011, id101, id111, id201, id211, jpl, jplp, & + & ig, js, js1 + + real (kind=kind_phys) :: tauself, taufor, o3m1, o3m2, abso3, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_mo3, specparm_mo3, specmult_mo3, fmo3, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & refrat_planck_a, refrat_planck_b, refrat_m_a, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 +! +!===> ... begin here +! +! --- ... minor gas mapping level : +! lower - o3, p = 317.34 mbar, t = 240.77 k +! lower - ccl4 + +! --- ... calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + + refrat_planck_a = chi_mls(1,5)/chi_mls(2,5) ! P = 473.420 mb + refrat_planck_b = chi_mls(3,43)/chi_mls(2,43) ! P = 0.2369 mb + refrat_m_a = chi_mls(1,7)/chi_mls(2,7) ! P = 317.348 mb + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(5) + js + + speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(5) + js1 + + speccomb_mo3 = colamt(k,1) + refrat_m_a*colamt(k,2) + specparm_mo3 = colamt(k,1) / speccomb_mo3 + specmult_mo3 = 8.0 * min(specparm_mo3, oneminus) + jmo3 = 1 + int(specmult_mo3) + fmo3 = mod(specmult_mo3, f_one) + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + jplp = jpl + 1 + jmo3p = jmo3 + 1 + + if (specparm < 0.125) then + p0 = fs - f_one + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p0 = -fs + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk00 = f_one - fs + fk10 = fs + fk20 = f_zero + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk00 * fac00(k) + fac100 = fk10 * fac00(k) + fac200 = fk20 * fac00(k) + fac010 = fk00 * fac10(k) + fac110 = fk10 * fac10(k) + fac210 = fk20 * fac10(k) + + if (specparm1 < 0.125) then + p1 = fs1 - f_one + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p1 = -fs1 + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk01 = f_one - fs1 + fk11 = fs1 + fk21 = f_zero + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk01 * fac01(k) + fac101 = fk11 * fac01(k) + fac201 = fk21 * fac01(k) + fac011 = fk01 * fac11(k) + fac111 = fk11 * fac11(k) + fac211 = fk21 * fac11(k) + + do ig = 1, ng05 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + o3m1 = ka_mo3(ig,jmo3,indm) + fmo3 & + & * (ka_mo3(ig,jmo3p,indm) - ka_mo3(ig,jmo3,indm)) + o3m2 = ka_mo3(ig,jmo3,indmp) + fmo3 & + & * (ka_mo3(ig,jmo3p,indmp) - ka_mo3(ig,jmo3,indmp)) + abso3 = o3m1 + minorfrac(k)*(o3m2 - o3m1) + + taug(ns05+ig,k) = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & + & + speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & + & + tauself + taufor+abso3*colamt(k,3)+wx(k,1)*ccl4(ig) + + fracs(ns05+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + speccomb = colamt(k,3) + rfrate(k,6,1)*colamt(k,2) + specparm = colamt(k,3) / speccomb + specmult = 4.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-13)*5 + (jt(k)-1)) * nspb(5) + js + + speccomb1 = colamt(k,3) + rfrate(k,6,2)*colamt(k,2) + specparm1 = colamt(k,3) / speccomb1 + specmult1 = 4.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(5) + js1 + + speccomb_planck = colamt(k,3) + refrat_planck_b*colamt(k,2) + specparm_planck = colamt(k,3) / speccomb_planck + specmult_planck = 4.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + jplp= jpl + 1 + + id000 = ind0 + id010 = ind0 + 5 + id100 = ind0 + 1 + id110 = ind0 + 6 + id001 = ind1 + id011 = ind1 + 5 + id101 = ind1 + 1 + id111 = ind1 + 6 + + fk00 = f_one - fs + fk10 = fs + + fk01 = f_one - fs1 + fk11 = fs1 + + fac000 = fk00 * fac00(k) + fac010 = fk00 * fac10(k) + fac100 = fk10 * fac00(k) + fac110 = fk10 * fac10(k) + + fac001 = fk01 * fac01(k) + fac011 = fk01 * fac11(k) + fac101 = fk11 * fac01(k) + fac111 = fk11 * fac11(k) + + do ig = 1, ng05 + taug(ns05+ig,k) = speccomb & + & * (fac000*absb(ig,id000) + fac010*absb(ig,id010) & + & + fac100*absb(ig,id100) + fac110*absb(ig,id110)) & + & + speccomb1 & + & * (fac001*absb(ig,id001) + fac011*absb(ig,id011) & + & + fac101*absb(ig,id101) + fac111*absb(ig,id111)) & + & + wx(k,1) * ccl4(ig) + + fracs(ns05+ig,k) = fracrefb(ig,jpl) + fpl & + & * (fracrefb(ig,jplp) - fracrefb(ig,jpl)) + enddo + enddo + +! .................................. + end subroutine taugb05 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 6: 820-980 cm-1 (low key - h2o; low minor - co2) +!! (high key - none; high minor - cfc11, cfc12) +! ---------------------------------- + subroutine taugb06 +! .................................. + +! ------------------------------------------------------------------ ! +! band 6: 820-980 cm-1 (low key - h2o; low minor - co2) ! +! (high key - none; high minor - cfc11, cfc12) +! ------------------------------------------------------------------ ! + + use module_radlw_kgb06 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & indm, indmp, ig + + real (kind=kind_phys) :: ratco2, adjfac, adjcolco2, tauself, & + & taufor, absco2, temp +! +!===> ... begin here +! +! --- ... minor gas mapping level: +! lower - co2, p = 706.2720 mb, t = 294.2 k +! upper - cfc11, cfc12 + +! --- ... lower atmosphere loop + + do k = 1, laytrop + ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(6) + 1 + ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(6) + 1 + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + ind0p = ind0 + 1 + ind1p = ind1 + 1 + +! --- ... in atmospheres where the amount of co2 is too great to be considered +! a minor species, adjust the column amount of co2 by an empirical factor +! to obtain the proper contribution. + + temp = coldry(k) * chi_mls(2,jp(k)+1) + ratco2 = colamt(k,2) / temp + if (ratco2 > 3.0) then + adjfac = 2.0 + (ratco2-2.0)**0.77 + adjcolco2 = adjfac * temp + else + adjcolco2 = colamt(k,2) + endif + + do ig = 1, ng06 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + absco2 = ka_mco2(ig,indm) + minorfrac(k) & + & * (ka_mco2(ig,indmp) - ka_mco2(ig,indm)) + + taug(ns06+ig,k) = colamt(k,1) & + & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & + & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & + & + tauself + taufor + adjcolco2*absco2 & + & + wx(k,2)*cfc11adj(ig) + wx(k,3)*cfc12(ig) + + fracs(ns06+ig,k) = fracrefa(ig) + enddo + enddo + +! --- ... upper atmosphere loop +! nothing important goes on above laytrop in this band. + + do k = laytrop+1, nlay + do ig = 1, ng06 + taug(ns06+ig,k) = wx(k,2)*cfc11adj(ig) + wx(k,3)*cfc12(ig) + + fracs(ns06+ig,k) = fracrefa(ig) + enddo + enddo + +! .................................. + end subroutine taugb06 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2) +!! (high key - o3; high minor - co2) +! ---------------------------------- + subroutine taugb07 +! .................................. + +! ------------------------------------------------------------------ ! +! band 7: 980-1080 cm-1 (low key - h2o,o3; low minor - co2) ! +! (high key - o3; high minor - co2) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb07 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & id000, id010, id100, id110, id200, id210, indm, indmp, & + & id001, id011, id101, id111, id201, id211, jmco2, jmco2p, & + & jpl, jplp, ig, js, js1 + + real (kind=kind_phys) :: tauself, taufor, co2m1, co2m2, absco2, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_mco2, specparm_mco2, specmult_mco2, fmco2, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & refrat_planck_a, refrat_m_a, ratco2, adjfac, adjcolco2, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp +! +!===> ... begin here +! +! --- ... minor gas mapping level : +! lower - co2, p = 706.2620 mbar, t= 278.94 k +! upper - co2, p = 12.9350 mbar, t = 234.01 k + +! --- ... calculate reference ratio to be used in calculation of Planck +! fraction in lower atmosphere. + + refrat_planck_a = chi_mls(1,3)/chi_mls(3,3) ! P = 706.2620 mb + refrat_m_a = chi_mls(1,3)/chi_mls(3,3) ! P = 706.2720 mb + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,2,1)*colamt(k,3) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(7) + js + + speccomb1 = colamt(k,1) + rfrate(k,2,2)*colamt(k,3) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(7) + js1 + + speccomb_mco2 = colamt(k,1) + refrat_m_a*colamt(k,3) + specparm_mco2 = colamt(k,1) / speccomb_mco2 + specmult_mco2 = 8.0 * min(specparm_mco2, oneminus) + jmco2 = 1 + int(specmult_mco2) + fmco2 = mod(specmult_mco2, f_one) + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,3) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + jplp = jpl + 1 + jmco2p= jmco2+ 1 + ind0p = ind0 + 1 + ind1p = ind1 + 1 + +! --- ... in atmospheres where the amount of CO2 is too great to be considered +! a minor species, adjust the column amount of CO2 by an empirical factor +! to obtain the proper contribution. + + temp = coldry(k) * chi_mls(2,jp(k)+1) + ratco2 = colamt(k,2) / temp + if (ratco2 > 3.0) then + adjfac = 3.0 + (ratco2-3.0)**0.79 + adjcolco2 = adjfac * temp + else + adjcolco2 = colamt(k,2) + endif + + if (specparm < 0.125) then + p0 = fs - f_one + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p0 = -fs + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk00 = f_one - fs + fk10 = fs + fk20 = f_zero + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk00 * fac00(k) + fac100 = fk10 * fac00(k) + fac200 = fk20 * fac00(k) + fac010 = fk00 * fac10(k) + fac110 = fk10 * fac10(k) + fac210 = fk20 * fac10(k) + + if (specparm1 < 0.125) then + p1 = fs1 - f_one + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p1 = -fs1 + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk01 = f_one - fs1 + fk11 = fs1 + fk21 = f_zero + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk01 * fac01(k) + fac101 = fk11 * fac01(k) + fac201 = fk21 * fac01(k) + fac011 = fk01 * fac11(k) + fac111 = fk11 * fac11(k) + fac211 = fk21 * fac11(k) + + do ig = 1, ng07 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 & + & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm)) + co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 & + & * (ka_mco2(ig,jmco2p,indmp) - ka_mco2(ig,jmco2,indmp)) + absco2 = co2m1 + minorfrac(k) * (co2m2 - co2m1) + + taug(ns07+ig,k) = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & + & + speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & + & + tauself + taufor + adjcolco2*absco2 + + fracs(ns07+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo + enddo + +! --- ... upper atmosphere loop + +! --- ... in atmospheres where the amount of co2 is too great to be considered +! a minor species, adjust the column amount of co2 by an empirical factor +! to obtain the proper contribution. + + do k = laytrop+1, nlay + temp = coldry(k) * chi_mls(2,jp(k)+1) + ratco2 = colamt(k,2) / temp + if (ratco2 > 3.0) then + adjfac = 2.0 + (ratco2-2.0)**0.79 + adjcolco2 = adjfac * temp + else + adjcolco2 = colamt(k,2) + endif + + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(7) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(7) + 1 + + indm = indminor(k) + indmp = indm + 1 + ind0p = ind0 + 1 + ind1p = ind1 + 1 + + do ig = 1, ng07 + absco2 = kb_mco2(ig,indm) + minorfrac(k) & + & * (kb_mco2(ig,indmp) - kb_mco2(ig,indm)) + + taug(ns07+ig,k) = colamt(k,3) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & + & + adjcolco2 * absco2 + + fracs(ns07+ig,k) = fracrefb(ig) + enddo + +! --- ... empirical modification to code to improve stratospheric cooling rates +! for o3. revised to apply weighting for g-point reduction in this band. + + taug(ns07+ 6,k) = taug(ns07+ 6,k) * 0.92 + taug(ns07+ 7,k) = taug(ns07+ 7,k) * 0.88 + taug(ns07+ 8,k) = taug(ns07+ 8,k) * 1.07 + taug(ns07+ 9,k) = taug(ns07+ 9,k) * 1.1 + taug(ns07+10,k) = taug(ns07+10,k) * 0.99 + taug(ns07+11,k) = taug(ns07+11,k) * 0.855 + enddo + +! .................................. + end subroutine taugb07 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) +!! (high key - o3; high minor - co2, n2o) +! ---------------------------------- + subroutine taugb08 +! .................................. + +! ------------------------------------------------------------------ ! +! band 8: 1080-1180 cm-1 (low key - h2o; low minor - co2,o3,n2o) ! +! (high key - o3; high minor - co2, n2o) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb08 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & indm, indmp, ig + + real (kind=kind_phys) :: tauself, taufor, absco2, abso3, absn2o, & + & ratco2, adjfac, adjcolco2, temp +! +!===> ... begin here +! +! --- ... minor gas mapping level: +! lower - co2, p = 1053.63 mb, t = 294.2 k +! lower - o3, p = 317.348 mb, t = 240.77 k +! lower - n2o, p = 706.2720 mb, t= 278.94 k +! lower - cfc12,cfc11 +! upper - co2, p = 35.1632 mb, t = 223.28 k +! upper - n2o, p = 8.716e-2 mb, t = 226.03 k + +! --- ... lower atmosphere loop + + do k = 1, laytrop + ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(8) + 1 + ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(8) + 1 + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + +! --- ... in atmospheres where the amount of co2 is too great to be considered +! a minor species, adjust the column amount of co2 by an empirical factor +! to obtain the proper contribution. + + temp = coldry(k) * chi_mls(2,jp(k)+1) + ratco2 = colamt(k,2) / temp + if (ratco2 > 3.0) then + adjfac = 2.0 + (ratco2-2.0)**0.65 + adjcolco2 = adjfac * temp + else + adjcolco2 = colamt(k,2) + endif + + do ig = 1, ng08 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + absco2 = (ka_mco2(ig,indm) + minorfrac(k) & + & * (ka_mco2(ig,indmp) - ka_mco2(ig,indm))) + abso3 = (ka_mo3(ig,indm) + minorfrac(k) & + & * (ka_mo3(ig,indmp) - ka_mo3(ig,indm))) + absn2o = (ka_mn2o(ig,indm) + minorfrac(k) & + & * (ka_mn2o(ig,indmp) - ka_mn2o(ig,indm))) + + taug(ns08+ig,k) = colamt(k,1) & + & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & + & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & + & + tauself+taufor + adjcolco2*absco2 & + & + colamt(k,3)*abso3 + colamt(k,4)*absn2o & + & + wx(k,3)*cfc12(ig) + wx(k,4)*cfc22adj(ig) + + fracs(ns08+ig,k) = fracrefa(ig) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(8) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(8) + 1 + + indm = indminor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indmp = indm + 1 + +! --- ... in atmospheres where the amount of co2 is too great to be considered +! a minor species, adjust the column amount of co2 by an empirical factor +! to obtain the proper contribution. + + temp = coldry(k) * chi_mls(2,jp(k)+1) + ratco2 = colamt(k,2) / temp + if (ratco2 > 3.0) then + adjfac = 2.0 + (ratco2-2.0)**0.65 + adjcolco2 = adjfac * temp + else + adjcolco2 = colamt(k,2) + endif + + do ig = 1, ng08 + absco2 = (kb_mco2(ig,indm) + minorfrac(k) & + & * (kb_mco2(ig,indmp) - kb_mco2(ig,indm))) + absn2o = (kb_mn2o(ig,indm) + minorfrac(k) & + & * (kb_mn2o(ig,indmp) - kb_mn2o(ig,indm))) + + taug(ns08+ig,k) = colamt(k,3) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & + & + adjcolco2*absco2 + colamt(k,4)*absn2o & + & + wx(k,3)*cfc12(ig) + wx(k,4)*cfc22adj(ig) + + fracs(ns08+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb08 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) +!! (high key - ch4; high minor - n2o) +! ---------------------------------- + subroutine taugb09 +! .................................. + +! ------------------------------------------------------------------ ! +! band 9: 1180-1390 cm-1 (low key - h2o,ch4; low minor - n2o) ! +! (high key - ch4; high minor - n2o) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb09 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & id000, id010, id100, id110, id200, id210, indm, indmp, & + & id001, id011, id101, id111, id201, id211, jmn2o, jmn2op, & + & jpl, jplp, ig, js, js1 + + real (kind=kind_phys) :: tauself, taufor, n2om1, n2om2, absn2o, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_mn2o, specparm_mn2o, specmult_mn2o, fmn2o, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & refrat_planck_a, refrat_m_a, ratn2o, adjfac, adjcoln2o, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp +! +!===> ... begin here +! +! --- ... minor gas mapping level : +! lower - n2o, p = 706.272 mbar, t = 278.94 k +! upper - n2o, p = 95.58 mbar, t = 215.7 k + +! --- ... calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + + refrat_planck_a = chi_mls(1,9)/chi_mls(6,9) ! P = 212 mb + refrat_m_a = chi_mls(1,3)/chi_mls(6,3) ! P = 706.272 mb + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,4,1)*colamt(k,5) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(9) + js + + speccomb1 = colamt(k,1) + rfrate(k,4,2)*colamt(k,5) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(9) + js1 + + speccomb_mn2o = colamt(k,1) + refrat_m_a*colamt(k,5) + specparm_mn2o = colamt(k,1) / speccomb_mn2o + specmult_mn2o = 8.0 * min(specparm_mn2o, oneminus) + jmn2o = 1 + int(specmult_mn2o) + fmn2o = mod(specmult_mn2o, f_one) + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,5) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + jplp = jpl + 1 + jmn2op= jmn2o+ 1 + +! --- ... in atmospheres where the amount of n2o is too great to be considered +! a minor species, adjust the column amount of n2o by an empirical factor +! to obtain the proper contribution. + + temp = coldry(k) * chi_mls(4,jp(k)+1) + ratn2o = colamt(k,4) / temp + if (ratn2o > 1.5) then + adjfac = 0.5 + (ratn2o-0.5)**0.65 + adjcoln2o = adjfac * temp + else + adjcoln2o = colamt(k,4) + endif + + if (specparm < 0.125) then + p0 = fs - f_one + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p0 = -fs + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk00 = f_one - fs + fk10 = fs + fk20 = f_zero + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk00 * fac00(k) + fac100 = fk10 * fac00(k) + fac200 = fk20 * fac00(k) + fac010 = fk00 * fac10(k) + fac110 = fk10 * fac10(k) + fac210 = fk20 * fac10(k) + + if (specparm1 < 0.125) then + p1 = fs1 - f_one + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p1 = -fs1 + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk01 = f_one - fs1 + fk11 = fs1 + fk21 = f_zero + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk01 * fac01(k) + fac101 = fk11 * fac01(k) + fac201 = fk21 * fac01(k) + fac011 = fk01 * fac11(k) + fac111 = fk11 * fac11(k) + fac211 = fk21 * fac11(k) + + do ig = 1, ng09 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + n2om1 = ka_mn2o(ig,jmn2o,indm) + fmn2o & + & * (ka_mn2o(ig,jmn2op,indm) - ka_mn2o(ig,jmn2o,indm)) + n2om2 = ka_mn2o(ig,jmn2o,indmp) + fmn2o & + & * (ka_mn2o(ig,jmn2op,indmp) - ka_mn2o(ig,jmn2o,indmp)) + absn2o = n2om1 + minorfrac(k) * (n2om2 - n2om1) + + taug(ns09+ig,k) = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & + & + speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & + & + tauself + taufor + adjcoln2o*absn2o + + fracs(ns09+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(9) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(9) + 1 + + indm = indminor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indmp = indm + 1 + +! --- ... in atmospheres where the amount of n2o is too great to be considered +! a minor species, adjust the column amount of n2o by an empirical factor +! to obtain the proper contribution. + + temp = coldry(k) * chi_mls(4,jp(k)+1) + ratn2o = colamt(k,4) / temp + if (ratn2o > 1.5) then + adjfac = 0.5 + (ratn2o - 0.5)**0.65 + adjcoln2o = adjfac * temp + else + adjcoln2o = colamt(k,4) + endif + + do ig = 1, ng09 + absn2o = kb_mn2o(ig,indm) + minorfrac(k) & + & * (kb_mn2o(ig,indmp) - kb_mn2o(ig,indm)) + + taug(ns09+ig,k) = colamt(k,5) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & + & + adjcoln2o*absn2o + + fracs(ns09+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb09 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o) +! ---------------------------------- + subroutine taugb10 +! .................................. + +! ------------------------------------------------------------------ ! +! band 10: 1390-1480 cm-1 (low key - h2o; high key - h2o) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb10 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & ig + + real (kind=kind_phys) :: tauself, taufor +! +!===> ... begin here +! +! --- ... lower atmosphere loop + + do k = 1, laytrop + ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(10) + 1 + ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(10) + 1 + + inds = indself(k) + indf = indfor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indsp = inds + 1 + indfp = indf + 1 + + do ig = 1, ng10 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + taug(ns10+ig,k) = colamt(k,1) & + & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & + & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & + & + tauself + taufor + + fracs(ns10+ig,k) = fracrefa(ig) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(10) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(10) + 1 + + indf = indfor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indfp = indf + 1 + + do ig = 1, ng10 + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + taug(ns10+ig,k) = colamt(k,1) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & + & + taufor + + fracs(ns10+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb10 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) +!! (high key - h2o; high minor - o2) +! ---------------------------------- + subroutine taugb11 +! .................................. + +! ------------------------------------------------------------------ ! +! band 11: 1480-1800 cm-1 (low - h2o; low minor - o2) ! +! (high key - h2o; high minor - o2) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb11 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & indm, indmp, ig + + real (kind=kind_phys) :: scaleo2, tauself, taufor, tauo2 +! +!===> ... begin here +! +! --- ... minor gas mapping level : +! lower - o2, p = 706.2720 mbar, t = 278.94 k +! upper - o2, p = 4.758820 mbarm t = 250.85 k + +! --- ... lower atmosphere loop + + do k = 1, laytrop + ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(11) + 1 + ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(11) + 1 + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + + scaleo2 = colamt(k,6) * scaleminor(k) + + do ig = 1, ng11 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + tauo2 = scaleo2 * (ka_mo2(ig,indm) + minorfrac(k) & + & * (ka_mo2(ig,indmp) - ka_mo2(ig,indm))) + + taug(ns11+ig,k) = colamt(k,1) & + & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & + & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & + & + tauself + taufor + tauo2 + + fracs(ns11+ig,k) = fracrefa(ig) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(11) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(11) + 1 + + indf = indfor(k) + indm = indminor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indfp = indf + 1 + indmp = indm + 1 + + scaleo2 = colamt(k,6) * scaleminor(k) + + do ig = 1, ng11 + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + tauo2 = scaleo2 * (kb_mo2(ig,indm) + minorfrac(k) & + & * (kb_mo2(ig,indmp) - kb_mo2(ig,indm))) + + taug(ns11+ig,k) = colamt(k,1) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) & + & + taufor + tauo2 + + fracs(ns11+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb11 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) +! ---------------------------------- + subroutine taugb12 +! .................................. + +! ------------------------------------------------------------------ ! +! band 12: 1800-2080 cm-1 (low - h2o,co2; high - nothing) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb12 + +! --- locals: + integer :: k, ind0, ind1, inds, indsp, indf, indfp, jpl, jplp, & + & id000, id010, id100, id110, id200, id210, ig, js, js1, & + & id001, id011, id101, id111, id201, id211 + + real (kind=kind_phys) :: tauself, taufor, refrat_planck_a, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 +! +!===> ... begin here +! +! --- ... calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + + refrat_planck_a = chi_mls(1,10)/chi_mls(2,10) ! P = 174.164 mb + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,1,1)*colamt(k,2) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(12) + js + + speccomb1 = colamt(k,1) + rfrate(k,1,2)*colamt(k,2) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(12) + js1 + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,2) + specparm_planck = colamt(k,1) / speccomb_planck + if (specparm_planck >= oneminus) specparm_planck=oneminus + specmult_planck = 8.0 * specparm_planck + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + inds = indself(k) + indf = indfor(k) + indsp = inds + 1 + indfp = indf + 1 + jplp = jpl + 1 + + if (specparm < 0.125) then + p0 = fs - f_one + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p0 = -fs + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk00 = f_one - fs + fk10 = fs + fk20 = f_zero + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk00 * fac00(k) + fac100 = fk10 * fac00(k) + fac200 = fk20 * fac00(k) + fac010 = fk00 * fac10(k) + fac110 = fk10 * fac10(k) + fac210 = fk20 * fac10(k) + + if (specparm1 < 0.125) then + p1 = fs1 - f_one + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p1 = -fs1 + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk01 = f_one - fs1 + fk11 = fs1 + fk21 = f_zero + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk01 * fac01(k) + fac101 = fk11 * fac01(k) + fac201 = fk21 * fac01(k) + fac011 = fk01 * fac11(k) + fac111 = fk11 * fac11(k) + fac211 = fk21 * fac11(k) + + do ig = 1, ng12 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + taug(ns12+ig,k) = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & + & + speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & + & + tauself + taufor + + fracs(ns12+ig,k) = fracrefa(ig,jpl) + fpl & + & *(fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + do ig = 1, ng12 + taug(ns12+ig,k) = f_zero + fracs(ns12+ig,k) = f_zero + enddo + enddo + +! .................................. + end subroutine taugb12 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 13: 2080-2250 cm-1 (low key-h2o,n2o; high minor-o3 minor) +! ---------------------------------- + subroutine taugb13 +! .................................. + +! ------------------------------------------------------------------ ! +! band 13: 2080-2250 cm-1 (low key-h2o,n2o; high minor-o3 minor) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb13 + +! --- locals: + integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & + & id000, id010, id100, id110, id200, id210, jmco2, jpl, & + & id001, id011, id101, id111, id201, id211, jmco2p, jplp, & + & jmco, jmcop, ig, js, js1 + + real (kind=kind_phys) :: tauself, taufor, co2m1, co2m2, absco2, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_mco2, specparm_mco2, specmult_mco2, fmco2, & + & speccomb_mco, specparm_mco, specmult_mco, fmco, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & refrat_planck_a, refrat_m_a, refrat_m_a3, ratco2, & + & adjfac, adjcolco2, com1, com2, absco, abso3, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21, temp +! +!===> ... begin here +! +! --- ... minor gas mapping levels : +! lower - co2, p = 1053.63 mb, t = 294.2 k +! lower - co, p = 706 mb, t = 278.94 k +! upper - o3, p = 95.5835 mb, t = 215.7 k + +! --- ... calculate reference ratio to be used in calculation of Planck +! fraction in lower/upper atmosphere. + + refrat_planck_a = chi_mls(1,5)/chi_mls(4,5) ! P = 473.420 mb (Level 5) + refrat_m_a = chi_mls(1,1)/chi_mls(4,1) ! P = 1053. (Level 1) + refrat_m_a3 = chi_mls(1,3)/chi_mls(4,3) ! P = 706. (Level 3) + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,3,1)*colamt(k,4) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(13) + js + + speccomb1 = colamt(k,1) + rfrate(k,3,2)*colamt(k,4) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(13) + js1 + + speccomb_mco2 = colamt(k,1) + refrat_m_a*colamt(k,4) + specparm_mco2 = colamt(k,1) / speccomb_mco2 + specmult_mco2 = 8.0 * min(specparm_mco2, oneminus) + jmco2 = 1 + int(specmult_mco2) + fmco2 = mod(specmult_mco2, f_one) + +! --- ... in atmospheres where the amount of co2 is too great to be considered +! a minor species, adjust the column amount of co2 by an empirical factor +! to obtain the proper contribution. + + speccomb_mco = colamt(k,1) + refrat_m_a3*colamt(k,4) + specparm_mco = colamt(k,1) / speccomb_mco + specmult_mco = 8.0 * min(specparm_mco, oneminus) + jmco = 1 + int(specmult_mco) + fmco = mod(specmult_mco, f_one) + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,4) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + jplp = jpl + 1 + jmco2p= jmco2+ 1 + jmcop = jmco + 1 + +! --- ... in atmospheres where the amount of co2 is too great to be considered +! a minor species, adjust the column amount of co2 by an empirical factor +! to obtain the proper contribution. + + temp = coldry(k) * 3.55e-4 + ratco2 = colamt(k,2) / temp + if (ratco2 > 3.0) then + adjfac = 2.0 + (ratco2-2.0)**0.68 + adjcolco2 = adjfac * temp + else + adjcolco2 = colamt(k,2) + endif + + if (specparm < 0.125) then + p0 = fs - f_one + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p0 = -fs + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk00 = f_one - fs + fk10 = fs + fk20 = f_zero + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk00 * fac00(k) + fac100 = fk10 * fac00(k) + fac200 = fk20 * fac00(k) + fac010 = fk00 * fac10(k) + fac110 = fk10 * fac10(k) + fac210 = fk20 * fac10(k) + + if (specparm1 < 0.125) then + p1 = fs1 - f_one + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p1 = -fs1 + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk01 = f_one - fs1 + fk11 = fs1 + fk21 = f_zero + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk01 * fac01(k) + fac101 = fk11 * fac01(k) + fac201 = fk21 * fac01(k) + fac011 = fk01 * fac11(k) + fac111 = fk11 * fac11(k) + fac211 = fk21 * fac11(k) + + do ig = 1, ng13 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + co2m1 = ka_mco2(ig,jmco2,indm) + fmco2 & + & * (ka_mco2(ig,jmco2p,indm) - ka_mco2(ig,jmco2,indm)) + co2m2 = ka_mco2(ig,jmco2,indmp) + fmco2 & + & * (ka_mco2(ig,jmco2p,indmp) - ka_mco2(ig,jmco2,indmp)) + absco2 = co2m1 + minorfrac(k) * (co2m2 - co2m1) + com1 = ka_mco(ig,jmco,indm) + fmco & + & * (ka_mco(ig,jmcop,indm) - ka_mco(ig,jmco,indm)) + com2 = ka_mco(ig,jmco,indmp) + fmco & + & * (ka_mco(ig,jmcop,indmp) - ka_mco(ig,jmco,indmp)) + absco = com1 + minorfrac(k) * (com2 - com1) + + taug(ns13+ig,k) = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & + & + speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & + & + tauself + taufor + adjcolco2*absco2 & + & + colamt(k,7)*absco + + fracs(ns13+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + indm = indminor(k) + indmp = indm + 1 + + do ig = 1, ng13 + abso3 = kb_mo3(ig,indm) + minorfrac(k) & + & * (kb_mo3(ig,indmp) - kb_mo3(ig,indm)) + + taug(ns13+ig,k) = colamt(k,3)*abso3 + + fracs(ns13+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb13 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 14: 2250-2380 cm-1 (low - co2; high - co2) +! ---------------------------------- + subroutine taugb14 +! .................................. + +! ------------------------------------------------------------------ ! +! band 14: 2250-2380 cm-1 (low - co2; high - co2) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb14 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & ig + + real (kind=kind_phys) :: tauself, taufor +! +!===> ... begin here +! +! --- ... lower atmosphere loop + + do k = 1, laytrop + ind0 = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(14) + 1 + ind1 = ( jp(k) *5 + (jt1(k)-1)) * nspa(14) + 1 + + inds = indself(k) + indf = indfor(k) + ind0p = ind0 + 1 + ind1p = ind1 + 1 + indsp = inds + 1 + indfp = indf + 1 + + do ig = 1, ng14 + tauself = selffac(k) * (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + taug(ns14+ig,k) = colamt(k,2) & + & * (fac00(k)*absa(ig,ind0) + fac10(k)*absa(ig,ind0p) & + & + fac01(k)*absa(ig,ind1) + fac11(k)*absa(ig,ind1p)) & + & + tauself + taufor + + fracs(ns14+ig,k) = fracrefa(ig) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(14) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(14) + 1 + + ind0p = ind0 + 1 + ind1p = ind1 + 1 + + do ig = 1, ng14 + taug(ns14+ig,k) = colamt(k,2) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) + + fracs(ns14+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb14 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) +!! (high - nothing) +! ---------------------------------- + subroutine taugb15 +! .................................. + +! ------------------------------------------------------------------ ! +! band 15: 2380-2600 cm-1 (low - n2o,co2; low minor - n2) ! +! (high - nothing) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb15 + +! --- locals: + integer :: k, ind0, ind1, inds, indsp, indf, indfp, indm, indmp, & + & id000, id010, id100, id110, id200, id210, jpl, jplp, & + & id001, id011, id101, id111, id201, id211, jmn2, jmn2p, & + & ig, js, js1 + + real (kind=kind_phys) :: scalen2, tauself, taufor, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_mn2, specparm_mn2, specmult_mn2, fmn2, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & refrat_planck_a, refrat_m_a, n2m1, n2m2, taun2, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 +! +!===> ... begin here +! +! --- ... minor gas mapping level : +! lower - nitrogen continuum, P = 1053., T = 294. + +! --- ... calculate reference ratio to be used in calculation of Planck +! fraction in lower atmosphere. + + refrat_planck_a = chi_mls(4,1)/chi_mls(2,1) ! P = 1053. mb (Level 1) + refrat_m_a = chi_mls(4,1)/chi_mls(2,1) ! P = 1053. mb + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,4) + rfrate(k,5,1)*colamt(k,2) + specparm = colamt(k,4) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(15) + js + + speccomb1 = colamt(k,4) + rfrate(k,5,2)*colamt(k,2) + specparm1 = colamt(k,4) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(15) + js1 + + speccomb_mn2 = colamt(k,4) + refrat_m_a*colamt(k,2) + specparm_mn2 = colamt(k,4) / speccomb_mn2 + specmult_mn2 = 8.0 * min(specparm_mn2, oneminus) + jmn2 = 1 + int(specmult_mn2) + fmn2 = mod(specmult_mn2, f_one) + + speccomb_planck = colamt(k,4) + refrat_planck_a*colamt(k,2) + specparm_planck = colamt(k,4) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + scalen2 = colbrd(k) * scaleminor(k) + + inds = indself(k) + indf = indfor(k) + indm = indminor(k) + indsp = inds + 1 + indfp = indf + 1 + indmp = indm + 1 + jplp = jpl + 1 + jmn2p = jmn2 + 1 + + if (specparm < 0.125) then + p0 = fs - f_one + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p0 = -fs + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk00 = f_one - fs + fk10 = fs + fk20 = f_zero + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk00 * fac00(k) + fac100 = fk10 * fac00(k) + fac200 = fk20 * fac00(k) + fac010 = fk00 * fac10(k) + fac110 = fk10 * fac10(k) + fac210 = fk20 * fac10(k) + + if (specparm1 < 0.125) then + p1 = fs1 - f_one + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p1 = -fs1 + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk01 = f_one - fs1 + fk11 = fs1 + fk21 = f_zero + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk01 * fac01(k) + fac101 = fk11 * fac01(k) + fac201 = fk21 * fac01(k) + fac011 = fk01 * fac11(k) + fac111 = fk11 * fac11(k) + fac211 = fk21 * fac11(k) + + do ig = 1, ng15 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + n2m1 = ka_mn2(ig,jmn2,indm) + fmn2 & + & * (ka_mn2(ig,jmn2p,indm) - ka_mn2(ig,jmn2,indm)) + n2m2 = ka_mn2(ig,jmn2,indmp) + fmn2 & + & * (ka_mn2(ig,jmn2p,indmp) - ka_mn2(ig,jmn2,indmp)) + taun2 = scalen2 * (n2m1 + minorfrac(k) * (n2m2 - n2m1)) + + taug(ns15+ig,k) = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & + & + speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & + & + tauself + taufor + taun2 + + fracs(ns15+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + do ig = 1, ng15 + taug(ns15+ig,k) = f_zero + + fracs(ns15+ig,k) = f_zero + enddo + enddo + +! .................................. + end subroutine taugb15 +! ---------------------------------- + +!>\ingroup module_radlw_main +!> Band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) +! ---------------------------------- + subroutine taugb16 +! .................................. + +! ------------------------------------------------------------------ ! +! band 16: 2600-3250 cm-1 (low key- h2o,ch4; high key - ch4) ! +! ------------------------------------------------------------------ ! + + use module_radlw_kgb16 + +! --- locals: + integer :: k, ind0, ind0p, ind1, ind1p, inds, indsp, indf, indfp, & + & id000, id010, id100, id110, id200, id210, jpl, jplp, & + & id001, id011, id101, id111, id201, id211, ig, js, js1 + + real (kind=kind_phys) :: tauself, taufor, refrat_planck_a, & + & speccomb, specparm, specmult, fs, & + & speccomb1, specparm1, specmult1, fs1, & + & speccomb_planck,specparm_planck,specmult_planck,fpl, & + & fac000, fac100, fac200, fac010, fac110, fac210, & + & fac001, fac101, fac201, fac011, fac111, fac211, & + & p0, p40, fk00, fk10, fk20, p1, p41, fk01, fk11, fk21 +! +!===> ... begin here +! +! --- ... calculate reference ratio to be used in calculation of Planck +! fraction in lower atmosphere. + + refrat_planck_a = chi_mls(1,6)/chi_mls(6,6) ! P = 387. mb (Level 6) + +! --- ... lower atmosphere loop + + do k = 1, laytrop + speccomb = colamt(k,1) + rfrate(k,4,1)*colamt(k,5) + specparm = colamt(k,1) / speccomb + specmult = 8.0 * min(specparm, oneminus) + js = 1 + int(specmult) + fs = mod(specmult, f_one) + ind0 = ((jp(k)-1)*5 + (jt(k)-1)) * nspa(16) + js + + speccomb1 = colamt(k,1) + rfrate(k,4,2)*colamt(k,5) + specparm1 = colamt(k,1) / speccomb1 + specmult1 = 8.0 * min(specparm1, oneminus) + js1 = 1 + int(specmult1) + fs1 = mod(specmult1, f_one) + ind1 = (jp(k)*5 + (jt1(k)-1)) * nspa(16) + js1 + + speccomb_planck = colamt(k,1) + refrat_planck_a*colamt(k,5) + specparm_planck = colamt(k,1) / speccomb_planck + specmult_planck = 8.0 * min(specparm_planck, oneminus) + jpl = 1 + int(specmult_planck) + fpl = mod(specmult_planck, f_one) + + inds = indself(k) + indf = indfor(k) + indsp = inds + 1 + indfp = indf + 1 + jplp = jpl + 1 + + if (specparm < 0.125) then + p0 = fs - f_one + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + 2 + id210 = ind0 +11 + elseif (specparm > 0.875) then + p0 = -fs + p40 = p0**4 + fk00 = p40 + fk10 = f_one - p0 - 2.0*p40 + fk20 = p0 + p40 + + id000 = ind0 + 1 + id010 = ind0 +10 + id100 = ind0 + id110 = ind0 + 9 + id200 = ind0 - 1 + id210 = ind0 + 8 + else + fk00 = f_one - fs + fk10 = fs + fk20 = f_zero + + id000 = ind0 + id010 = ind0 + 9 + id100 = ind0 + 1 + id110 = ind0 +10 + id200 = ind0 + id210 = ind0 + endif + + fac000 = fk00 * fac00(k) + fac100 = fk10 * fac00(k) + fac200 = fk20 * fac00(k) + fac010 = fk00 * fac10(k) + fac110 = fk10 * fac10(k) + fac210 = fk20 * fac10(k) + + if (specparm1 < 0.125) then + p1 = fs1 - f_one + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + 2 + id211 = ind1 +11 + elseif (specparm1 > 0.875) then + p1 = -fs1 + p41 = p1**4 + fk01 = p41 + fk11 = f_one - p1 - 2.0*p41 + fk21 = p1 + p41 + + id001 = ind1 + 1 + id011 = ind1 +10 + id101 = ind1 + id111 = ind1 + 9 + id201 = ind1 - 1 + id211 = ind1 + 8 + else + fk01 = f_one - fs1 + fk11 = fs1 + fk21 = f_zero + + id001 = ind1 + id011 = ind1 + 9 + id101 = ind1 + 1 + id111 = ind1 +10 + id201 = ind1 + id211 = ind1 + endif + + fac001 = fk01 * fac01(k) + fac101 = fk11 * fac01(k) + fac201 = fk21 * fac01(k) + fac011 = fk01 * fac11(k) + fac111 = fk11 * fac11(k) + fac211 = fk21 * fac11(k) + + do ig = 1, ng16 + tauself = selffac(k)* (selfref(ig,inds) + selffrac(k) & + & * (selfref(ig,indsp) - selfref(ig,inds))) + taufor = forfac(k) * (forref(ig,indf) + forfrac(k) & + & * (forref(ig,indfp) - forref(ig,indf))) + + taug(ns16+ig,k) = speccomb & + & * (fac000*absa(ig,id000) + fac010*absa(ig,id010) & + & + fac100*absa(ig,id100) + fac110*absa(ig,id110) & + & + fac200*absa(ig,id200) + fac210*absa(ig,id210)) & + & + speccomb1 & + & * (fac001*absa(ig,id001) + fac011*absa(ig,id011) & + & + fac101*absa(ig,id101) + fac111*absa(ig,id111) & + & + fac201*absa(ig,id201) + fac211*absa(ig,id211)) & + & + tauself + taufor + + fracs(ns16+ig,k) = fracrefa(ig,jpl) + fpl & + & * (fracrefa(ig,jplp) - fracrefa(ig,jpl)) + enddo + enddo + +! --- ... upper atmosphere loop + + do k = laytrop+1, nlay + ind0 = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(16) + 1 + ind1 = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(16) + 1 + + ind0p = ind0 + 1 + ind1p = ind1 + 1 + + do ig = 1, ng16 + taug(ns16+ig,k) = colamt(k,5) & + & * (fac00(k)*absb(ig,ind0) + fac10(k)*absb(ig,ind0p) & + & + fac01(k)*absb(ig,ind1) + fac11(k)*absb(ig,ind1p)) + + fracs(ns16+ig,k) = fracrefb(ig) + enddo + enddo + +! .................................. + end subroutine taugb16 +! ---------------------------------- + +! .................................. + end subroutine taumol +!! @} +!----------------------------------- + +!mz* exponential cloud overlapping subroutines +!------------------------------------------------------------------ +! Public subroutines +!------------------------------------------------------------------ +! mz* - Add height needed for exponential and exponential-random cloud overlap methods (icld=4 and 5, respectively) + subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, & + & irng, play, hgt, & + & cldfrac, ciwp, clwp, cswp, rei, rel, res, tauc, & + & cldfmcl, & + & ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, & + & resnmcl, taucmcl) + + use machine, only : im => kind_io4, rb => kind_phys +! ----- Input ----- +! Control + integer(kind=im), intent(in) :: iplon ! column/longitude index + integer(kind=im), intent(in) :: ncol ! number of columns + integer(kind=im), intent(in) :: nlay ! number of model layers + integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag + integer(kind=im), intent(in) :: permuteseed ! if the cloud generator is called multiple times, + ! permute the seed between each call. + ! between calls for LW and SW, recommended + ! permuteseed differes by 'ngpt' + integer(kind=im), intent(inout) :: irng ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne + ! Twister + +! Atmosphere + real(kind=rb), intent(in) :: play(:,:) ! layer pressures (mb) + ! Dimensions: (ncol,nlay) + +! mji - Add height + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) + +! Atmosphere/clouds - cldprop + real(kind=rb), intent(in) :: cldfrac(:,:) ! layer cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth + ! Dimensions: (nbndlw,ncol,nlay) +! real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo + ! Dimensions: (nbndlw,ncol,nlay) +! real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter + ! Dimensions: (nbndlw,ncol,nlay) + real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: rei(:,:) ! cloud ice particle size + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: rel(:,:) ! cloud liquid particle size + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: res(:,:) ! snow particle size + ! Dimensions: (ncol,nlay) + +! ----- Output ----- +! Atmosphere/clouds - cldprmc [mcica] + real(kind=rb), intent(out) :: cldfmcl(:,:,:) ! cloud fraction [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: ciwpmcl(:,:,:) ! in-cloud ice water path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: clwpmcl(:,:,:) ! in-cloud liquid water path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: cswpmcl(:,:,:) ! in-cloud snow path [mcica] + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: relqmcl(:,:) ! liquid particle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: reicmcl(:,:) ! ice partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: resnmcl(:,:) ! snow partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: taucmcl(:,:,:) ! in-cloud optical depth [mcica] +!mz* + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(out) :: ssacmcl(:,:,:) ! in-cloud single scattering albedo [mcica] + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(out) :: asmcmcl(:,:,:) ! in-cloud asymmetry parameter [mcica] + ! Dimensions: (ngptlw,ncol,nlay) +! ----- Local ----- + +! Stochastic cloud generator variables [mcica] + integer(kind=im), parameter :: nsubclw = ngptlw ! number of sub-columns (g-point intervals) + integer(kind=im) :: ilev ! loop index + + real(kind=rb) :: pmid(ncol, nlay) ! layer pressures (Pa) +! real(kind=rb) :: pdel(ncol, nlay) ! layer pressure thickness (Pa) +! real(kind=rb) :: qi(ncol, nlay) ! ice water (specific humidity) +! real(kind=rb) :: ql(ncol, nlay) ! liq water (specific humidity) + +! Return if clear sky + if (icld.eq.0) return + +! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at least the number of subcolumns + + +! Pass particle sizes to new arrays, no subcolumns for these properties yet +! Convert pressures from mb to Pa + + reicmcl(:ncol,:nlay) = rei(:ncol,:nlay) + relqmcl(:ncol,:nlay) = rel(:ncol,:nlay) + resnmcl(:ncol,:nlay) = res(:ncol,:nlay) + pmid(:ncol,:nlay) = play(:ncol,:nlay)*1.e2_rb + +! Generate the stochastic subcolumns of cloud optical properties for +! the longwave + call generate_stochastic_clouds (ncol, nlay, nsubclw, icld, irng, & + & pmid, hgt, cldfrac, clwp, ciwp, cswp, tauc, & + & cldfmcl, clwpmcl, ciwpmcl, cswpmcl, & + & taucmcl, permuteseed) + + end subroutine mcica_subcol_lw +!------------------------------------------------------------------------------------------------- + subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, & + & irng, pmid, hgt, cld, clwp, ciwp, cswp, tauc, & + & cld_stoch, clwp_stoch, ciwp_stoch, & + & cswp_stoch, tauc_stoch, changeSeed) +!------------------------------------------------------------------------------------------------- +!------------------------------------------------------------------------------------------------- +! Contact: Cecile Hannay (hannay@ucar.edu) +! +! Original code: Based on Raisanen et al., QJRMS, 2004. +! +! Modifications: +! 1) Generalized for use with RRTMG and added Mersenne Twister as the default +! random number generator, which can be changed to the optional kissvec random number generator +! with flag 'irng'. Some extra functionality has been commented or removed. +! Michael J. Iacono, AER, Inc., February 2007 +! 2) Activated exponential and exponential/random cloud overlap method +! Michael J. Iacono, AER, November 2017 +! +! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns. +! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one +! and uniform cloud liquid and cloud ice concentration. +! The ensemble as a whole reproduces the probability function of cloud liquid and ice within each layer +! and obeys an overlap assumption in the vertical. +! +! Overlap assumption: +! The cloud are consistent with 5 overlap assumptions: random, maximum, maximum-random, exponential and exponential random. +! The default option is maximum-random (option 2) +! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap, 5=exp/random +! This is set with the variable "overlap" +! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) +! +! Seed: +! If the stochastic cloud generator is called several times during the same timestep, +! one should change the seed between the call to insure that the +! subcolumns are different. +! This is done by changing the argument 'changeSeed' +! For example, if one wants to create a set of columns for the +! shortwave and another set for the longwave , +! use 'changeSeed = 1' for the first call and'changeSeed = 2' for the second call + +! PDF assumption: +! We can use arbitrary complicated PDFS. +! In the present version, we produce homogeneuous clouds (the simplest case). +! Future developments include using the PDF scheme of Ben Johnson. +! +! History file: +! Option to add diagnostics variables in the history file. (using FINCL in the namelist) +! nsubcol = number of subcolumns +! overlap = overlap type (1-3) +! Zo = length scale +! CLOUD_S = mean of the subcolumn cloud fraction ('_S" means Stochastic) +! CLDLIQ_S = mean of the subcolumn cloud water +! CLDICE_S = mean of the subcolumn cloud ice +! +! Note: +! Here: we force that the cloud condensate to be consistent with the cloud fraction +! i.e we only have cloud condensate when the cell is cloudy. +! In CAM: The cloud condensate and the cloud fraction are obtained from 2 different equations +! and the 2 quantities can be inconsistent (i.e. CAM can produce cloud fraction +! without cloud condensate or the opposite). +!----------------------------------------------------------------- + + use mcica_random_numbers +! The Mersenne Twister random number engine + use MersenneTwister, only: randomNumberSequence, & + & new_RandomNumberSequence, getRandomReal + use machine ,only : im => kind_io4, rb => kind_phys + + type(randomNumberSequence) :: randomNumbers + +! -- Arguments + + integer(kind=im), intent(in) :: ncol ! number of columns + integer(kind=im), intent(in) :: nlay ! number of layers + integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag + integer(kind=im), intent(inout) :: irng ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne Twister + integer(kind=im), intent(in) :: nsubcol ! number of sub-columns (g-point intervals) + integer(kind=im), optional, intent(in) :: changeSeed ! allows permuting seed + +! Column state (cloud fraction, cloud water, cloud ice) + variables needed to read physics state + real(kind=rb), intent(in) :: pmid(:,:) ! layer pressure (Pa) + ! Dimensions: (ncol,nlay) + + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cld(:,:) ! cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth + ! Dimensions:(nbndlw,ncol,nlay) +! real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo + ! Dimensions: (nbndlw,ncol,nlay) + ! inactive - for future expansion +! real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter + ! Dimensions: (nbndlw,ncol,nlay) + ! inactive - for future expansion + + real(kind=rb), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: clwp_stoch(:,:,:) ! subcolumn in-cloud liquid water path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: ciwp_stoch(:,:,:) ! subcolumn in-cloud ice water path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: cswp_stoch(:,:,:) ! subcolumn in-cloud snow path + ! Dimensions: (ngptlw,ncol,nlay) + real(kind=rb), intent(out) :: tauc_stoch(:,:,:) ! subcolumn in-cloud optical depth + ! Dimensions: (ngptlw,ncol,nlay) +! real(kind=rb), intent(out) :: ssac_stoch(:,:,:)! subcolumn in-cloud single scattering albedo + ! Dimensions: (ngptlw,ncol,nlay) + ! inactive - for future expansion +! real(kind=rb), intent(out) :: asmc_stoch(:,:,:)! subcolumn in-cloud asymmetry parameter + ! Dimensions: (ngptlw,ncol,nlay) + ! inactive - for future expansion + +! -- Local variables + real(kind=rb) :: cldf(ncol,nlay) ! cloud fraction + +! Mean over the subcolumns (cloud fraction, cloud water , cloud ice) - inactive +! real(kind=rb) :: mean_cld_stoch(ncol, nlay) ! cloud fraction +! real(kind=rb) :: mean_clwp_stoch(ncol, nlay) ! cloud water +! real(kind=rb) :: mean_ciwp_stoch(ncol, nlay) ! cloud ice +! real(kind=rb) :: mean_tauc_stoch(ncol, nlay) ! cloud optical depth +! real(kind=rb) :: mean_ssac_stoch(ncol, nlay) ! cloud single scattering albedo +! real(kind=rb) :: mean_asmc_stoch(ncol, nlay) ! cloud asymmetry parameter + +! Set overlap + integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum-random, + ! 3 = maximum overlap, 4 = exponential, + ! 5 = exponential-random + real(kind=rb), parameter :: Zo = 2500._rb ! length scale (m) + real(kind=rb), dimension(ncol,nlay) :: alpha ! overlap parameter + +! Constants (min value for cloud fraction and cloud water and ice) + real(kind=rb), parameter :: cldmin = 1.0e-20_rb ! min cloud fraction +! real(kind=rb), parameter :: qmin = 1.0e-10_rb ! min cloud water and cloud ice (not used) + +! Variables related to random number and seed + real(kind=rb), dimension(nsubcol, ncol, nlay) :: CDF, CDF2 !random numbers + integer(kind=im), dimension(ncol) :: seed1, seed2, seed3, seed4 !seed to create random number (kissvec) + real(kind=rb), dimension(ncol) :: rand_num ! random number (kissvec) + integer(kind=im) :: iseed ! seed to create random number (Mersenne Teister) + real(kind=rb) :: rand_num_mt ! random number (Mersenne Twister) + +! Flag to identify cloud fraction in subcolumns + logical, dimension(nsubcol, ncol, nlay) :: iscloudy ! flag that says whether a gridbox is cloudy + +! Indices + integer(kind=im) :: ilev, isubcol, i, n ! indices + +!------------------------------------------------------------------- + +! Check that irng is in bounds; if not, set to default + if (irng .ne. 0) irng = 1 + +! Pass input cloud overlap setting to local variable + overlap = icld + +! Ensure that cloud fractions are in bounds + do ilev = 1, nlay + do i = 1, ncol + cldf(i,ilev) = cld(i,ilev) + if (cldf(i,ilev) < cldmin) then + cldf(i,ilev) = 0._rb + endif + enddo + enddo + +! ----- Create seed -------- + +! Advance randum number generator by changeseed values + if (irng.eq.0) then +! For kissvec, create a seed that depends on the state of the columns. Maybe not the best way, but it works. +! Must use pmid from bottom four layers. + do i=1,ncol + if (pmid(i,1).lt.pmid(i,2)) then + stop 'MCICA_SUBCOL: KISSVEC SEED GENERATOR REQUIRES PMID & + & FROM BOTTOM FOUR LAYERS.' + endif + seed1(i) = (pmid(i,1) - int(pmid(i,1))) * 1000000000_im + seed2(i) = (pmid(i,2) - int(pmid(i,2))) * 1000000000_im + seed3(i) = (pmid(i,3) - int(pmid(i,3))) * 1000000000_im + seed4(i) = (pmid(i,4) - int(pmid(i,4))) * 1000000000_im + enddo + do i=1,changeSeed + call kissvec(seed1, seed2, seed3, seed4, rand_num) + enddo + elseif (irng.eq.1) then + randomNumbers = new_RandomNumberSequence(seed = changeSeed) + endif + +! ------ Apply overlap assumption -------- + +! generate the random numbers + + select case (overlap) + + case(1) +! Random overlap +! i) pick a random value at every level + + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) ! we get different random number for each level + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + case(2) +! Maximum-Random overlap +! i) pick a random number for top layer. +! ii) walk down the column: +! - if the layer above is cloudy, we use the same random number than in the layer above +! - if the layer above is clear, we use a new random number + + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + do ilev = 2,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (CDF(isubcol, i, ilev-1) > 1._rb - cldf(i,ilev-1) )& + & then + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev-1) + else + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev) * (1._rb & + & - cldf(i,ilev-1)) + endif + enddo + enddo + enddo + + case(3) +! Maximum overlap +! i) pick the same random numebr at every level + + if (irng.eq.0) then + do isubcol = 1,nsubcol + call kissvec(seed1, seed2, seed3, seed4, rand_num) + do ilev = 1,nlay + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + rand_num_mt = getRandomReal(randomNumbers) + do ilev = 1, nlay + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + +! mji - Activate exponential cloud overlap option + case(4) + ! Exponential overlap: weighting between maximum and random overlap increases with the distance. + ! The random numbers for exponential overlap verify: + ! j=1 RAN(j)=RND1 + ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) + ! RAN(j) = RND2 + ! alpha is obtained from the equation + ! alpha = exp(-(Z(j)-Z(j-1))/Zo) where Zo is a characteristic length scale + + ! compute alpha + do i = 1, ncol + alpha(i, 1) = 0._rb + do ilev = 2,nlay + alpha(i, ilev) = exp( -( hgt (i, ilev) - & + & hgt (i, ilev-1)) / Zo) + enddo + enddo + + ! generate 2 streams of random numbers + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol, :, ilev) = rand_num + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF2(isubcol, :, ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + rand_num_mt = getRandomReal(randomNumbers) + CDF2(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + ! generate random numbers + do ilev = 2,nlay + where (CDF2(:, :, ilev) < spread(alpha (:,ilev), & + & dim=1,nCopies=nsubcol) ) + CDF(:,:,ilev) = CDF(:,:,ilev-1) + end where + end do + +! Activate exponential-random cloud overlap option + case(5) + ! Exponential-random overlap: +!mz* call wrf_error_fatal("Cloud Overlap case 5: ER has not yet & +! been implemented. Stopping...") + + end select + +! -- generate subcolumns for homogeneous clouds ----- + do ilev = 1,nlay + iscloudy(:,:,ilev) = (CDF(:,:,ilev) >= 1._rb - & + & spread(cldf(:,ilev), dim=1, nCopies=nsubcol) ) + enddo + +! where the subcolumn is cloudy, the subcolumn cloud fraction is 1; +! where the subcolumn is not cloudy, the subcolumn cloud fraction is 0; +! where there is a cloud, define the subcolumn cloud properties, +! otherwise set these to zero + + do ilev = 1,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (iscloudy(isubcol,i,ilev) ) then + cld_stoch(isubcol,i,ilev) = 1._rb + clwp_stoch(isubcol,i,ilev) = clwp(i,ilev) + ciwp_stoch(isubcol,i,ilev) = ciwp(i,ilev) +!mz +! cswp_stoch(isubcol,i,ilev) = cswp(i,ilev) + cswp_stoch(isubcol,i,ilev) = 0._rb + n = ngb(isubcol) + tauc_stoch(isubcol,i,ilev) = tauc(n,i,ilev) +! ssac_stoch(isubcol,i,ilev) = ssac(n,i,ilev) +! asmc_stoch(isubcol,i,ilev) = asmc(n,i,ilev) + else + cld_stoch(isubcol,i,ilev) = 0._rb + clwp_stoch(isubcol,i,ilev) = 0._rb + ciwp_stoch(isubcol,i,ilev) = 0._rb + cswp_stoch(isubcol,i,ilev) = 0._rb + tauc_stoch(isubcol,i,ilev) = 0._rb +! ssac_stoch(isubcol,i,ilev) = 1._rb +! asmc_stoch(isubcol,i,ilev) = 1._rb + endif + enddo + enddo + enddo + +! -- compute the means of the subcolumns --- +! mean_cld_stoch(:,:) = 0._rb +! mean_clwp_stoch(:,:) = 0._rb +! mean_ciwp_stoch(:,:) = 0._rb +! mean_tauc_stoch(:,:) = 0._rb +! mean_ssac_stoch(:,:) = 0._rb +! mean_asmc_stoch(:,:) = 0._rb +! do i = 1, nsubcol +! mean_cld_stoch(:,:) = cld_stoch(i,:,:) + mean_cld_stoch(:,:) +! mean_clwp_stoch(:,:) = clwp_stoch( i,:,:) + mean_clwp_stoch(:,:) +! mean_ciwp_stoch(:,:) = ciwp_stoch( i,:,:) + mean_ciwp_stoch(:,:) +! mean_tauc_stoch(:,:) = tauc_stoch( i,:,:) + mean_tauc_stoch(:,:) +! mean_ssac_stoch(:,:) = ssac_stoch( i,:,:) + mean_ssac_stoch(:,:) +! mean_asmc_stoch(:,:) = asmc_stoch( i,:,:) + mean_asmc_stoch(:,:) +! end do +! mean_cld_stoch(:,:) = mean_cld_stoch(:,:) / nsubcol +! mean_clwp_stoch(:,:) = mean_clwp_stoch(:,:) / nsubcol +! mean_ciwp_stoch(:,:) = mean_ciwp_stoch(:,:) / nsubcol +! mean_tauc_stoch(:,:) = mean_tauc_stoch(:,:) / nsubcol +! mean_ssac_stoch(:,:) = mean_ssac_stoch(:,:) / nsubcol +! mean_asmc_stoch(:,:) = mean_asmc_stoch(:,:) / nsubcol + + end subroutine generate_stochastic_clouds + +!------------------------------------------------------------------ +! Private subroutines +!------------------------------------------------------------------ + +!----------------------------------------------------------------- + subroutine kissvec(seed1,seed2,seed3,seed4,ran_arr) +!---------------------------------------------------------------- + +! public domain code +! made available from http://www.fortran.com/ +! downloaded by pjr on 03/16/04 for NCAR CAM +! converted to vector form, functions inlined by pjr,mvr on 05/10/2004 + +! The KISS (Keep It Simple Stupid) random number generator. Combines: +! (1) The congruential generator x(n)=69069*x(n-1)+1327217885, period 2^32. +! (2) A 3-shift shift-register generator, period 2^32-1, +! (3) Two 16-bit multiply-with-carry generators, period 597273182964842497>2^59 +! Overall period>2^123; + real(kind=rb), dimension(:), intent(inout) :: ran_arr + integer(kind=im), dimension(:), intent(inout) :: seed1,seed2,seed3& + & ,seed4 + integer(kind=im) :: i,sz,kiss + integer(kind=im) :: m, k, n + +! inline function + m(k, n) = ieor (k, ishft (k, n) ) + + sz = size(ran_arr) + do i = 1, sz + seed1(i) = 69069_im * seed1(i) + 1327217885_im + seed2(i) = m (m (m (seed2(i), 13_im), - 17_im), 5_im) + seed3(i) = 18000_im * iand (seed3(i), 65535_im) + & + & ishft (seed3(i), - 16_im) + seed4(i) = 30903_im * iand (seed4(i), 65535_im) + & + & ishft (seed4(i), - 16_im) + kiss = seed1(i) + seed2(i) + ishft (seed3(i), 16_im) + seed4(i) + ran_arr(i) = kiss*2.328306e-10_rb + 0.5_rb + end do + + end subroutine kissvec +! + subroutine rtrnmc_mcica(nlayers, istart, iend, iout, pz, semiss, & + & ncbands, cldfmc, taucmc, planklay, planklev, &!plankbnd, & + & pwvcm, fracs, taut, & + & totuflux, totdflux, htr, & + & totuclfl, totdclfl, htrc ) +!--------------------------------------------------------------- +! +! Original version: E. J. Mlawer, et al. RRTM_V3.0 +! Revision for GCMs: Michael J. Iacono; October, 2002 +! Revision for F90: Michael J. Iacono; June, 2006 +! +! This program calculates the upward fluxes, downward fluxes, and +! heating rates for an arbitrary clear or cloudy atmosphere. The input +! to this program is the atmospheric profile, all Planck function +! information, and the cloud fraction by layer. A variable diffusivity +! angle (SECDIFF) is used for the angle integration. Bands 2-3 and 5-9 +! use a value for SECDIFF that varies from 1.50 to 1.80 as a function of +! the column water vapor, and other bands use a value of 1.66. The Gaussian +! weight appropriate to this angle (WTDIFF=0.5) is applied here. Note that +! use of the emissivity angle for the flux integration can cause errors of +! 1 to 4 W/m2 within cloudy layers. +! Clouds are treated with the McICA stochastic approach and maximum-random +! cloud overlap. +!*************************************************************************** + +! ------- Declarations ------- + +! ----- Input ----- + integer(kind=im), intent(in) :: nlayers ! total number of layers + integer(kind=im), intent(in) :: istart ! beginning band of calculation + integer(kind=im), intent(in) :: iend ! ending band of calculation + integer(kind=im), intent(in) :: iout ! output option flag + +! Atmosphere + real(kind=rb), intent(in) :: pz(0:) ! level (interface) pressures (hPa, mb) + ! Dimensions: (0:nlayers) + real(kind=rb), intent(in) :: pwvcm ! precipitable water vapor (cm) + real(kind=rb), intent(in) :: semiss(:) ! lw surface emissivity + ! Dimensions: (nbndlw) +!mz + real(kind=rb), intent(in) :: planklay(0:,:) ! + ! Dimensions: (nlayers,nbndlw) + real(kind=rb), intent(in) :: planklev(0:,:) ! + ! Dimensions: (0:nlayers,nbndlw) +! real(kind=rb), intent(in) :: plankbnd(:) ! + ! Dimensions: (nbndlw) + real(kind=rb), intent(in) :: fracs(:,:) ! + ! Dimensions: (nlayers,ngptw) + real(kind=rb), intent(in) :: taut(:,:) ! gaseous + aerosol optical depths + ! Dimensions: (nlayers,ngptlw) + +! Clouds + integer(kind=im), intent(in) :: ncbands ! number of cloud spectral bands + real(kind=rb), intent(in) :: cldfmc(:,:) ! layer cloud fraction [mcica] + ! Dimensions: (ngptlw,nlayers) + real(kind=rb), intent(in) :: taucmc(:,:) ! layer cloud optical depth [mcica] + ! Dimensions: (ngptlw,nlayers) + +! ----- Output ----- + real(kind=rb), intent(out) :: totuflux(0:) ! upward longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=rb), intent(out) :: totdflux(0:) ! downward longwave flux (w/m2) + ! Dimensions: (0:nlayers) +!mz* real(kind=rb), intent(out) :: fnet(0:) ! net longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=rb), intent(out) :: htr(:) +!mz real(kind=rb), intent(out) :: htr(0:) ! longwave heating rate (k/day) + ! Dimensions: (0:nlayers) + real(kind=rb), intent(out) :: totuclfl(0:) ! clear sky upward longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=rb), intent(out) :: totdclfl(0:) ! clear sky downward longwave flux (w/m2) + ! Dimensions: (0:nlayers) +!mz*real(kind=rb), intent(out) :: fnetc(0:) ! clear sky net longwave flux (w/m2) + ! Dimensions: (0:nlayers) + real(kind=rb), intent(out) :: htrc(:) +! real(kind=rb), intent(out) :: htrc(0:) ! clear sky longwave heating rate (k/day) + ! Dimensions: (0:nlayers) + +! ----- Local ----- +! Declarations for radiative transfer + real (kind=kind_phys), dimension(0:nlayers) :: fnet, fnetc + real(kind=rb) :: abscld(nlayers,ngptlw) + real(kind=rb) :: atot(nlayers) + real(kind=rb) :: atrans(nlayers) + real(kind=rb) :: bbugas(nlayers) + real(kind=rb) :: bbutot(nlayers) + real(kind=rb) :: clrurad(0:nlayers) + real(kind=rb) :: clrdrad(0:nlayers) + real(kind=rb) :: efclfrac(nlayers,ngptlw) + real(kind=rb) :: uflux(0:nlayers) + real(kind=rb) :: dflux(0:nlayers) + real(kind=rb) :: urad(0:nlayers) + real(kind=rb) :: drad(0:nlayers) + real(kind=rb) :: uclfl(0:nlayers) + real(kind=rb) :: dclfl(0:nlayers) + real(kind=rb) :: odcld(nlayers,ngptlw) + + + real(kind=rb) :: secdiff(nbands) ! secant of diffusivity angle + real(kind=rb) :: transcld, radld, radclrd, plfrac, blay, dplankup,& + & dplankdn + real(kind=rb) :: odepth, odtot, odepth_rec, odtot_rec, gassrc + real(kind=rb) :: tblind, tfactot, bbd, bbdtot, tfacgas, transc, & + & tausfac + real(kind=rb) :: rad0, reflect, radlu, radclru + + integer(kind=im) :: icldlyr(nlayers) ! flag for cloud in layer + integer(kind=im) :: ibnd, ib, iband, lay, lev, l, ig ! loop indices + integer(kind=im) :: igc ! g-point interval counter + integer(kind=im) :: iclddn ! flag for cloud in down path + integer(kind=im) :: ittot, itgas, itr ! lookup table indices +!mz* + real (kind=kind_phys), parameter :: rec_6 = 0.166667 + ! The cumulative sum of new g-points for each band + integer(kind=im) :: ngs(nbands) + ngs(:) = (/10,22,38,52,68,76,88,96,108,114,122,130,134,136,138, & + & 140/) + +! ------- Definitions ------- +! input +! nlayers ! number of model layers +! ngptlw ! total number of g-point subintervals +! nbndlw ! number of longwave spectral bands +! ncbands ! number of spectral bands for clouds +! secdiff ! diffusivity angle +! wtdiff ! weight for radiance to flux conversion +! pavel ! layer pressures (mb) +! pz ! level (interface) pressures (mb) +! tavel ! layer temperatures (k) +! tz ! level (interface) temperatures(mb) +! tbound ! surface temperature (k) +! cldfrac ! layer cloud fraction +! taucloud ! layer cloud optical depth +! itr ! integer look-up table index +! icldlyr ! flag for cloudy layers +! iclddn ! flag for cloud in column at any layer +! semiss ! surface emissivities for each band +! reflect ! surface reflectance +! bpade ! 1/(pade constant) +! tau_tbl ! clear sky optical depth look-up table +! exp_tbl ! exponential look-up table for transmittance +! tfn_tbl ! tau transition function look-up table + +! local +! atrans ! gaseous absorptivity +! abscld ! cloud absorptivity +! atot ! combined gaseous and cloud absorptivity +! odclr ! clear sky (gaseous) optical depth +! odcld ! cloud optical depth +! odtot ! optical depth of gas and cloud +! tfacgas ! gas-only pade factor, used for planck fn +! tfactot ! gas and cloud pade factor, used for planck fn +! bbdgas ! gas-only planck function for downward rt +! bbugas ! gas-only planck function for upward rt +! bbdtot ! gas and cloud planck function for downward rt +! bbutot ! gas and cloud planck function for upward calc. +! gassrc ! source radiance due to gas only +! efclfrac ! effective cloud fraction +! radlu ! spectrally summed upward radiance +! radclru ! spectrally summed clear sky upward radiance +! urad ! upward radiance by layer +! clrurad ! clear sky upward radiance by layer +! radld ! spectrally summed downward radiance +! radclrd ! spectrally summed clear sky downward radiance +! drad ! downward radiance by layer +! clrdrad ! clear sky downward radiance by layer + + +! output +! totuflux ! upward longwave flux (w/m2) +! totdflux ! downward longwave flux (w/m2) +! fnet ! net longwave flux (w/m2) +! htr ! longwave heating rate (k/day) +! totuclfl ! clear sky upward longwave flux (w/m2) +! totdclfl ! clear sky downward longwave flux (w/m2) +! fnetc ! clear sky net longwave flux (w/m2) +! htrc ! clear sky longwave heating rate (k/day) + + +!jm not thread safe hvrrtc = '$Revision: 1.3 $' + + do ibnd = 1,nbands!mz*nbndlw + if (ibnd.eq.1 .or. ibnd.eq.4 .or. ibnd.ge.10) then + secdiff(ibnd) = 1.66_rb + else + secdiff(ibnd) = a0(ibnd) + a1(ibnd)*exp(a2(ibnd)*pwvcm) + if (secdiff(ibnd) .gt. 1.80_rb) secdiff(ibnd) = 1.80_rb + if (secdiff(ibnd) .lt. 1.50_rb) secdiff(ibnd) = 1.50_rb + endif + enddo + + urad(0) = 0.0_rb + drad(0) = 0.0_rb + totuflux(0) = 0.0_rb + totdflux(0) = 0.0_rb + clrurad(0) = 0.0_rb + clrdrad(0) = 0.0_rb + totuclfl(0) = 0.0_rb + totdclfl(0) = 0.0_rb + + do lay = 1, nlayers + urad(lay) = 0.0_rb + drad(lay) = 0.0_rb + totuflux(lay) = 0.0_rb + totdflux(lay) = 0.0_rb + clrurad(lay) = 0.0_rb + clrdrad(lay) = 0.0_rb + totuclfl(lay) = 0.0_rb + totdclfl(lay) = 0.0_rb + icldlyr(lay) = 0 + +! Change to band loop? + do ig = 1, ngptlw + if (cldfmc(ig,lay) .eq. 1._rb) then + ib = ngb(ig) + odcld(lay,ig) = secdiff(ib) * taucmc(ig,lay) + transcld = exp(-odcld(lay,ig)) + abscld(lay,ig) = 1._rb - transcld + efclfrac(lay,ig) = abscld(lay,ig) * cldfmc(ig,lay) + icldlyr(lay) = 1 + else + odcld(lay,ig) = 0.0_rb + abscld(lay,ig) = 0.0_rb + efclfrac(lay,ig) = 0.0_rb + endif + enddo + + enddo + + igc = 1 +! Loop over frequency bands. + do iband = istart, iend + +! Reinitialize g-point counter for each band if output for each band is requested. + if (iout.gt.0.and.iband.ge.2) igc = ngs(iband-1)+1 + +! Loop over g-channels. + 1000 continue + +! Radiative transfer starts here. + radld = 0._rb + radclrd = 0._rb + iclddn = 0 + +! Downward radiative transfer loop. + + do lev = nlayers, 1, -1 + plfrac = fracs(lev,igc) + blay = planklay(lev,iband) + dplankup = planklev(lev,iband) - blay + dplankdn = planklev(lev-1,iband) - blay + odepth = secdiff(iband) * taut(lev,igc) + if (odepth .lt. 0.0_rb) odepth = 0.0_rb +! Cloudy layer + if (icldlyr(lev).eq.1) then + iclddn = 1 + odtot = odepth + odcld(lev,igc) + if (odtot .lt. 0.06_rb) then + atrans(lev) = odepth - 0.5_rb*odepth*odepth + odepth_rec = rec_6*odepth + gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev) + + atot(lev) = odtot - 0.5_rb*odtot*odtot + odtot_rec = rec_6*odtot + bbdtot = plfrac * (blay+dplankdn*odtot_rec) + bbd = plfrac*(blay+dplankdn*odepth_rec) + radld = radld - radld * (atrans(lev) + & + & efclfrac(lev,igc) * (1. - atrans(lev))) + & + & gassrc + cldfmc(igc,lev) * & + & (bbdtot * atot(lev) - gassrc) + drad(lev-1) = drad(lev-1) + radld + + bbugas(lev) = plfrac * (blay+dplankup*odepth_rec) + bbutot(lev) = plfrac * (blay+dplankup*odtot_rec) + + elseif (odepth .le. 0.06_rb) then + atrans(lev) = odepth - 0.5_rb*odepth*odepth + odepth_rec = rec_6*odepth + gassrc = plfrac*(blay+dplankdn*odepth_rec)*atrans(lev) + + odtot = odepth + odcld(lev,igc) + tblind = odtot/(bpade+odtot) + ittot = tblint*tblind + 0.5_rb + tfactot = tfn_tbl(ittot) + bbdtot = plfrac * (blay + tfactot*dplankdn) + bbd = plfrac*(blay+dplankdn*odepth_rec) + atot(lev) = 1. - exp_tbl(ittot) + + radld = radld - radld * (atrans(lev) + & + & efclfrac(lev,igc) * (1._rb - atrans(lev))) + & + & gassrc + cldfmc(igc,lev) * & + & (bbdtot * atot(lev) - gassrc) + drad(lev-1) = drad(lev-1) + radld + + bbugas(lev) = plfrac * (blay + dplankup*odepth_rec) + bbutot(lev) = plfrac * (blay + tfactot * dplankup) + + else + + tblind = odepth/(bpade+odepth) + itgas = tblint*tblind+0.5_rb + odepth = tau_tbl(itgas) + atrans(lev) = 1._rb - exp_tbl(itgas) + tfacgas = tfn_tbl(itgas) + gassrc = atrans(lev) * plfrac * (blay + tfacgas*dplankdn) + + odtot = odepth + odcld(lev,igc) + tblind = odtot/(bpade+odtot) + ittot = tblint*tblind + 0.5_rb + tfactot = tfn_tbl(ittot) + bbdtot = plfrac * (blay + tfactot*dplankdn) + bbd = plfrac*(blay+tfacgas*dplankdn) + atot(lev) = 1._rb - exp_tbl(ittot) + + radld = radld - radld * (atrans(lev) + & + & efclfrac(lev,igc) * (1._rb - atrans(lev))) + & + & gassrc + cldfmc(igc,lev) * & + & (bbdtot * atot(lev) - gassrc) + drad(lev-1) = drad(lev-1) + radld + bbugas(lev) = plfrac * (blay + tfacgas * dplankup) + bbutot(lev) = plfrac * (blay + tfactot * dplankup) + endif +! Clear layer + else + if (odepth .le. 0.06_rb) then + atrans(lev) = odepth-0.5_rb*odepth*odepth + odepth = rec_6*odepth + bbd = plfrac*(blay+dplankdn*odepth) + bbugas(lev) = plfrac*(blay+dplankup*odepth) + else + tblind = odepth/(bpade+odepth) + itr = tblint*tblind+0.5_rb + transc = exp_tbl(itr) + atrans(lev) = 1._rb-transc + tausfac = tfn_tbl(itr) + bbd = plfrac*(blay+tausfac*dplankdn) + bbugas(lev) = plfrac * (blay + tausfac * dplankup) + endif + radld = radld + (bbd-radld)*atrans(lev) + drad(lev-1) = drad(lev-1) + radld + endif +! Set clear sky stream to total sky stream as long as layers +! remain clear. Streams diverge when a cloud is reached (iclddn=1), +! and clear sky stream must be computed separately from that point. + if (iclddn.eq.1) then + radclrd = radclrd + (bbd-radclrd) * atrans(lev) + clrdrad(lev-1) = clrdrad(lev-1) + radclrd + else + radclrd = radld + clrdrad(lev-1) = drad(lev-1) + endif + enddo + +! Spectral emissivity & reflectance +! Include the contribution of spectrally varying longwave emissivity +! and reflection from the surface to the upward radiative transfer. +! Note: Spectral and Lambertian reflection are identical for the +! diffusivity angle flux integration used here. + +!mz* +! rad0 = fracs(1,igc) * plankbnd(iband) + rad0 = semiss(iband) * fracs(1,igc) * planklay(0,iband) +!mz +! Add in specular reflection of surface downward radiance. + reflect = 1._rb - semiss(iband) + radlu = rad0 + reflect * radld + radclru = rad0 + reflect * radclrd + + +! Upward radiative transfer loop. + urad(0) = urad(0) + radlu + clrurad(0) = clrurad(0) + radclru + + do lev = 1, nlayers +! Cloudy layer + if (icldlyr(lev) .eq. 1) then + gassrc = bbugas(lev) * atrans(lev) + radlu = radlu - radlu * (atrans(lev) + & + & efclfrac(lev,igc) * (1._rb - atrans(lev))) + & + & gassrc + cldfmc(igc,lev) * & + & (bbutot(lev) * atot(lev) - gassrc) + urad(lev) = urad(lev) + radlu +! Clear layer + else + radlu = radlu + (bbugas(lev)-radlu)*atrans(lev) + urad(lev) = urad(lev) + radlu + endif +! Set clear sky stream to total sky stream as long as all layers +! are clear (iclddn=0). Streams must be calculated separately at +! all layers when a cloud is present (ICLDDN=1), because surface +! reflectance is different for each stream. + if (iclddn.eq.1) then + radclru = radclru + (bbugas(lev)-radclru)*atrans(lev) + clrurad(lev) = clrurad(lev) + radclru + else + radclru = radlu + clrurad(lev) = urad(lev) + endif + enddo + +! Increment g-point counter + igc = igc + 1 +! Return to continue radiative transfer for all g-channels in present band + if (igc .le. ngs(iband)) go to 1000 + +! Process longwave output from band for total and clear streams. +! Calculate upward, downward, and net flux. + do lev = nlayers, 0, -1 + uflux(lev) = urad(lev)*wtdiff + dflux(lev) = drad(lev)*wtdiff + urad(lev) = 0.0_rb + drad(lev) = 0.0_rb + totuflux(lev) = totuflux(lev) + uflux(lev) * delwave(iband) + totdflux(lev) = totdflux(lev) + dflux(lev) * delwave(iband) + uclfl(lev) = clrurad(lev)*wtdiff + dclfl(lev) = clrdrad(lev)*wtdiff + clrurad(lev) = 0.0_rb + clrdrad(lev) = 0.0_rb + totuclfl(lev) = totuclfl(lev) + uclfl(lev) * delwave(iband) + totdclfl(lev) = totdclfl(lev) + dclfl(lev) * delwave(iband) + enddo + +! End spectral band loop + enddo + +! Calculate fluxes at surface + totuflux(0) = totuflux(0) * fluxfac + totdflux(0) = totdflux(0) * fluxfac + fnet(0) = totuflux(0) - totdflux(0) + totuclfl(0) = totuclfl(0) * fluxfac + totdclfl(0) = totdclfl(0) * fluxfac + fnetc(0) = totuclfl(0) - totdclfl(0) + +! Calculate fluxes at model levels + do lev = 1, nlayers + totuflux(lev) = totuflux(lev) * fluxfac + totdflux(lev) = totdflux(lev) * fluxfac + fnet(lev) = totuflux(lev) - totdflux(lev) + totuclfl(lev) = totuclfl(lev) * fluxfac + totdclfl(lev) = totdclfl(lev) * fluxfac + fnetc(lev) = totuclfl(lev) - totdclfl(lev) + l = lev - 1 + +! Calculate heating rates at model layers + htr(l)=heatfac*(fnet(l)-fnet(lev))/(pz(l)-pz(lev)) + htrc(l)=heatfac*(fnetc(l)-fnetc(lev))/(pz(l)-pz(lev)) + enddo + +! Set heating rate to zero in top layer + htr(nlayers) = 0.0_rb + htrc(nlayers) = 0.0_rb + + end subroutine rtrnmc_mcica + +! ------------------------------------------------------------------------------ + subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & + & ciwpmc, clwpmc, cswpmc, reicmc, relqmc, resnmc, ncbands, taucmc) +! ------------------------------------------------------------------------------ + +! Purpose: Compute the cloud optical depth(s) for each cloudy layer. + +! ------- Input ------- + + integer(kind=im), intent(in) :: nlayers ! total number of layers + integer(kind=im), intent(in) :: inflag ! see definitions + integer(kind=im), intent(in) :: iceflag ! see definitions + integer(kind=im), intent(in) :: liqflag ! see definitions + + real(kind=rb), intent(in) :: cldfmc(:,:) ! cloud fraction [mcica] + ! Dimensions: (ngptlw,nlayers) + real(kind=rb), intent(in) :: ciwpmc(:,:) ! cloud ice water path [mcica] + ! Dimensions: (ngptlw,nlayers) + real(kind=rb), intent(in) :: clwpmc(:,:) ! cloud liquid water path [mcica] + ! Dimensions: (ngptlw,nlayers) + real(kind=rb), intent(in) :: cswpmc(:,:) ! cloud snow path [mcica] + ! Dimensions: (ngptlw,nlayers) + real(kind=rb), intent(in) :: relqmc(:) ! liquid particle effective radius (microns) + ! Dimensions: (nlayers) + real(kind=rb), intent(in) :: reicmc(:) ! ice particle effective radius (microns) + ! Dimensions: (nlayers) + real(kind=rb), intent(in) :: resnmc(:) ! snow particle effective radius (microns) + ! Dimensions: (nlayers) + ! specific definition of reicmc depends on setting of iceflag: + ! iceflag = 0: ice effective radius, r_ec, (Ebert and Curry, 1992), + ! r_ec must be >= 10.0 microns + ! iceflag = 1: ice effective radius, r_ec, (Ebert and Curry, 1992), + ! r_ec range is limited to 13.0 to 130.0 microns + ! iceflag = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996) + ! r_k range is limited to 5.0 to 131.0 microns + ! iceflag = 3: generalized effective size, dge, (Fu, 1996), + ! dge range is limited to 5.0 to 140.0 microns + ! [dge = 1.0315 * r_ec] + +! ------- Output ------- + + integer(kind=im), intent(out) :: ncbands ! number of cloud spectral bands + real(kind=rb), intent(inout) :: taucmc(:,:) ! cloud optical depth [mcica] + ! Dimensions: (ngptlw,nlayers) + +! ------- Local ------- + + integer(kind=im) :: lay ! Layer index + integer(kind=im) :: ib ! spectral band index + integer(kind=im) :: ig ! g-point interval index + integer(kind=im) :: index + integer(kind=im) :: icb(nbands) + real(kind=rb) , dimension(2) :: absice0 + real(kind=rb) , dimension(2,5) :: absice1 + real(kind=rb) , dimension(43,16) :: absice2 + real(kind=rb) , dimension(46,16) :: absice3 + real(kind=rb) :: absliq0 + real(kind=rb) , dimension(58,16) :: absliq1 + + real(kind=rb) :: abscoice(ngptlw) ! ice absorption coefficients + real(kind=rb) :: abscoliq(ngptlw) ! liquid absorption coefficients + real(kind=rb) :: abscosno(ngptlw) ! snow absorption coefficients + real(kind=rb) :: cwp ! cloud water path + real(kind=rb) :: radice ! cloud ice effective size (microns) + real(kind=rb) :: factor ! + real(kind=rb) :: fint ! + real(kind=rb) :: radliq ! cloud liquid droplet radius (microns) + real(kind=rb) :: radsno ! cloud snow effective size (microns) + real(kind=rb), parameter :: eps = 1.e-6_rb ! epsilon + real(kind=rb), parameter :: cldmin = 1.e-20_rb ! minimum value for cloud quantities + character*80 errmess + +! ------- Definitions ------- + +! Explanation of the method for each value of INFLAG. Values of +! 0 or 1 for INFLAG do not distingish being liquid and ice clouds. +! INFLAG = 2 does distinguish between liquid and ice clouds, and +! requires further user input to specify the method to be used to +! compute the aborption due to each. +! INFLAG = 0: For each cloudy layer, the cloud fraction and (gray) +! optical depth are input. +! INFLAG = 1: For each cloudy layer, the cloud fraction and cloud +! water path (g/m2) are input. The (gray) cloud optical +! depth is computed as in CCM2. +! INFLAG = 2: For each cloudy layer, the cloud fraction, cloud +! water path (g/m2), and cloud ice fraction are input. +! ICEFLAG = 0: The ice effective radius (microns) is input and the +! optical depths due to ice clouds are computed as in CCM3. +! ICEFLAG = 1: The ice effective radius (microns) is input and the +! optical depths due to ice clouds are computed as in +! Ebert and Curry, JGR, 97, 3831-3836 (1992). The +! spectral regions in this work have been matched with +! the spectral bands in RRTM to as great an extent +! as possible: +! E&C 1 IB = 5 RRTM bands 9-16 +! E&C 2 IB = 4 RRTM bands 6-8 +! E&C 3 IB = 3 RRTM bands 3-5 +! E&C 4 IB = 2 RRTM band 2 +! E&C 5 IB = 1 RRTM band 1 +! ICEFLAG = 2: The ice effective radius (microns) is input and the +! optical properties due to ice clouds are computed from +! the optical properties stored in the RT code, +! STREAMER v3.0 (Reference: Key. J., Streamer +! User's Guide, Cooperative Institute for +! Meteorological Satellite Studies, 2001, 96 pp.). +! Valid range of values for re are between 5.0 and +! 131.0 micron. +! ICEFLAG = 3: The ice generalized effective size (dge) is input +! and the optical properties, are calculated as in +! Q. Fu, J. Climate, (1998). Q. Fu provided high resolution +! tables which were appropriately averaged for the +! bands in RRTM_LW. Linear interpolation is used to +! get the coefficients from the stored tables. +! Valid range of values for dge are between 5.0 and +! 140.0 micron. +! LIQFLAG = 0: The optical depths due to water clouds are computed as +! in CCM3. +! LIQFLAG = 1: The water droplet effective radius (microns) is input +! and the optical depths due to water clouds are computed +! as in Hu and Stamnes, J., Clim., 6, 728-742, (1993). +! The values for absorption coefficients appropriate for +! the spectral bands in RRTM have been obtained for a +! range of effective radii by an averaging procedure +! based on the work of J. Pinto (private communication). +! Linear interpolation is used to get the absorption +! coefficients for the input effective radius. + + data icb /1,2,3,3,3,4,4,4,5, 5, 5, 5, 5, 5, 5, 5/ +! Everything below is for INFLAG = 2. + +! ABSICEn(J,IB) are the parameters needed to compute the liquid water +! absorption coefficient in spectral region IB for ICEFLAG=n. The units +! of ABSICEn(1,IB) are m2/g and ABSICEn(2,IB) has units (microns (m2/g)). +! For ICEFLAG = 0. + + absice0(:)= (/0.005_rb, 1.0_rb/) + +! For ICEFLAG = 1. + absice1(1,:) = (/0.0036_rb, 0.0068_rb, 0.0003_rb, 0.0016_rb, & + & 0.0020_rb/) + absice1(2,:) = (/1.136_rb , 0.600_rb , 1.338_rb , 1.166_rb , & + & 1.118_rb /) + +! For ICEFLAG = 2. In each band, the absorption +! coefficients are listed for a range of effective radii from 5.0 +! to 131.0 microns in increments of 3.0 microns. +! Spherical Ice Particle Parameterization +! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)] + absice2(:,1) = (/ & +! band 1 + 7.798999e-02_rb,6.340479e-02_rb,5.417973e-02_rb,4.766245e-02_rb,4.272663e-02_rb, & + 3.880939e-02_rb,3.559544e-02_rb,3.289241e-02_rb,3.057511e-02_rb,2.855800e-02_rb, & + 2.678022e-02_rb,2.519712e-02_rb,2.377505e-02_rb,2.248806e-02_rb,2.131578e-02_rb, & + 2.024194e-02_rb,1.925337e-02_rb,1.833926e-02_rb,1.749067e-02_rb,1.670007e-02_rb, & + 1.596113e-02_rb,1.526845e-02_rb,1.461739e-02_rb,1.400394e-02_rb,1.342462e-02_rb, & + 1.287639e-02_rb,1.235656e-02_rb,1.186279e-02_rb,1.139297e-02_rb,1.094524e-02_rb, & + 1.051794e-02_rb,1.010956e-02_rb,9.718755e-03_rb,9.344316e-03_rb,8.985139e-03_rb, & + 8.640223e-03_rb,8.308656e-03_rb,7.989606e-03_rb,7.682312e-03_rb,7.386076e-03_rb, & + 7.100255e-03_rb,6.824258e-03_rb,6.557540e-03_rb/) + absice2(:,2) = (/ & +! band 2 + 2.784879e-02_rb,2.709863e-02_rb,2.619165e-02_rb,2.529230e-02_rb,2.443225e-02_rb, & + 2.361575e-02_rb,2.284021e-02_rb,2.210150e-02_rb,2.139548e-02_rb,2.071840e-02_rb, & + 2.006702e-02_rb,1.943856e-02_rb,1.883064e-02_rb,1.824120e-02_rb,1.766849e-02_rb, & + 1.711099e-02_rb,1.656737e-02_rb,1.603647e-02_rb,1.551727e-02_rb,1.500886e-02_rb, & + 1.451045e-02_rb,1.402132e-02_rb,1.354084e-02_rb,1.306842e-02_rb,1.260355e-02_rb, & + 1.214575e-02_rb,1.169460e-02_rb,1.124971e-02_rb,1.081072e-02_rb,1.037731e-02_rb, & + 9.949167e-03_rb,9.526021e-03_rb,9.107615e-03_rb,8.693714e-03_rb,8.284096e-03_rb, & + 7.878558e-03_rb,7.476910e-03_rb,7.078974e-03_rb,6.684586e-03_rb,6.293589e-03_rb, & + 5.905839e-03_rb,5.521200e-03_rb,5.139543e-03_rb/) + absice2(:,3) = (/ & +! band 3 + 1.065397e-01_rb,8.005726e-02_rb,6.546428e-02_rb,5.589131e-02_rb,4.898681e-02_rb, & + 4.369932e-02_rb,3.947901e-02_rb,3.600676e-02_rb,3.308299e-02_rb,3.057561e-02_rb, & + 2.839325e-02_rb,2.647040e-02_rb,2.475872e-02_rb,2.322164e-02_rb,2.183091e-02_rb, & + 2.056430e-02_rb,1.940407e-02_rb,1.833586e-02_rb,1.734787e-02_rb,1.643034e-02_rb, & + 1.557512e-02_rb,1.477530e-02_rb,1.402501e-02_rb,1.331924e-02_rb,1.265364e-02_rb, & + 1.202445e-02_rb,1.142838e-02_rb,1.086257e-02_rb,1.032445e-02_rb,9.811791e-03_rb, & + 9.322587e-03_rb,8.855053e-03_rb,8.407591e-03_rb,7.978763e-03_rb,7.567273e-03_rb, & + 7.171949e-03_rb,6.791728e-03_rb,6.425642e-03_rb,6.072809e-03_rb,5.732424e-03_rb, & + 5.403748e-03_rb,5.086103e-03_rb,4.778865e-03_rb/) + absice2(:,4) = (/ & +! band 4 + 1.804566e-01_rb,1.168987e-01_rb,8.680442e-02_rb,6.910060e-02_rb,5.738174e-02_rb, & + 4.902332e-02_rb,4.274585e-02_rb,3.784923e-02_rb,3.391734e-02_rb,3.068690e-02_rb, & + 2.798301e-02_rb,2.568480e-02_rb,2.370600e-02_rb,2.198337e-02_rb,2.046940e-02_rb, & + 1.912777e-02_rb,1.793016e-02_rb,1.685420e-02_rb,1.588193e-02_rb,1.499882e-02_rb, & + 1.419293e-02_rb,1.345440e-02_rb,1.277496e-02_rb,1.214769e-02_rb,1.156669e-02_rb, & + 1.102694e-02_rb,1.052412e-02_rb,1.005451e-02_rb,9.614854e-03_rb,9.202335e-03_rb, & + 8.814470e-03_rb,8.449077e-03_rb,8.104223e-03_rb,7.778195e-03_rb,7.469466e-03_rb, & + 7.176671e-03_rb,6.898588e-03_rb,6.634117e-03_rb,6.382264e-03_rb,6.142134e-03_rb, & + 5.912913e-03_rb,5.693862e-03_rb,5.484308e-03_rb/) + absice2(:,5) = (/ & +! band 5 + 2.131806e-01_rb,1.311372e-01_rb,9.407171e-02_rb,7.299442e-02_rb,5.941273e-02_rb, & + 4.994043e-02_rb,4.296242e-02_rb,3.761113e-02_rb,3.337910e-02_rb,2.994978e-02_rb, & + 2.711556e-02_rb,2.473461e-02_rb,2.270681e-02_rb,2.095943e-02_rb,1.943839e-02_rb, & + 1.810267e-02_rb,1.692057e-02_rb,1.586719e-02_rb,1.492275e-02_rb,1.407132e-02_rb, & + 1.329989e-02_rb,1.259780e-02_rb,1.195618e-02_rb,1.136761e-02_rb,1.082583e-02_rb, & + 1.032552e-02_rb,9.862158e-03_rb,9.431827e-03_rb,9.031157e-03_rb,8.657217e-03_rb, & + 8.307449e-03_rb,7.979609e-03_rb,7.671724e-03_rb,7.382048e-03_rb,7.109032e-03_rb, & + 6.851298e-03_rb,6.607615e-03_rb,6.376881e-03_rb,6.158105e-03_rb,5.950394e-03_rb, & + 5.752942e-03_rb,5.565019e-03_rb,5.385963e-03_rb/) + absice2(:,6) = (/ & +! band 6 + 1.546177e-01_rb,1.039251e-01_rb,7.910347e-02_rb,6.412429e-02_rb,5.399997e-02_rb, & + 4.664937e-02_rb,4.104237e-02_rb,3.660781e-02_rb,3.300218e-02_rb,3.000586e-02_rb, & + 2.747148e-02_rb,2.529633e-02_rb,2.340647e-02_rb,2.174723e-02_rb,2.027731e-02_rb, & + 1.896487e-02_rb,1.778492e-02_rb,1.671761e-02_rb,1.574692e-02_rb,1.485978e-02_rb, & + 1.404543e-02_rb,1.329489e-02_rb,1.260066e-02_rb,1.195636e-02_rb,1.135657e-02_rb, & + 1.079664e-02_rb,1.027257e-02_rb,9.780871e-03_rb,9.318505e-03_rb,8.882815e-03_rb, & + 8.471458e-03_rb,8.082364e-03_rb,7.713696e-03_rb,7.363817e-03_rb,7.031264e-03_rb, & + 6.714725e-03_rb,6.413021e-03_rb,6.125086e-03_rb,5.849958e-03_rb,5.586764e-03_rb, & + 5.334707e-03_rb,5.093066e-03_rb,4.861179e-03_rb/) + absice2(:,7) = (/ & +! band 7 + 7.583404e-02_rb,6.181558e-02_rb,5.312027e-02_rb,4.696039e-02_rb,4.225986e-02_rb, & + 3.849735e-02_rb,3.538340e-02_rb,3.274182e-02_rb,3.045798e-02_rb,2.845343e-02_rb, & + 2.667231e-02_rb,2.507353e-02_rb,2.362606e-02_rb,2.230595e-02_rb,2.109435e-02_rb, & + 1.997617e-02_rb,1.893916e-02_rb,1.797328e-02_rb,1.707016e-02_rb,1.622279e-02_rb, & + 1.542523e-02_rb,1.467241e-02_rb,1.395997e-02_rb,1.328414e-02_rb,1.264164e-02_rb, & + 1.202958e-02_rb,1.144544e-02_rb,1.088697e-02_rb,1.035218e-02_rb,9.839297e-03_rb, & + 9.346733e-03_rb,8.873057e-03_rb,8.416980e-03_rb,7.977335e-03_rb,7.553066e-03_rb, & + 7.143210e-03_rb,6.746888e-03_rb,6.363297e-03_rb,5.991700e-03_rb,5.631422e-03_rb, & + 5.281840e-03_rb,4.942378e-03_rb,4.612505e-03_rb/) + absice2(:,8) = (/ & +! band 8 + 9.022185e-02_rb,6.922700e-02_rb,5.710674e-02_rb,4.898377e-02_rb,4.305946e-02_rb, & + 3.849553e-02_rb,3.484183e-02_rb,3.183220e-02_rb,2.929794e-02_rb,2.712627e-02_rb, & + 2.523856e-02_rb,2.357810e-02_rb,2.210286e-02_rb,2.078089e-02_rb,1.958747e-02_rb, & + 1.850310e-02_rb,1.751218e-02_rb,1.660205e-02_rb,1.576232e-02_rb,1.498440e-02_rb, & + 1.426107e-02_rb,1.358624e-02_rb,1.295474e-02_rb,1.236212e-02_rb,1.180456e-02_rb, & + 1.127874e-02_rb,1.078175e-02_rb,1.031106e-02_rb,9.864433e-03_rb,9.439878e-03_rb, & + 9.035637e-03_rb,8.650140e-03_rb,8.281981e-03_rb,7.929895e-03_rb,7.592746e-03_rb, & + 7.269505e-03_rb,6.959238e-03_rb,6.661100e-03_rb,6.374317e-03_rb,6.098185e-03_rb, & + 5.832059e-03_rb,5.575347e-03_rb,5.327504e-03_rb/) + absice2(:,9) = (/ & +! band 9 + 1.294087e-01_rb,8.788217e-02_rb,6.728288e-02_rb,5.479720e-02_rb,4.635049e-02_rb, & + 4.022253e-02_rb,3.555576e-02_rb,3.187259e-02_rb,2.888498e-02_rb,2.640843e-02_rb, & + 2.431904e-02_rb,2.253038e-02_rb,2.098024e-02_rb,1.962267e-02_rb,1.842293e-02_rb, & + 1.735426e-02_rb,1.639571e-02_rb,1.553060e-02_rb,1.474552e-02_rb,1.402953e-02_rb, & + 1.337363e-02_rb,1.277033e-02_rb,1.221336e-02_rb,1.169741e-02_rb,1.121797e-02_rb, & + 1.077117e-02_rb,1.035369e-02_rb,9.962643e-03_rb,9.595509e-03_rb,9.250088e-03_rb, & + 8.924447e-03_rb,8.616876e-03_rb,8.325862e-03_rb,8.050057e-03_rb,7.788258e-03_rb, & + 7.539388e-03_rb,7.302478e-03_rb,7.076656e-03_rb,6.861134e-03_rb,6.655197e-03_rb, & + 6.458197e-03_rb,6.269543e-03_rb,6.088697e-03_rb/) + absice2(:,10) = (/ & +! band 10 + 1.593628e-01_rb,1.014552e-01_rb,7.458955e-02_rb,5.903571e-02_rb,4.887582e-02_rb, & + 4.171159e-02_rb,3.638480e-02_rb,3.226692e-02_rb,2.898717e-02_rb,2.631256e-02_rb, & + 2.408925e-02_rb,2.221156e-02_rb,2.060448e-02_rb,1.921325e-02_rb,1.799699e-02_rb, & + 1.692456e-02_rb,1.597177e-02_rb,1.511961e-02_rb,1.435289e-02_rb,1.365933e-02_rb, & + 1.302890e-02_rb,1.245334e-02_rb,1.192576e-02_rb,1.144037e-02_rb,1.099230e-02_rb, & + 1.057739e-02_rb,1.019208e-02_rb,9.833302e-03_rb,9.498395e-03_rb,9.185047e-03_rb, & + 8.891237e-03_rb,8.615185e-03_rb,8.355325e-03_rb,8.110267e-03_rb,7.878778e-03_rb, & + 7.659759e-03_rb,7.452224e-03_rb,7.255291e-03_rb,7.068166e-03_rb,6.890130e-03_rb, & + 6.720536e-03_rb,6.558794e-03_rb,6.404371e-03_rb/) + absice2(:,11) = (/ & +! band 11 + 1.656227e-01_rb,1.032129e-01_rb,7.487359e-02_rb,5.871431e-02_rb,4.828355e-02_rb, & + 4.099989e-02_rb,3.562924e-02_rb,3.150755e-02_rb,2.824593e-02_rb,2.560156e-02_rb, & + 2.341503e-02_rb,2.157740e-02_rb,2.001169e-02_rb,1.866199e-02_rb,1.748669e-02_rb, & + 1.645421e-02_rb,1.554015e-02_rb,1.472535e-02_rb,1.399457e-02_rb,1.333553e-02_rb, & + 1.273821e-02_rb,1.219440e-02_rb,1.169725e-02_rb,1.124104e-02_rb,1.082096e-02_rb, & + 1.043290e-02_rb,1.007336e-02_rb,9.739338e-03_rb,9.428223e-03_rb,9.137756e-03_rb, & + 8.865964e-03_rb,8.611115e-03_rb,8.371686e-03_rb,8.146330e-03_rb,7.933852e-03_rb, & + 7.733187e-03_rb,7.543386e-03_rb,7.363597e-03_rb,7.193056e-03_rb,7.031072e-03_rb, & + 6.877024e-03_rb,6.730348e-03_rb,6.590531e-03_rb/) + absice2(:,12) = (/ & +! band 12 + 9.194591e-02_rb,6.446867e-02_rb,4.962034e-02_rb,4.042061e-02_rb,3.418456e-02_rb, & + 2.968856e-02_rb,2.629900e-02_rb,2.365572e-02_rb,2.153915e-02_rb,1.980791e-02_rb, & + 1.836689e-02_rb,1.714979e-02_rb,1.610900e-02_rb,1.520946e-02_rb,1.442476e-02_rb, & + 1.373468e-02_rb,1.312345e-02_rb,1.257858e-02_rb,1.209010e-02_rb,1.164990e-02_rb, & + 1.125136e-02_rb,1.088901e-02_rb,1.055827e-02_rb,1.025531e-02_rb,9.976896e-03_rb, & + 9.720255e-03_rb,9.483022e-03_rb,9.263160e-03_rb,9.058902e-03_rb,8.868710e-03_rb, & + 8.691240e-03_rb,8.525312e-03_rb,8.369886e-03_rb,8.224042e-03_rb,8.086961e-03_rb, & + 7.957917e-03_rb,7.836258e-03_rb,7.721400e-03_rb,7.612821e-03_rb,7.510045e-03_rb, & + 7.412648e-03_rb,7.320242e-03_rb,7.232476e-03_rb/) + absice2(:,13) = (/ & +! band 13 + 1.437021e-01_rb,8.872535e-02_rb,6.392420e-02_rb,4.991833e-02_rb,4.096790e-02_rb, & + 3.477881e-02_rb,3.025782e-02_rb,2.681909e-02_rb,2.412102e-02_rb,2.195132e-02_rb, & + 2.017124e-02_rb,1.868641e-02_rb,1.743044e-02_rb,1.635529e-02_rb,1.542540e-02_rb, & + 1.461388e-02_rb,1.390003e-02_rb,1.326766e-02_rb,1.270395e-02_rb,1.219860e-02_rb, & + 1.174326e-02_rb,1.133107e-02_rb,1.095637e-02_rb,1.061442e-02_rb,1.030126e-02_rb, & + 1.001352e-02_rb,9.748340e-03_rb,9.503256e-03_rb,9.276155e-03_rb,9.065205e-03_rb, & + 8.868808e-03_rb,8.685571e-03_rb,8.514268e-03_rb,8.353820e-03_rb,8.203272e-03_rb, & + 8.061776e-03_rb,7.928578e-03_rb,7.803001e-03_rb,7.684443e-03_rb,7.572358e-03_rb, & + 7.466258e-03_rb,7.365701e-03_rb,7.270286e-03_rb/) + absice2(:,14) = (/ & +! band 14 + 1.288870e-01_rb,8.160295e-02_rb,5.964745e-02_rb,4.703790e-02_rb,3.888637e-02_rb, & + 3.320115e-02_rb,2.902017e-02_rb,2.582259e-02_rb,2.330224e-02_rb,2.126754e-02_rb, & + 1.959258e-02_rb,1.819130e-02_rb,1.700289e-02_rb,1.598320e-02_rb,1.509942e-02_rb, & + 1.432666e-02_rb,1.364572e-02_rb,1.304156e-02_rb,1.250220e-02_rb,1.201803e-02_rb, & + 1.158123e-02_rb,1.118537e-02_rb,1.082513e-02_rb,1.049605e-02_rb,1.019440e-02_rb, & + 9.916989e-03_rb,9.661116e-03_rb,9.424457e-03_rb,9.205005e-03_rb,9.001022e-03_rb, & + 8.810992e-03_rb,8.633588e-03_rb,8.467646e-03_rb,8.312137e-03_rb,8.166151e-03_rb, & + 8.028878e-03_rb,7.899597e-03_rb,7.777663e-03_rb,7.662498e-03_rb,7.553581e-03_rb, & + 7.450444e-03_rb,7.352662e-03_rb,7.259851e-03_rb/) + absice2(:,15) = (/ & +! band 15 + 8.254229e-02_rb,5.808787e-02_rb,4.492166e-02_rb,3.675028e-02_rb,3.119623e-02_rb, & + 2.718045e-02_rb,2.414450e-02_rb,2.177073e-02_rb,1.986526e-02_rb,1.830306e-02_rb, & + 1.699991e-02_rb,1.589698e-02_rb,1.495199e-02_rb,1.413374e-02_rb,1.341870e-02_rb, & + 1.278883e-02_rb,1.223002e-02_rb,1.173114e-02_rb,1.128322e-02_rb,1.087900e-02_rb, & + 1.051254e-02_rb,1.017890e-02_rb,9.873991e-03_rb,9.594347e-03_rb,9.337044e-03_rb, & + 9.099589e-03_rb,8.879842e-03_rb,8.675960e-03_rb,8.486341e-03_rb,8.309594e-03_rb, & + 8.144500e-03_rb,7.989986e-03_rb,7.845109e-03_rb,7.709031e-03_rb,7.581007e-03_rb, & + 7.460376e-03_rb,7.346544e-03_rb,7.238978e-03_rb,7.137201e-03_rb,7.040780e-03_rb, & + 6.949325e-03_rb,6.862483e-03_rb,6.779931e-03_rb/) + absice2(:,16) = (/ & +! band 16 + 1.382062e-01_rb,8.643227e-02_rb,6.282935e-02_rb,4.934783e-02_rb,4.063891e-02_rb, & + 3.455591e-02_rb,3.007059e-02_rb,2.662897e-02_rb,2.390631e-02_rb,2.169972e-02_rb, & + 1.987596e-02_rb,1.834393e-02_rb,1.703924e-02_rb,1.591513e-02_rb,1.493679e-02_rb, & + 1.407780e-02_rb,1.331775e-02_rb,1.264061e-02_rb,1.203364e-02_rb,1.148655e-02_rb, & + 1.099099e-02_rb,1.054006e-02_rb,1.012807e-02_rb,9.750215e-03_rb,9.402477e-03_rb, & + 9.081428e-03_rb,8.784143e-03_rb,8.508107e-03_rb,8.251146e-03_rb,8.011373e-03_rb, & + 7.787140e-03_rb,7.577002e-03_rb,7.379687e-03_rb,7.194071e-03_rb,7.019158e-03_rb, & + 6.854061e-03_rb,6.697986e-03_rb,6.550224e-03_rb,6.410138e-03_rb,6.277153e-03_rb, & + 6.150751e-03_rb,6.030462e-03_rb,5.915860e-03_rb/) + +! ICEFLAG = 3; Fu parameterization. Particle size 5 - 140 micron in +! increments of 3 microns. +! units = m2/g +! Hexagonal Ice Particle Parameterization +! absorption units (abs coef/iwc): [(m^-1)/(g m^-3)] + absice3(:,1) = (/ & +! band 1 + 3.110649e-03_rb,4.666352e-02_rb,6.606447e-02_rb,6.531678e-02_rb,6.012598e-02_rb, & + 5.437494e-02_rb,4.906411e-02_rb,4.441146e-02_rb,4.040585e-02_rb,3.697334e-02_rb, & + 3.403027e-02_rb,3.149979e-02_rb,2.931596e-02_rb,2.742365e-02_rb,2.577721e-02_rb, & + 2.433888e-02_rb,2.307732e-02_rb,2.196644e-02_rb,2.098437e-02_rb,2.011264e-02_rb, & + 1.933561e-02_rb,1.863992e-02_rb,1.801407e-02_rb,1.744812e-02_rb,1.693346e-02_rb, & + 1.646252e-02_rb,1.602866e-02_rb,1.562600e-02_rb,1.524933e-02_rb,1.489399e-02_rb, & + 1.455580e-02_rb,1.423098e-02_rb,1.391612e-02_rb,1.360812e-02_rb,1.330413e-02_rb, & + 1.300156e-02_rb,1.269801e-02_rb,1.239127e-02_rb,1.207928e-02_rb,1.176014e-02_rb, & + 1.143204e-02_rb,1.109334e-02_rb,1.074243e-02_rb,1.037786e-02_rb,9.998198e-03_rb, & + 9.602126e-03_rb/) + absice3(:,2) = (/ & +! band 2 + 3.984966e-04_rb,1.681097e-02_rb,2.627680e-02_rb,2.767465e-02_rb,2.700722e-02_rb, & + 2.579180e-02_rb,2.448677e-02_rb,2.323890e-02_rb,2.209096e-02_rb,2.104882e-02_rb, & + 2.010547e-02_rb,1.925003e-02_rb,1.847128e-02_rb,1.775883e-02_rb,1.710358e-02_rb, & + 1.649769e-02_rb,1.593449e-02_rb,1.540829e-02_rb,1.491429e-02_rb,1.444837e-02_rb, & + 1.400704e-02_rb,1.358729e-02_rb,1.318654e-02_rb,1.280258e-02_rb,1.243346e-02_rb, & + 1.207750e-02_rb,1.173325e-02_rb,1.139941e-02_rb,1.107487e-02_rb,1.075861e-02_rb, & + 1.044975e-02_rb,1.014753e-02_rb,9.851229e-03_rb,9.560240e-03_rb,9.274003e-03_rb, & + 8.992020e-03_rb,8.713845e-03_rb,8.439074e-03_rb,8.167346e-03_rb,7.898331e-03_rb, & + 7.631734e-03_rb,7.367286e-03_rb,7.104742e-03_rb,6.843882e-03_rb,6.584504e-03_rb, & + 6.326424e-03_rb/) + absice3(:,3) = (/ & +! band 3 + 6.933163e-02_rb,8.540475e-02_rb,7.701816e-02_rb,6.771158e-02_rb,5.986953e-02_rb, & + 5.348120e-02_rb,4.824962e-02_rb,4.390563e-02_rb,4.024411e-02_rb,3.711404e-02_rb, & + 3.440426e-02_rb,3.203200e-02_rb,2.993478e-02_rb,2.806474e-02_rb,2.638464e-02_rb, & + 2.486516e-02_rb,2.348288e-02_rb,2.221890e-02_rb,2.105780e-02_rb,1.998687e-02_rb, & + 1.899552e-02_rb,1.807490e-02_rb,1.721750e-02_rb,1.641693e-02_rb,1.566773e-02_rb, & + 1.496515e-02_rb,1.430509e-02_rb,1.368398e-02_rb,1.309865e-02_rb,1.254634e-02_rb, & + 1.202456e-02_rb,1.153114e-02_rb,1.106409e-02_rb,1.062166e-02_rb,1.020224e-02_rb, & + 9.804381e-03_rb,9.426771e-03_rb,9.068205e-03_rb,8.727578e-03_rb,8.403876e-03_rb, & + 8.096160e-03_rb,7.803564e-03_rb,7.525281e-03_rb,7.260560e-03_rb,7.008697e-03_rb, & + 6.769036e-03_rb/) + absice3(:,4) = (/ & +! band 4 + 1.765735e-01_rb,1.382700e-01_rb,1.095129e-01_rb,8.987475e-02_rb,7.591185e-02_rb, & + 6.554169e-02_rb,5.755500e-02_rb,5.122083e-02_rb,4.607610e-02_rb,4.181475e-02_rb, & + 3.822697e-02_rb,3.516432e-02_rb,3.251897e-02_rb,3.021073e-02_rb,2.817876e-02_rb, & + 2.637607e-02_rb,2.476582e-02_rb,2.331871e-02_rb,2.201113e-02_rb,2.082388e-02_rb, & + 1.974115e-02_rb,1.874983e-02_rb,1.783894e-02_rb,1.699922e-02_rb,1.622280e-02_rb, & + 1.550296e-02_rb,1.483390e-02_rb,1.421064e-02_rb,1.362880e-02_rb,1.308460e-02_rb, & + 1.257468e-02_rb,1.209611e-02_rb,1.164628e-02_rb,1.122287e-02_rb,1.082381e-02_rb, & + 1.044725e-02_rb,1.009154e-02_rb,9.755166e-03_rb,9.436783e-03_rb,9.135163e-03_rb, & + 8.849193e-03_rb,8.577856e-03_rb,8.320225e-03_rb,8.075451e-03_rb,7.842755e-03_rb, & + 7.621418e-03_rb/) + absice3(:,5) = (/ & +! band 5 + 2.339673e-01_rb,1.692124e-01_rb,1.291656e-01_rb,1.033837e-01_rb,8.562949e-02_rb, & + 7.273526e-02_rb,6.298262e-02_rb,5.537015e-02_rb,4.927787e-02_rb,4.430246e-02_rb, & + 4.017061e-02_rb,3.669072e-02_rb,3.372455e-02_rb,3.116995e-02_rb,2.894977e-02_rb, & + 2.700471e-02_rb,2.528842e-02_rb,2.376420e-02_rb,2.240256e-02_rb,2.117959e-02_rb, & + 2.007567e-02_rb,1.907456e-02_rb,1.816271e-02_rb,1.732874e-02_rb,1.656300e-02_rb, & + 1.585725e-02_rb,1.520445e-02_rb,1.459852e-02_rb,1.403419e-02_rb,1.350689e-02_rb, & + 1.301260e-02_rb,1.254781e-02_rb,1.210941e-02_rb,1.169468e-02_rb,1.130118e-02_rb, & + 1.092675e-02_rb,1.056945e-02_rb,1.022757e-02_rb,9.899560e-03_rb,9.584021e-03_rb, & + 9.279705e-03_rb,8.985479e-03_rb,8.700322e-03_rb,8.423306e-03_rb,8.153590e-03_rb, & + 7.890412e-03_rb/) + absice3(:,6) = (/ & +! band 6 + 1.145369e-01_rb,1.174566e-01_rb,9.917866e-02_rb,8.332990e-02_rb,7.104263e-02_rb, & + 6.153370e-02_rb,5.405472e-02_rb,4.806281e-02_rb,4.317918e-02_rb,3.913795e-02_rb, & + 3.574916e-02_rb,3.287437e-02_rb,3.041067e-02_rb,2.828017e-02_rb,2.642292e-02_rb, & + 2.479206e-02_rb,2.335051e-02_rb,2.206851e-02_rb,2.092195e-02_rb,1.989108e-02_rb, & + 1.895958e-02_rb,1.811385e-02_rb,1.734245e-02_rb,1.663573e-02_rb,1.598545e-02_rb, & + 1.538456e-02_rb,1.482700e-02_rb,1.430750e-02_rb,1.382150e-02_rb,1.336499e-02_rb, & + 1.293447e-02_rb,1.252685e-02_rb,1.213939e-02_rb,1.176968e-02_rb,1.141555e-02_rb, & + 1.107508e-02_rb,1.074655e-02_rb,1.042839e-02_rb,1.011923e-02_rb,9.817799e-03_rb, & + 9.522962e-03_rb,9.233688e-03_rb,8.949041e-03_rb,8.668171e-03_rb,8.390301e-03_rb, & + 8.114723e-03_rb/) + absice3(:,7) = (/ & +! band 7 + 1.222345e-02_rb,5.344230e-02_rb,5.523465e-02_rb,5.128759e-02_rb,4.676925e-02_rb, & + 4.266150e-02_rb,3.910561e-02_rb,3.605479e-02_rb,3.342843e-02_rb,3.115052e-02_rb, & + 2.915776e-02_rb,2.739935e-02_rb,2.583499e-02_rb,2.443266e-02_rb,2.316681e-02_rb, & + 2.201687e-02_rb,2.096619e-02_rb,2.000112e-02_rb,1.911044e-02_rb,1.828481e-02_rb, & + 1.751641e-02_rb,1.679866e-02_rb,1.612598e-02_rb,1.549360e-02_rb,1.489742e-02_rb, & + 1.433392e-02_rb,1.380002e-02_rb,1.329305e-02_rb,1.281068e-02_rb,1.235084e-02_rb, & + 1.191172e-02_rb,1.149171e-02_rb,1.108936e-02_rb,1.070341e-02_rb,1.033271e-02_rb, & + 9.976220e-03_rb,9.633021e-03_rb,9.302273e-03_rb,8.983216e-03_rb,8.675161e-03_rb, & + 8.377478e-03_rb,8.089595e-03_rb,7.810986e-03_rb,7.541170e-03_rb,7.279706e-03_rb, & + 7.026186e-03_rb/) + absice3(:,8) = (/ & +! band 8 + 6.711058e-02_rb,6.918198e-02_rb,6.127484e-02_rb,5.411944e-02_rb,4.836902e-02_rb, & + 4.375293e-02_rb,3.998077e-02_rb,3.683587e-02_rb,3.416508e-02_rb,3.186003e-02_rb, & + 2.984290e-02_rb,2.805671e-02_rb,2.645895e-02_rb,2.501733e-02_rb,2.370689e-02_rb, & + 2.250808e-02_rb,2.140532e-02_rb,2.038609e-02_rb,1.944018e-02_rb,1.855918e-02_rb, & + 1.773609e-02_rb,1.696504e-02_rb,1.624106e-02_rb,1.555990e-02_rb,1.491793e-02_rb, & + 1.431197e-02_rb,1.373928e-02_rb,1.319743e-02_rb,1.268430e-02_rb,1.219799e-02_rb, & + 1.173682e-02_rb,1.129925e-02_rb,1.088393e-02_rb,1.048961e-02_rb,1.011516e-02_rb, & + 9.759543e-03_rb,9.421813e-03_rb,9.101089e-03_rb,8.796559e-03_rb,8.507464e-03_rb, & + 8.233098e-03_rb,7.972798e-03_rb,7.725942e-03_rb,7.491940e-03_rb,7.270238e-03_rb, & + 7.060305e-03_rb/) + absice3(:,9) = (/ & +! band 9 + 1.236780e-01_rb,9.222386e-02_rb,7.383997e-02_rb,6.204072e-02_rb,5.381029e-02_rb, & + 4.770678e-02_rb,4.296928e-02_rb,3.916131e-02_rb,3.601540e-02_rb,3.335878e-02_rb, & + 3.107493e-02_rb,2.908247e-02_rb,2.732282e-02_rb,2.575276e-02_rb,2.433968e-02_rb, & + 2.305852e-02_rb,2.188966e-02_rb,2.081757e-02_rb,1.982974e-02_rb,1.891599e-02_rb, & + 1.806794e-02_rb,1.727865e-02_rb,1.654227e-02_rb,1.585387e-02_rb,1.520924e-02_rb, & + 1.460476e-02_rb,1.403730e-02_rb,1.350416e-02_rb,1.300293e-02_rb,1.253153e-02_rb, & + 1.208808e-02_rb,1.167094e-02_rb,1.127862e-02_rb,1.090979e-02_rb,1.056323e-02_rb, & + 1.023786e-02_rb,9.932665e-03_rb,9.646744e-03_rb,9.379250e-03_rb,9.129409e-03_rb, & + 8.896500e-03_rb,8.679856e-03_rb,8.478852e-03_rb,8.292904e-03_rb,8.121463e-03_rb, & + 7.964013e-03_rb/) + absice3(:,10) = (/ & +! band 10 + 1.655966e-01_rb,1.134205e-01_rb,8.714344e-02_rb,7.129241e-02_rb,6.063739e-02_rb, & + 5.294203e-02_rb,4.709309e-02_rb,4.247476e-02_rb,3.871892e-02_rb,3.559206e-02_rb, & + 3.293893e-02_rb,3.065226e-02_rb,2.865558e-02_rb,2.689288e-02_rb,2.532221e-02_rb, & + 2.391150e-02_rb,2.263582e-02_rb,2.147549e-02_rb,2.041476e-02_rb,1.944089e-02_rb, & + 1.854342e-02_rb,1.771371e-02_rb,1.694456e-02_rb,1.622989e-02_rb,1.556456e-02_rb, & + 1.494415e-02_rb,1.436491e-02_rb,1.382354e-02_rb,1.331719e-02_rb,1.284339e-02_rb, & + 1.239992e-02_rb,1.198486e-02_rb,1.159647e-02_rb,1.123323e-02_rb,1.089375e-02_rb, & + 1.057679e-02_rb,1.028124e-02_rb,1.000607e-02_rb,9.750376e-03_rb,9.513303e-03_rb, & + 9.294082e-03_rb,9.092003e-03_rb,8.906412e-03_rb,8.736702e-03_rb,8.582314e-03_rb, & + 8.442725e-03_rb/) + absice3(:,11) = (/ & +! band 11 + 1.775615e-01_rb,1.180046e-01_rb,8.929607e-02_rb,7.233500e-02_rb,6.108333e-02_rb, & + 5.303642e-02_rb,4.696927e-02_rb,4.221206e-02_rb,3.836768e-02_rb,3.518576e-02_rb, & + 3.250063e-02_rb,3.019825e-02_rb,2.819758e-02_rb,2.643943e-02_rb,2.487953e-02_rb, & + 2.348414e-02_rb,2.222705e-02_rb,2.108762e-02_rb,2.004936e-02_rb,1.909892e-02_rb, & + 1.822539e-02_rb,1.741975e-02_rb,1.667449e-02_rb,1.598330e-02_rb,1.534084e-02_rb, & + 1.474253e-02_rb,1.418446e-02_rb,1.366325e-02_rb,1.317597e-02_rb,1.272004e-02_rb, & + 1.229321e-02_rb,1.189350e-02_rb,1.151915e-02_rb,1.116859e-02_rb,1.084042e-02_rb, & + 1.053338e-02_rb,1.024636e-02_rb,9.978326e-03_rb,9.728357e-03_rb,9.495613e-03_rb, & + 9.279327e-03_rb,9.078798e-03_rb,8.893383e-03_rb,8.722488e-03_rb,8.565568e-03_rb, & + 8.422115e-03_rb/) + absice3(:,12) = (/ & +! band 12 + 9.465447e-02_rb,6.432047e-02_rb,5.060973e-02_rb,4.267283e-02_rb,3.741843e-02_rb, & + 3.363096e-02_rb,3.073531e-02_rb,2.842405e-02_rb,2.651789e-02_rb,2.490518e-02_rb, & + 2.351273e-02_rb,2.229056e-02_rb,2.120335e-02_rb,2.022541e-02_rb,1.933763e-02_rb, & + 1.852546e-02_rb,1.777763e-02_rb,1.708528e-02_rb,1.644134e-02_rb,1.584009e-02_rb, & + 1.527684e-02_rb,1.474774e-02_rb,1.424955e-02_rb,1.377957e-02_rb,1.333549e-02_rb, & + 1.291534e-02_rb,1.251743e-02_rb,1.214029e-02_rb,1.178265e-02_rb,1.144337e-02_rb, & + 1.112148e-02_rb,1.081609e-02_rb,1.052642e-02_rb,1.025178e-02_rb,9.991540e-03_rb, & + 9.745130e-03_rb,9.512038e-03_rb,9.291797e-03_rb,9.083980e-03_rb,8.888195e-03_rb, & + 8.704081e-03_rb,8.531306e-03_rb,8.369560e-03_rb,8.218558e-03_rb,8.078032e-03_rb, & + 7.947730e-03_rb/) + absice3(:,13) = (/ & +! band 13 + 1.560311e-01_rb,9.961097e-02_rb,7.502949e-02_rb,6.115022e-02_rb,5.214952e-02_rb, & + 4.578149e-02_rb,4.099731e-02_rb,3.724174e-02_rb,3.419343e-02_rb,3.165356e-02_rb, & + 2.949251e-02_rb,2.762222e-02_rb,2.598073e-02_rb,2.452322e-02_rb,2.321642e-02_rb, & + 2.203516e-02_rb,2.096002e-02_rb,1.997579e-02_rb,1.907036e-02_rb,1.823401e-02_rb, & + 1.745879e-02_rb,1.673819e-02_rb,1.606678e-02_rb,1.544003e-02_rb,1.485411e-02_rb, & + 1.430574e-02_rb,1.379215e-02_rb,1.331092e-02_rb,1.285996e-02_rb,1.243746e-02_rb, & + 1.204183e-02_rb,1.167164e-02_rb,1.132567e-02_rb,1.100281e-02_rb,1.070207e-02_rb, & + 1.042258e-02_rb,1.016352e-02_rb,9.924197e-03_rb,9.703953e-03_rb,9.502199e-03_rb, & + 9.318400e-03_rb,9.152066e-03_rb,9.002749e-03_rb,8.870038e-03_rb,8.753555e-03_rb, & + 8.652951e-03_rb/) + absice3(:,14) = (/ & +! band 14 + 1.559547e-01_rb,9.896700e-02_rb,7.441231e-02_rb,6.061469e-02_rb,5.168730e-02_rb, & + 4.537821e-02_rb,4.064106e-02_rb,3.692367e-02_rb,3.390714e-02_rb,3.139438e-02_rb, & + 2.925702e-02_rb,2.740783e-02_rb,2.578547e-02_rb,2.434552e-02_rb,2.305506e-02_rb, & + 2.188910e-02_rb,2.082842e-02_rb,1.985789e-02_rb,1.896553e-02_rb,1.814165e-02_rb, & + 1.737839e-02_rb,1.666927e-02_rb,1.600891e-02_rb,1.539279e-02_rb,1.481712e-02_rb, & + 1.427865e-02_rb,1.377463e-02_rb,1.330266e-02_rb,1.286068e-02_rb,1.244689e-02_rb, & + 1.205973e-02_rb,1.169780e-02_rb,1.135989e-02_rb,1.104492e-02_rb,1.075192e-02_rb, & + 1.048004e-02_rb,1.022850e-02_rb,9.996611e-03_rb,9.783753e-03_rb,9.589361e-03_rb, & + 9.412924e-03_rb,9.253977e-03_rb,9.112098e-03_rb,8.986903e-03_rb,8.878039e-03_rb, & + 8.785184e-03_rb/) + absice3(:,15) = (/ & +! band 15 + 1.102926e-01_rb,7.176622e-02_rb,5.530316e-02_rb,4.606056e-02_rb,4.006116e-02_rb, & + 3.579628e-02_rb,3.256909e-02_rb,3.001360e-02_rb,2.791920e-02_rb,2.615617e-02_rb, & + 2.464023e-02_rb,2.331426e-02_rb,2.213817e-02_rb,2.108301e-02_rb,2.012733e-02_rb, & + 1.925493e-02_rb,1.845331e-02_rb,1.771269e-02_rb,1.702531e-02_rb,1.638493e-02_rb, & + 1.578648e-02_rb,1.522579e-02_rb,1.469940e-02_rb,1.420442e-02_rb,1.373841e-02_rb, & + 1.329931e-02_rb,1.288535e-02_rb,1.249502e-02_rb,1.212700e-02_rb,1.178015e-02_rb, & + 1.145348e-02_rb,1.114612e-02_rb,1.085730e-02_rb,1.058633e-02_rb,1.033263e-02_rb, & + 1.009564e-02_rb,9.874895e-03_rb,9.669960e-03_rb,9.480449e-03_rb,9.306014e-03_rb, & + 9.146339e-03_rb,9.001138e-03_rb,8.870154e-03_rb,8.753148e-03_rb,8.649907e-03_rb, & + 8.560232e-03_rb/) + absice3(:,16) = (/ & +! band 16 + 1.688344e-01_rb,1.077072e-01_rb,7.994467e-02_rb,6.403862e-02_rb,5.369850e-02_rb, & + 4.641582e-02_rb,4.099331e-02_rb,3.678724e-02_rb,3.342069e-02_rb,3.065831e-02_rb, & + 2.834557e-02_rb,2.637680e-02_rb,2.467733e-02_rb,2.319286e-02_rb,2.188299e-02_rb, & + 2.071701e-02_rb,1.967121e-02_rb,1.872692e-02_rb,1.786931e-02_rb,1.708641e-02_rb, & + 1.636846e-02_rb,1.570743e-02_rb,1.509665e-02_rb,1.453052e-02_rb,1.400433e-02_rb, & + 1.351407e-02_rb,1.305631e-02_rb,1.262810e-02_rb,1.222688e-02_rb,1.185044e-02_rb, & + 1.149683e-02_rb,1.116436e-02_rb,1.085153e-02_rb,1.055701e-02_rb,1.027961e-02_rb, & + 1.001831e-02_rb,9.772141e-03_rb,9.540280e-03_rb,9.321966e-03_rb,9.116517e-03_rb, & + 8.923315e-03_rb,8.741803e-03_rb,8.571472e-03_rb,8.411860e-03_rb,8.262543e-03_rb, & + 8.123136e-03_rb/) + +! For LIQFLAG = 0. + absliq0 = 0.0903614_rb + +! For LIQFLAG = 1. In each band, the absorption +! coefficients are listed for a range of effective radii from 2.5 +! to 59.5 microns in increments of 1.0 micron. + absliq1(:, 1) = (/ & +! band 1 + 1.64047e-03_rb, 6.90533e-02_rb, 7.72017e-02_rb, 7.78054e-02_rb, 7.69523e-02_rb, & + 7.58058e-02_rb, 7.46400e-02_rb, 7.35123e-02_rb, 7.24162e-02_rb, 7.13225e-02_rb, & + 6.99145e-02_rb, 6.66409e-02_rb, 6.36582e-02_rb, 6.09425e-02_rb, 5.84593e-02_rb, & + 5.61743e-02_rb, 5.40571e-02_rb, 5.20812e-02_rb, 5.02245e-02_rb, 4.84680e-02_rb, & + 4.67959e-02_rb, 4.51944e-02_rb, 4.36516e-02_rb, 4.21570e-02_rb, 4.07015e-02_rb, & + 3.92766e-02_rb, 3.78747e-02_rb, 3.64886e-02_rb, 3.53632e-02_rb, 3.41992e-02_rb, & + 3.31016e-02_rb, 3.20643e-02_rb, 3.10817e-02_rb, 3.01490e-02_rb, 2.92620e-02_rb, & + 2.84171e-02_rb, 2.76108e-02_rb, 2.68404e-02_rb, 2.61031e-02_rb, 2.53966e-02_rb, & + 2.47189e-02_rb, 2.40678e-02_rb, 2.34418e-02_rb, 2.28392e-02_rb, 2.22586e-02_rb, & + 2.16986e-02_rb, 2.11580e-02_rb, 2.06356e-02_rb, 2.01305e-02_rb, 1.96417e-02_rb, & + 1.91682e-02_rb, 1.87094e-02_rb, 1.82643e-02_rb, 1.78324e-02_rb, 1.74129e-02_rb, & + 1.70052e-02_rb, 1.66088e-02_rb, 1.62231e-02_rb/) + absliq1(:, 2) = (/ & +! band 2 + 2.19486e-01_rb, 1.80687e-01_rb, 1.59150e-01_rb, 1.44731e-01_rb, 1.33703e-01_rb, & + 1.24355e-01_rb, 1.15756e-01_rb, 1.07318e-01_rb, 9.86119e-02_rb, 8.92739e-02_rb, & + 8.34911e-02_rb, 7.70773e-02_rb, 7.15240e-02_rb, 6.66615e-02_rb, 6.23641e-02_rb, & + 5.85359e-02_rb, 5.51020e-02_rb, 5.20032e-02_rb, 4.91916e-02_rb, 4.66283e-02_rb, & + 4.42813e-02_rb, 4.21236e-02_rb, 4.01330e-02_rb, 3.82905e-02_rb, 3.65797e-02_rb, & + 3.49869e-02_rb, 3.35002e-02_rb, 3.21090e-02_rb, 3.08957e-02_rb, 2.97601e-02_rb, & + 2.86966e-02_rb, 2.76984e-02_rb, 2.67599e-02_rb, 2.58758e-02_rb, 2.50416e-02_rb, & + 2.42532e-02_rb, 2.35070e-02_rb, 2.27997e-02_rb, 2.21284e-02_rb, 2.14904e-02_rb, & + 2.08834e-02_rb, 2.03051e-02_rb, 1.97536e-02_rb, 1.92271e-02_rb, 1.87239e-02_rb, & + 1.82425e-02_rb, 1.77816e-02_rb, 1.73399e-02_rb, 1.69162e-02_rb, 1.65094e-02_rb, & + 1.61187e-02_rb, 1.57430e-02_rb, 1.53815e-02_rb, 1.50334e-02_rb, 1.46981e-02_rb, & + 1.43748e-02_rb, 1.40628e-02_rb, 1.37617e-02_rb/) + absliq1(:, 3) = (/ & +! band 3 + 2.95174e-01_rb, 2.34765e-01_rb, 1.98038e-01_rb, 1.72114e-01_rb, 1.52083e-01_rb, & + 1.35654e-01_rb, 1.21613e-01_rb, 1.09252e-01_rb, 9.81263e-02_rb, 8.79448e-02_rb, & + 8.12566e-02_rb, 7.44563e-02_rb, 6.86374e-02_rb, 6.36042e-02_rb, 5.92094e-02_rb, & + 5.53402e-02_rb, 5.19087e-02_rb, 4.88455e-02_rb, 4.60951e-02_rb, 4.36124e-02_rb, & + 4.13607e-02_rb, 3.93096e-02_rb, 3.74338e-02_rb, 3.57119e-02_rb, 3.41261e-02_rb, & + 3.26610e-02_rb, 3.13036e-02_rb, 3.00425e-02_rb, 2.88497e-02_rb, 2.78077e-02_rb, & + 2.68317e-02_rb, 2.59158e-02_rb, 2.50545e-02_rb, 2.42430e-02_rb, 2.34772e-02_rb, & + 2.27533e-02_rb, 2.20679e-02_rb, 2.14181e-02_rb, 2.08011e-02_rb, 2.02145e-02_rb, & + 1.96561e-02_rb, 1.91239e-02_rb, 1.86161e-02_rb, 1.81311e-02_rb, 1.76673e-02_rb, & + 1.72234e-02_rb, 1.67981e-02_rb, 1.63903e-02_rb, 1.59989e-02_rb, 1.56230e-02_rb, & + 1.52615e-02_rb, 1.49138e-02_rb, 1.45791e-02_rb, 1.42565e-02_rb, 1.39455e-02_rb, & + 1.36455e-02_rb, 1.33559e-02_rb, 1.30761e-02_rb/) + absliq1(:, 4) = (/ & +! band 4 + 3.00925e-01_rb, 2.36949e-01_rb, 1.96947e-01_rb, 1.68692e-01_rb, 1.47190e-01_rb, & + 1.29986e-01_rb, 1.15719e-01_rb, 1.03568e-01_rb, 9.30028e-02_rb, 8.36658e-02_rb, & + 7.71075e-02_rb, 7.07002e-02_rb, 6.52284e-02_rb, 6.05024e-02_rb, 5.63801e-02_rb, & + 5.27534e-02_rb, 4.95384e-02_rb, 4.66690e-02_rb, 4.40925e-02_rb, 4.17664e-02_rb, & + 3.96559e-02_rb, 3.77326e-02_rb, 3.59727e-02_rb, 3.43561e-02_rb, 3.28662e-02_rb, & + 3.14885e-02_rb, 3.02110e-02_rb, 2.90231e-02_rb, 2.78948e-02_rb, 2.69109e-02_rb, & + 2.59884e-02_rb, 2.51217e-02_rb, 2.43058e-02_rb, 2.35364e-02_rb, 2.28096e-02_rb, & + 2.21218e-02_rb, 2.14700e-02_rb, 2.08515e-02_rb, 2.02636e-02_rb, 1.97041e-02_rb, & + 1.91711e-02_rb, 1.86625e-02_rb, 1.81769e-02_rb, 1.77126e-02_rb, 1.72683e-02_rb, & + 1.68426e-02_rb, 1.64344e-02_rb, 1.60427e-02_rb, 1.56664e-02_rb, 1.53046e-02_rb, & + 1.49565e-02_rb, 1.46214e-02_rb, 1.42985e-02_rb, 1.39871e-02_rb, 1.36866e-02_rb, & + 1.33965e-02_rb, 1.31162e-02_rb, 1.28453e-02_rb/) + absliq1(:, 5) = (/ & +! band 5 + 2.64691e-01_rb, 2.12018e-01_rb, 1.78009e-01_rb, 1.53539e-01_rb, 1.34721e-01_rb, & + 1.19580e-01_rb, 1.06996e-01_rb, 9.62772e-02_rb, 8.69710e-02_rb, 7.87670e-02_rb, & + 7.29272e-02_rb, 6.70920e-02_rb, 6.20977e-02_rb, 5.77732e-02_rb, 5.39910e-02_rb, & + 5.06538e-02_rb, 4.76866e-02_rb, 4.50301e-02_rb, 4.26374e-02_rb, 4.04704e-02_rb, & + 3.84981e-02_rb, 3.66948e-02_rb, 3.50394e-02_rb, 3.35141e-02_rb, 3.21038e-02_rb, & + 3.07957e-02_rb, 2.95788e-02_rb, 2.84438e-02_rb, 2.73790e-02_rb, 2.64390e-02_rb, & + 2.55565e-02_rb, 2.47263e-02_rb, 2.39437e-02_rb, 2.32047e-02_rb, 2.25056e-02_rb, & + 2.18433e-02_rb, 2.12149e-02_rb, 2.06177e-02_rb, 2.00495e-02_rb, 1.95081e-02_rb, & + 1.89917e-02_rb, 1.84984e-02_rb, 1.80269e-02_rb, 1.75755e-02_rb, 1.71431e-02_rb, & + 1.67283e-02_rb, 1.63303e-02_rb, 1.59478e-02_rb, 1.55801e-02_rb, 1.52262e-02_rb, & + 1.48853e-02_rb, 1.45568e-02_rb, 1.42400e-02_rb, 1.39342e-02_rb, 1.36388e-02_rb, & + 1.33533e-02_rb, 1.30773e-02_rb, 1.28102e-02_rb/) + absliq1(:, 6) = (/ & +! band 6 + 8.81182e-02_rb, 1.06745e-01_rb, 9.79753e-02_rb, 8.99625e-02_rb, 8.35200e-02_rb, & + 7.81899e-02_rb, 7.35939e-02_rb, 6.94696e-02_rb, 6.56266e-02_rb, 6.19148e-02_rb, & + 5.83355e-02_rb, 5.49306e-02_rb, 5.19642e-02_rb, 4.93325e-02_rb, 4.69659e-02_rb, & + 4.48148e-02_rb, 4.28431e-02_rb, 4.10231e-02_rb, 3.93332e-02_rb, 3.77563e-02_rb, & + 3.62785e-02_rb, 3.48882e-02_rb, 3.35758e-02_rb, 3.23333e-02_rb, 3.11536e-02_rb, & + 3.00310e-02_rb, 2.89601e-02_rb, 2.79365e-02_rb, 2.70502e-02_rb, 2.62618e-02_rb, & + 2.55025e-02_rb, 2.47728e-02_rb, 2.40726e-02_rb, 2.34013e-02_rb, 2.27583e-02_rb, & + 2.21422e-02_rb, 2.15522e-02_rb, 2.09869e-02_rb, 2.04453e-02_rb, 1.99260e-02_rb, & + 1.94280e-02_rb, 1.89501e-02_rb, 1.84913e-02_rb, 1.80506e-02_rb, 1.76270e-02_rb, & + 1.72196e-02_rb, 1.68276e-02_rb, 1.64500e-02_rb, 1.60863e-02_rb, 1.57357e-02_rb, & + 1.53975e-02_rb, 1.50710e-02_rb, 1.47558e-02_rb, 1.44511e-02_rb, 1.41566e-02_rb, & + 1.38717e-02_rb, 1.35960e-02_rb, 1.33290e-02_rb/) + absliq1(:, 7) = (/ & +! band 7 + 4.32174e-02_rb, 7.36078e-02_rb, 6.98340e-02_rb, 6.65231e-02_rb, 6.41948e-02_rb, & + 6.23551e-02_rb, 6.06638e-02_rb, 5.88680e-02_rb, 5.67124e-02_rb, 5.38629e-02_rb, & + 4.99579e-02_rb, 4.86289e-02_rb, 4.70120e-02_rb, 4.52854e-02_rb, 4.35466e-02_rb, & + 4.18480e-02_rb, 4.02169e-02_rb, 3.86658e-02_rb, 3.71992e-02_rb, 3.58168e-02_rb, & + 3.45155e-02_rb, 3.32912e-02_rb, 3.21390e-02_rb, 3.10538e-02_rb, 3.00307e-02_rb, & + 2.90651e-02_rb, 2.81524e-02_rb, 2.72885e-02_rb, 2.62821e-02_rb, 2.55744e-02_rb, & + 2.48799e-02_rb, 2.42029e-02_rb, 2.35460e-02_rb, 2.29108e-02_rb, 2.22981e-02_rb, & + 2.17079e-02_rb, 2.11402e-02_rb, 2.05945e-02_rb, 2.00701e-02_rb, 1.95663e-02_rb, & + 1.90824e-02_rb, 1.86174e-02_rb, 1.81706e-02_rb, 1.77411e-02_rb, 1.73281e-02_rb, & + 1.69307e-02_rb, 1.65483e-02_rb, 1.61801e-02_rb, 1.58254e-02_rb, 1.54835e-02_rb, & + 1.51538e-02_rb, 1.48358e-02_rb, 1.45288e-02_rb, 1.42322e-02_rb, 1.39457e-02_rb, & + 1.36687e-02_rb, 1.34008e-02_rb, 1.31416e-02_rb/) + absliq1(:, 8) = (/ & +! band 8 + 1.41881e-01_rb, 7.15419e-02_rb, 6.30335e-02_rb, 6.11132e-02_rb, 6.01931e-02_rb, & + 5.92420e-02_rb, 5.78968e-02_rb, 5.58876e-02_rb, 5.28923e-02_rb, 4.84462e-02_rb, & + 4.60839e-02_rb, 4.56013e-02_rb, 4.45410e-02_rb, 4.31866e-02_rb, 4.17026e-02_rb, & + 4.01850e-02_rb, 3.86892e-02_rb, 3.72461e-02_rb, 3.58722e-02_rb, 3.45749e-02_rb, & + 3.33564e-02_rb, 3.22155e-02_rb, 3.11494e-02_rb, 3.01541e-02_rb, 2.92253e-02_rb, & + 2.83584e-02_rb, 2.75488e-02_rb, 2.67925e-02_rb, 2.57692e-02_rb, 2.50704e-02_rb, & + 2.43918e-02_rb, 2.37350e-02_rb, 2.31005e-02_rb, 2.24888e-02_rb, 2.18996e-02_rb, & + 2.13325e-02_rb, 2.07870e-02_rb, 2.02623e-02_rb, 1.97577e-02_rb, 1.92724e-02_rb, & + 1.88056e-02_rb, 1.83564e-02_rb, 1.79241e-02_rb, 1.75079e-02_rb, 1.71070e-02_rb, & + 1.67207e-02_rb, 1.63482e-02_rb, 1.59890e-02_rb, 1.56424e-02_rb, 1.53077e-02_rb, & + 1.49845e-02_rb, 1.46722e-02_rb, 1.43702e-02_rb, 1.40782e-02_rb, 1.37955e-02_rb, & + 1.35219e-02_rb, 1.32569e-02_rb, 1.30000e-02_rb/) + absliq1(:, 9) = (/ & +! band 9 + 6.72726e-02_rb, 6.61013e-02_rb, 6.47866e-02_rb, 6.33780e-02_rb, 6.18985e-02_rb, & + 6.03335e-02_rb, 5.86136e-02_rb, 5.65876e-02_rb, 5.39839e-02_rb, 5.03536e-02_rb, & + 4.71608e-02_rb, 4.63630e-02_rb, 4.50313e-02_rb, 4.34526e-02_rb, 4.17876e-02_rb, & + 4.01261e-02_rb, 3.85171e-02_rb, 3.69860e-02_rb, 3.55442e-02_rb, 3.41954e-02_rb, & + 3.29384e-02_rb, 3.17693e-02_rb, 3.06832e-02_rb, 2.96745e-02_rb, 2.87374e-02_rb, & + 2.78662e-02_rb, 2.70557e-02_rb, 2.63008e-02_rb, 2.52450e-02_rb, 2.45424e-02_rb, & + 2.38656e-02_rb, 2.32144e-02_rb, 2.25885e-02_rb, 2.19873e-02_rb, 2.14099e-02_rb, & + 2.08554e-02_rb, 2.03230e-02_rb, 1.98116e-02_rb, 1.93203e-02_rb, 1.88482e-02_rb, & + 1.83944e-02_rb, 1.79578e-02_rb, 1.75378e-02_rb, 1.71335e-02_rb, 1.67440e-02_rb, & + 1.63687e-02_rb, 1.60069e-02_rb, 1.56579e-02_rb, 1.53210e-02_rb, 1.49958e-02_rb, & + 1.46815e-02_rb, 1.43778e-02_rb, 1.40841e-02_rb, 1.37999e-02_rb, 1.35249e-02_rb, & + 1.32585e-02_rb, 1.30004e-02_rb, 1.27502e-02_rb/) + absliq1(:,10) = (/ & +! band 10 + 7.97040e-02_rb, 7.63844e-02_rb, 7.36499e-02_rb, 7.13525e-02_rb, 6.93043e-02_rb, & + 6.72807e-02_rb, 6.50227e-02_rb, 6.22395e-02_rb, 5.86093e-02_rb, 5.37815e-02_rb, & + 5.14682e-02_rb, 4.97214e-02_rb, 4.77392e-02_rb, 4.56961e-02_rb, 4.36858e-02_rb, & + 4.17569e-02_rb, 3.99328e-02_rb, 3.82224e-02_rb, 3.66265e-02_rb, 3.51416e-02_rb, & + 3.37617e-02_rb, 3.24798e-02_rb, 3.12887e-02_rb, 3.01812e-02_rb, 2.91505e-02_rb, & + 2.81900e-02_rb, 2.72939e-02_rb, 2.64568e-02_rb, 2.54165e-02_rb, 2.46832e-02_rb, & + 2.39783e-02_rb, 2.33017e-02_rb, 2.26531e-02_rb, 2.20314e-02_rb, 2.14359e-02_rb, & + 2.08653e-02_rb, 2.03187e-02_rb, 1.97947e-02_rb, 1.92924e-02_rb, 1.88106e-02_rb, & + 1.83483e-02_rb, 1.79043e-02_rb, 1.74778e-02_rb, 1.70678e-02_rb, 1.66735e-02_rb, & + 1.62941e-02_rb, 1.59286e-02_rb, 1.55766e-02_rb, 1.52371e-02_rb, 1.49097e-02_rb, & + 1.45937e-02_rb, 1.42885e-02_rb, 1.39936e-02_rb, 1.37085e-02_rb, 1.34327e-02_rb, & + 1.31659e-02_rb, 1.29075e-02_rb, 1.26571e-02_rb/) + absliq1(:,11) = (/ & +! band 11 + 1.49438e-01_rb, 1.33535e-01_rb, 1.21542e-01_rb, 1.11743e-01_rb, 1.03263e-01_rb, & + 9.55774e-02_rb, 8.83382e-02_rb, 8.12943e-02_rb, 7.42533e-02_rb, 6.70609e-02_rb, & + 6.38761e-02_rb, 5.97788e-02_rb, 5.59841e-02_rb, 5.25318e-02_rb, 4.94132e-02_rb, & + 4.66014e-02_rb, 4.40644e-02_rb, 4.17706e-02_rb, 3.96910e-02_rb, 3.77998e-02_rb, & + 3.60742e-02_rb, 3.44947e-02_rb, 3.30442e-02_rb, 3.17079e-02_rb, 3.04730e-02_rb, & + 2.93283e-02_rb, 2.82642e-02_rb, 2.72720e-02_rb, 2.61789e-02_rb, 2.53277e-02_rb, & + 2.45237e-02_rb, 2.37635e-02_rb, 2.30438e-02_rb, 2.23615e-02_rb, 2.17140e-02_rb, & + 2.10987e-02_rb, 2.05133e-02_rb, 1.99557e-02_rb, 1.94241e-02_rb, 1.89166e-02_rb, & + 1.84317e-02_rb, 1.79679e-02_rb, 1.75238e-02_rb, 1.70983e-02_rb, 1.66901e-02_rb, & + 1.62983e-02_rb, 1.59219e-02_rb, 1.55599e-02_rb, 1.52115e-02_rb, 1.48761e-02_rb, & + 1.45528e-02_rb, 1.42411e-02_rb, 1.39402e-02_rb, 1.36497e-02_rb, 1.33690e-02_rb, & + 1.30976e-02_rb, 1.28351e-02_rb, 1.25810e-02_rb/) + absliq1(:,12) = (/ & +! band 12 + 3.71985e-02_rb, 3.88586e-02_rb, 3.99070e-02_rb, 4.04351e-02_rb, 4.04610e-02_rb, & + 3.99834e-02_rb, 3.89953e-02_rb, 3.74886e-02_rb, 3.54551e-02_rb, 3.28870e-02_rb, & + 3.32576e-02_rb, 3.22444e-02_rb, 3.12384e-02_rb, 3.02584e-02_rb, 2.93146e-02_rb, & + 2.84120e-02_rb, 2.75525e-02_rb, 2.67361e-02_rb, 2.59618e-02_rb, 2.52280e-02_rb, & + 2.45327e-02_rb, 2.38736e-02_rb, 2.32487e-02_rb, 2.26558e-02_rb, 2.20929e-02_rb, & + 2.15579e-02_rb, 2.10491e-02_rb, 2.05648e-02_rb, 1.99749e-02_rb, 1.95704e-02_rb, & + 1.91731e-02_rb, 1.87839e-02_rb, 1.84032e-02_rb, 1.80315e-02_rb, 1.76689e-02_rb, & + 1.73155e-02_rb, 1.69712e-02_rb, 1.66362e-02_rb, 1.63101e-02_rb, 1.59928e-02_rb, & + 1.56842e-02_rb, 1.53840e-02_rb, 1.50920e-02_rb, 1.48080e-02_rb, 1.45318e-02_rb, & + 1.42631e-02_rb, 1.40016e-02_rb, 1.37472e-02_rb, 1.34996e-02_rb, 1.32586e-02_rb, & + 1.30239e-02_rb, 1.27954e-02_rb, 1.25728e-02_rb, 1.23559e-02_rb, 1.21445e-02_rb, & + 1.19385e-02_rb, 1.17376e-02_rb, 1.15417e-02_rb/) + + absliq1(:,13) = (/ & +! band 13 + 3.11868e-02_rb, 4.48357e-02_rb, 4.90224e-02_rb, 4.96406e-02_rb, 4.86806e-02_rb, & + 4.69610e-02_rb, 4.48630e-02_rb, 4.25795e-02_rb, 4.02138e-02_rb, 3.78236e-02_rb, & + 3.74266e-02_rb, 3.60384e-02_rb, 3.47074e-02_rb, 3.34434e-02_rb, 3.22499e-02_rb, & + 3.11264e-02_rb, 3.00704e-02_rb, 2.90784e-02_rb, 2.81463e-02_rb, 2.72702e-02_rb, & + 2.64460e-02_rb, 2.56698e-02_rb, 2.49381e-02_rb, 2.42475e-02_rb, 2.35948e-02_rb, & + 2.29774e-02_rb, 2.23925e-02_rb, 2.18379e-02_rb, 2.11793e-02_rb, 2.07076e-02_rb, & + 2.02470e-02_rb, 1.97981e-02_rb, 1.93613e-02_rb, 1.89367e-02_rb, 1.85243e-02_rb, & + 1.81240e-02_rb, 1.77356e-02_rb, 1.73588e-02_rb, 1.69935e-02_rb, 1.66392e-02_rb, & + 1.62956e-02_rb, 1.59624e-02_rb, 1.56393e-02_rb, 1.53259e-02_rb, 1.50219e-02_rb, & + 1.47268e-02_rb, 1.44404e-02_rb, 1.41624e-02_rb, 1.38925e-02_rb, 1.36302e-02_rb, & + 1.33755e-02_rb, 1.31278e-02_rb, 1.28871e-02_rb, 1.26530e-02_rb, 1.24253e-02_rb, & + 1.22038e-02_rb, 1.19881e-02_rb, 1.17782e-02_rb/) + absliq1(:,14) = (/ & +! band 14 + 1.58988e-02_rb, 3.50652e-02_rb, 4.00851e-02_rb, 4.07270e-02_rb, 3.98101e-02_rb, & + 3.83306e-02_rb, 3.66829e-02_rb, 3.50327e-02_rb, 3.34497e-02_rb, 3.19609e-02_rb, & + 3.13712e-02_rb, 3.03348e-02_rb, 2.93415e-02_rb, 2.83973e-02_rb, 2.75037e-02_rb, & + 2.66604e-02_rb, 2.58654e-02_rb, 2.51161e-02_rb, 2.44100e-02_rb, 2.37440e-02_rb, & + 2.31154e-02_rb, 2.25215e-02_rb, 2.19599e-02_rb, 2.14282e-02_rb, 2.09242e-02_rb, & + 2.04459e-02_rb, 1.99915e-02_rb, 1.95594e-02_rb, 1.90254e-02_rb, 1.86598e-02_rb, & + 1.82996e-02_rb, 1.79455e-02_rb, 1.75983e-02_rb, 1.72584e-02_rb, 1.69260e-02_rb, & + 1.66013e-02_rb, 1.62843e-02_rb, 1.59752e-02_rb, 1.56737e-02_rb, 1.53799e-02_rb, & + 1.50936e-02_rb, 1.48146e-02_rb, 1.45429e-02_rb, 1.42782e-02_rb, 1.40203e-02_rb, & + 1.37691e-02_rb, 1.35243e-02_rb, 1.32858e-02_rb, 1.30534e-02_rb, 1.28270e-02_rb, & + 1.26062e-02_rb, 1.23909e-02_rb, 1.21810e-02_rb, 1.19763e-02_rb, 1.17766e-02_rb, & + 1.15817e-02_rb, 1.13915e-02_rb, 1.12058e-02_rb/) + absliq1(:,15) = (/ & +! band 15 + 5.02079e-03_rb, 2.17615e-02_rb, 2.55449e-02_rb, 2.59484e-02_rb, 2.53650e-02_rb, & + 2.45281e-02_rb, 2.36843e-02_rb, 2.29159e-02_rb, 2.22451e-02_rb, 2.16716e-02_rb, & + 2.11451e-02_rb, 2.05817e-02_rb, 2.00454e-02_rb, 1.95372e-02_rb, 1.90567e-02_rb, & + 1.86028e-02_rb, 1.81742e-02_rb, 1.77693e-02_rb, 1.73866e-02_rb, 1.70244e-02_rb, & + 1.66815e-02_rb, 1.63563e-02_rb, 1.60477e-02_rb, 1.57544e-02_rb, 1.54755e-02_rb, & + 1.52097e-02_rb, 1.49564e-02_rb, 1.47146e-02_rb, 1.43684e-02_rb, 1.41728e-02_rb, & + 1.39762e-02_rb, 1.37797e-02_rb, 1.35838e-02_rb, 1.33891e-02_rb, 1.31961e-02_rb, & + 1.30051e-02_rb, 1.28164e-02_rb, 1.26302e-02_rb, 1.24466e-02_rb, 1.22659e-02_rb, & + 1.20881e-02_rb, 1.19131e-02_rb, 1.17412e-02_rb, 1.15723e-02_rb, 1.14063e-02_rb, & + 1.12434e-02_rb, 1.10834e-02_rb, 1.09264e-02_rb, 1.07722e-02_rb, 1.06210e-02_rb, & + 1.04725e-02_rb, 1.03269e-02_rb, 1.01839e-02_rb, 1.00436e-02_rb, 9.90593e-03_rb, & + 9.77080e-03_rb, 9.63818e-03_rb, 9.50800e-03_rb/) + absliq1(:,16) = (/ & +! band 16 + 5.64971e-02_rb, 9.04736e-02_rb, 8.11726e-02_rb, 7.05450e-02_rb, 6.20052e-02_rb, & + 5.54286e-02_rb, 5.03503e-02_rb, 4.63791e-02_rb, 4.32290e-02_rb, 4.06959e-02_rb, & + 3.74690e-02_rb, 3.52964e-02_rb, 3.33799e-02_rb, 3.16774e-02_rb, 3.01550e-02_rb, & + 2.87856e-02_rb, 2.75474e-02_rb, 2.64223e-02_rb, 2.53953e-02_rb, 2.44542e-02_rb, & + 2.35885e-02_rb, 2.27894e-02_rb, 2.20494e-02_rb, 2.13622e-02_rb, 2.07222e-02_rb, & + 2.01246e-02_rb, 1.95654e-02_rb, 1.90408e-02_rb, 1.84398e-02_rb, 1.80021e-02_rb, & + 1.75816e-02_rb, 1.71775e-02_rb, 1.67889e-02_rb, 1.64152e-02_rb, 1.60554e-02_rb, & + 1.57089e-02_rb, 1.53751e-02_rb, 1.50531e-02_rb, 1.47426e-02_rb, 1.44428e-02_rb, & + 1.41532e-02_rb, 1.38734e-02_rb, 1.36028e-02_rb, 1.33410e-02_rb, 1.30875e-02_rb, & + 1.28420e-02_rb, 1.26041e-02_rb, 1.23735e-02_rb, 1.21497e-02_rb, 1.19325e-02_rb, & + 1.17216e-02_rb, 1.15168e-02_rb, 1.13177e-02_rb, 1.11241e-02_rb, 1.09358e-02_rb, & + 1.07525e-02_rb, 1.05741e-02_rb, 1.04003e-02_rb/) + +!jm not thread safe hvrclc = '$Revision: 1.8 $' + + ncbands = 1 + +! This initialization is done in rrtmg_lw_subcol.F90. +! do lay = 1, nlayers +! do ig = 1, ngptlw +! taucmc(ig,lay) = 0.0_rb +! enddo +! enddo + +! Main layer loop + do lay = 1, nlayers + + do ig = 1, ngptlw + cwp = ciwpmc(ig,lay) + clwpmc(ig,lay) + cswpmc(ig,lay) + if (cldfmc(ig,lay) .ge. cldmin .and. & + & (cwp .ge. cldmin .or. taucmc(ig,lay) .ge. cldmin)) then + + +! Ice clouds and water clouds combined. + if (inflag .eq. 0) then +! Cloud optical depth already defined in taucmc, return to main program + return + + elseif(inflag .eq. 1) then + stop 'INFLAG = 1 OPTION NOT AVAILABLE WITH MCICA' +! cwp = ciwpmc(ig,lay) + clwpmc(ig,lay) +! taucmc(ig,lay) = abscld1 * cwp + +! Separate treatement of ice clouds and water clouds. + elseif(inflag .ge. 2) then + radice = reicmc(lay) + +! Calculation of absorption coefficients due to ice clouds. + if ((ciwpmc(ig,lay)+cswpmc(ig,lay)) .eq. 0.0_rb) then + abscoice(ig) = 0.0_rb + abscosno(ig) = 0.0_rb + + elseif (iceflag .eq. 0) then + if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL' + abscoice(ig) = absice0(1) + absice0(2)/radice + abscosno(ig) = 0.0_rb + + elseif (iceflag .eq. 1) then + if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop& + & 'ICE RADIUS OUT OF BOUNDS' + ncbands = 5 + ib = icb(ngb(ig)) + abscoice(ig) = absice1(1,ib) + absice1(2,ib)/radice + abscosno(ig) = 0.0_rb + +! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns + + elseif (iceflag .eq. 2) then + if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop& + & 'ICE RADIUS OUT OF BOUNDS' + ncbands = 16 + factor = (radice - 2._rb)/3._rb + index = int(factor) + if (index .eq. 43) index = 42 + fint = factor - float(index) + ib = ngb(ig) + abscoice(ig) = & + & absice2(index,ib) + fint * & + & (absice2(index+1,ib) - (absice2(index,ib))) + abscosno(ig) = 0.0_rb + +! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns + + elseif (iceflag .ge. 3) then + if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then + write(errmess,'(A,i5,i5,f8.2,f8.2)' ) & + & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & + & ,ig, lay, ciwpmc(ig,lay), radice + !mz call wrf_error_fatal(errmess) + end if + ncbands = 16 + factor = (radice - 2._rb)/3._rb + index = int(factor) + if (index .eq. 46) index = 45 + fint = factor - float(index) + ib = ngb(ig) + abscoice(ig) = & + & absice3(index,ib) + fint * & + & (absice3(index+1,ib) - (absice3(index,ib))) + abscosno(ig) = 0.0_rb + + endif + +!..Incorporate additional effects due to snow. + if (cswpmc(ig,lay).gt.0.0_rb .and. iceflag .eq. 5) then + radsno = resnmc(lay) + if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then + write(errmess,'(A,i5,i5,f8.2,f8.2)' ) & + & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & + & ,ig, lay, cswpmc(ig,lay), radsno + !mz call wrf_error_fatal(errmess) + end if + ncbands = 16 + factor = (radsno - 2._rb)/3._rb + index = int(factor) + if (index .eq. 46) index = 45 + fint = factor - float(index) + ib = ngb(ig) + abscosno(ig) = & + & absice3(index,ib) + fint * & + & (absice3(index+1,ib) - (absice3(index,ib))) + endif + + + +! Calculation of absorption coefficients due to water clouds. + if (clwpmc(ig,lay) .eq. 0.0_rb) then + abscoliq(ig) = 0.0_rb + + elseif (liqflag .eq. 0) then + abscoliq(ig) = absliq0 + + elseif (liqflag .eq. 1) then + radliq = relqmc(lay) + if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) stop & + & 'LIQUID EFFECTIVE RADIUS OUT OF BOUNDS' + index = int(radliq - 1.5_rb) + if (index .eq. 0) index = 1 + if (index .eq. 58) index = 57 + fint = radliq - 1.5_rb - float(index) + ib = ngb(ig) + abscoliq(ig) = & + & absliq1(index,ib) + fint * & + & (absliq1(index+1,ib) - (absliq1(index,ib))) + endif + + taucmc(ig,lay) = ciwpmc(ig,lay) * abscoice(ig) + & + & clwpmc(ig,lay) * abscoliq(ig) + & + & cswpmc(ig,lay) * abscosno(ig) + + endif + endif + enddo + enddo + + end subroutine cldprmc + + +!........................................!$ + end module rrtmg_lw !$ +!========================================!$ diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 new file mode 100644 index 000000000..cd7705d3f --- /dev/null +++ b/physics/radsw_main.F90 @@ -0,0 +1,6339 @@ +!> \file radsw_main.f +!! This file contains NCEP's modifications of the rrtmg-sw radiation +!! code from AER. + +! ============================================================== !!!!! +! sw-rrtm3 radiation package description !!!!! +! ============================================================== !!!!! +! ! +! this package includes ncep's modifications of the rrtm-sw radiation ! +! code from aer inc. ! +! ! +! the sw-rrtm3 package includes these parts: ! +! ! +! 'radsw_rrtm3_param.f' ! +! 'radsw_rrtm3_datatb.f' ! +! 'radsw_rrtm3_main.f' ! +! ! +! the 'radsw_rrtm3_param.f' contains: ! +! ! +! 'module_radsw_parameters' -- band parameters set up ! +! ! +! the 'radsw_rrtm3_datatb.f' contains: ! +! ! +! 'module_radsw_ref' -- reference temperature and pressure ! +! 'module_radsw_cldprtb' -- cloud property coefficients table ! +! 'module_radsw_sflux' -- spectral distribution of solar flux ! +! 'module_radsw_kgbnn' -- absorption coeffients for 14 ! +! bands, where nn = 16-29 ! +! ! +! the 'radsw_rrtm3_main.f' contains: ! +! ! +! 'rrtmg_sw' -- main sw radiation transfer ! +! ! +! in the main module 'rrtmg_sw' there are only two ! +! externally callable subroutines: ! +! ! +! 'swrad' -- main sw radiation routine ! +! inputs: ! +! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! +! clouds,icseed,aerosols,sfcalb, ! +! dzlyr,delpin,de_lgth, ! +! cosz,solcon,NDAY,idxday, ! +! npts, nlay, nlp1, lprnt, ! +! outputs: ! +! hswc,topflx,sfcflx,cldtau, ! +!! optional outputs: ! +! HSW0,HSWB,FLXPRF,FDNCMP) ! +! ) ! +! ! +! 'rswinit' -- initialization routine ! +! inputs: ! +! ( me ) ! +! outputs: ! +! (none) ! +! ! +! all the sw radiation subprograms become contained subprograms ! +! in module 'rrtmg_sw' and many of them are not directly ! +! accessable from places outside the module. ! +! ! +! derived data type constructs used: ! +! ! +! 1. radiation flux at toa: (from module 'module_radsw_parameters') ! +! topfsw_type - derived data type for toa rad fluxes ! +! upfxc total sky upward flux at toa ! +! dnfxc total sky downward flux at toa ! +! upfx0 clear sky upward flux at toa ! +! ! +! 2. radiation flux at sfc: (from module 'module_radsw_parameters') ! +! sfcfsw_type - derived data type for sfc rad fluxes ! +! upfxc total sky upward flux at sfc ! +! dnfxc total sky downward flux at sfc ! +! upfx0 clear sky upward flux at sfc ! +! dnfx0 clear sky downward flux at sfc ! +! ! +! 3. radiation flux profiles(from module 'module_radsw_parameters') ! +! profsw_type - derived data type for rad vertical prof ! +! upfxc level upward flux for total sky ! +! dnfxc level downward flux for total sky ! +! upfx0 level upward flux for clear sky ! +! dnfx0 level downward flux for clear sky ! +! ! +! 4. surface component fluxes(from module 'module_radsw_parameters' ! +! cmpfsw_type - derived data type for component sfc flux ! +! uvbfc total sky downward uv-b flux at sfc ! +! uvbf0 clear sky downward uv-b flux at sfc ! +! nirbm surface downward nir direct beam flux ! +! nirdf surface downward nir diffused flux ! +! visbm surface downward uv+vis direct beam flx ! +! visdf surface downward uv+vis diffused flux ! +! ! +! external modules referenced: ! +! ! +! 'module physparam' ! +! 'module physcons' ! +! 'mersenne_twister' ! +! ! +! compilation sequence is: ! +! ! +! 'radsw_rrtm3_param.f' ! +! 'radsw_rrtm3_datatb.f' ! +! 'radsw_rrtm3_main.f' ! +! ! +! and all should be put in front of routines that use sw modules ! +! ! +!==========================================================================! +! ! +! the original program declarations: ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). ! +! This software may be used, copied, or redistributed as long as it is ! +! not sold and this copyright notice is reproduced on each copy made. ! +! This model is provided as is without any express or implied warranties. ! +! (http://www.rtweb.aer.com/) ! +! ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! ! +! ************************************************************************ ! +! ! +! rrtmg_sw ! +! ! +! ! +! a rapid radiative transfer model ! +! for the solar spectral region ! +! atmospheric and environmental research, inc. ! +! 131 hartwell avenue ! +! lexington, ma 02421 ! +! ! +! eli j. mlawer ! +! jennifer s. delamere ! +! michael j. iacono ! +! shepard a. clough ! +! ! +! ! +! email: miacono@aer.com ! +! email: emlawer@aer.com ! +! email: jdelamer@aer.com ! +! ! +! the authors wish to acknowledge the contributions of the ! +! following people: steven j. taubman, patrick d. brown, ! +! ronald e. farren, luke chen, robert bergstrom. ! +! ! +! ************************************************************************ ! +! ! +! references: ! +! (rrtm_sw/rrtmg_sw): ! +! clough, s.a., m.w. shephard, e.j. mlawer, j.s. delamere, ! +! m.j. iacono, k. cady-pereira, s. boukabara, and p.d. brown: ! +! atmospheric radiative transfer modeling: a summary of the aer ! +! codes, j. quant. spectrosc. radiat. transfer, 91, 233-244, 2005. ! +! ! +! (mcica): ! +! pincus, r., h. w. barker, and j.-j. morcrette: a fast, flexible, ! +! approximation technique for computing radiative transfer in ! +! inhomogeneous cloud fields, j. geophys. res., 108(d13), 4376, ! +! doi:10.1029/2002jd003322, 2003. ! +! ! +! ************************************************************************ ! +! ! +! aer's revision history: ! +! this version of rrtmg_sw has been modified from rrtm_sw to use a ! +! reduced set of g-point intervals and a two-stream model for ! +! application to gcms. ! +! ! +! -- original version (derived from rrtm_sw) ! +! 2002: aer. inc. ! +! -- conversion to f90 formatting; addition of 2-stream radiative transfer! +! feb 2003: j.-j. morcrette, ecmwf ! +! -- additional modifications for gcm application ! +! aug 2003: m. j. iacono, aer inc. ! +! -- total number of g-points reduced from 224 to 112. original ! +! set of 224 can be restored by exchanging code in module parrrsw.f90 ! +! and in file rrtmg_sw_init.f90. ! +! apr 2004: m. j. iacono, aer, inc. ! +! -- modifications to include output for direct and diffuse ! +! downward fluxes. there are output as "true" fluxes without ! +! any delta scaling applied. code can be commented to exclude ! +! this calculation in source file rrtmg_sw_spcvrt.f90. ! +! jan 2005: e. j. mlawer, m. j. iacono, aer, inc. ! +! -- revised to add mcica capability. ! +! nov 2005: m. j. iacono, aer, inc. ! +! -- reformatted for consistency with rrtmg_lw. ! +! feb 2007: m. j. iacono, aer, inc. ! +! -- modifications to formatting to use assumed-shape arrays. ! +! aug 2007: m. j. iacono, aer, inc. ! +! ! +! ************************************************************************ ! +! ! +! ncep modifications history log: ! +! ! +! sep 2003, yu-tai hou -- received aer's rrtm-sw gcm version ! +! code (v224) ! +! nov 2003, yu-tai hou -- corrected errors in direct/diffuse ! +! surface alabedo components. ! +! jan 2004, yu-tai hou -- modified code into standard modular! +! f9x code for ncep models. the original three cloud ! +! control flags are simplified into two: iflagliq and ! +! iflagice. combined the org subr sw_224 and setcoef ! +! into radsw (the main program); put all kgb##together ! +! and reformat into a separated data module; combine ! +! reftra and vrtqdr as swflux; optimized taumol and all ! +! taubgs to form a contained subroutines. ! +! jun 2004, yu-tai hou -- modified code based on aer's faster! +! version rrtmg_sw (v2.0) with 112 g-points. ! +! mar 2005, yu-tai hou -- modified to aer v2.3, correct cloud! +! scaling error, total sky properties are delta scaled ! +! after combining clear and cloudy parts. the testing ! +! criterion of ssa is saved before scaling. added cloud ! +! layer rain and snow contributions. all cloud water ! +! partical contents are treated the same way as other ! +! atmos particles. ! +! apr 2005, yu-tai hou -- modified on module structures (this! +! version of code was given back to aer in jun 2006) ! +! nov 2006, yu-tai hou -- modified code to include the ! +! generallized aerosol optical property scheme for gcms.! +! apr 2007, yu-tai hou -- added spectral band heating as an ! +! optional output to support the 500km model's upper ! +! stratospheric radiation calculations. restructure ! +! optional outputs for easy access by different models. ! +! oct 2008, yu-tai hou -- modified to include new features ! +! from aer's newer release v3.5-v3.61, including mcica ! +! sub-grid cloud option and true direct/diffuse fluxes ! +! without delta scaling. added rain/snow opt properties ! +! support to cloudy sky calculations. simplified and ! +! unified sw and lw sub-column cloud subroutines into ! +! one module by using optional parameters. ! +! mar 2009, yu-tai hou -- replaced the original random number! +! generator coming with the original code with ncep w3 ! +! library to simplify the program and moved sub-column ! +! cloud subroutines inside the main module. added ! +! option of user provided permutation seeds that could ! +! be randomly generated from forecast time stamp. ! +! mar 2009, yu-tai hou -- replaced random number generator ! +! programs coming from the original code with the ncep ! +! w3 library to simplify the program and moved sub-col ! +! cloud subroutines inside the main module. added ! +! option of user provided permutation seeds that could ! +! be randomly generated from forecast time stamp. ! +! nov 2009, yu-tai hou -- updated to aer v3.7-v3.8 version. ! +! notice the input cloud ice/liquid are assumed as ! +! in-cloud quantities, not grid average quantities. ! +! aug 2010, yu-tai hou -- uptimized code to improve efficiency +! splited subroutine spcvrt into two subs, spcvrc and ! +! spcvrm, to handling non-mcica and mcica type of calls.! +! apr 2012, b. ferrier and y. hou -- added conversion factor to fu's! +! cloud-snow optical property scheme. ! +! jul 2012, s. moorthi and Y. hou -- eliminated the pointer array ! +! in subr 'spcvrt' for multi-threading issue running ! +! under intel's fortran compiler. ! +! nov 2012, yu-tai hou -- modified control parameters thru ! +! module 'physparam'. ! +! jun 2013, yu-tai hou -- moving band 9 surface treatment ! +! back as in the rrtm2 version, spliting surface flux ! +! into two spectral regions (vis & nir), instead of ! +! designated it in nir region only. ! +! may 2016 yu-tai hou --reverting swflux name back to vrtqdr! +! jun 2018 yu-tai hou --updated cloud optical coeffs with ! +! aer's newer version v3.9-v4.0 for hu and stamnes ! +! scheme. (used if iswcliq=2); added new option of ! +! cloud overlap method 'de-correlation-length'. ! +! ! +!!!!! ============================================================== !!!!! +!!!!! end descriptions !!!!! +!!!!! ============================================================== !!!!! + +!> This module contains the CCPP-compliant NCEP's modifications of the rrtm-sw radiation +!! code from aer inc. + module rrtmg_sw +! + use physparam, only : iswrate, iswrgas, iswcice, & !mz: iswcliq + & icldflg, ivflip, & + & iswmode + use physcons, only : con_g, con_cp, con_avgd, con_amd, & + & con_amw, con_amo3 + use machine, only : rb => kind_phys, im => kind_io4, & + & kind_phys + + use module_radsw_parameters + use mersenne_twister, only : random_setseed, random_number, & + & random_stat + use module_radsw_ref, only : preflog, tref + use module_radsw_sflux +! + implicit none +! + private +! +! --- version tag and last revision date + character(40), parameter :: & + & VTAGSW='NCEP SW v5.1 Nov 2012 -RRTMG-SW v3.8 ' +! & VTAGSW='NCEP SW v5.0 Aug 2012 -RRTMG-SW v3.8 ' +! & VTAGSW='RRTMG-SW v3.8 Nov 2009' +! & VTAGSW='RRTMG-SW v3.7 Nov 2009' +! & VTAGSW='RRTMG-SW v3.61 Oct 2008' +! & VTAGSW='RRTMG-SW v3.5 Oct 2008' +! & VTAGSW='RRTM-SW 112v2.3 Apr 2007' +! & VTAGSW='RRTM-SW 112v2.3 Mar 2005' +! & VTAGSW='RRTM-SW 112v2.0 Jul 2004' + +! \name constant values + + real (kind=kind_phys), parameter :: eps = 1.0e-6 + real (kind=kind_phys), parameter :: oneminus= 1.0 - eps +! pade approx constant + real (kind=kind_phys), parameter :: bpade = 1.0/0.278 + real (kind=kind_phys), parameter :: stpfac = 296.0/1013.0 + real (kind=kind_phys), parameter :: ftiny = 1.0e-12 + real (kind=kind_phys), parameter :: flimit = 1.0e-20 +! internal solar constant + real (kind=kind_phys), parameter :: s0 = 1368.22 + + real (kind=kind_phys), parameter :: f_zero = 0.0 + real (kind=kind_phys), parameter :: f_one = 1.0 + +! \name atomic weights for conversion from mass to volume mixing ratios + real (kind=kind_phys), parameter :: amdw = con_amd/con_amw + real (kind=kind_phys), parameter :: amdo3 = con_amd/con_amo3 + +! \name band indices + integer, dimension(nblow:nbhgh) :: nspa, nspb +! band index for sfc flux + integer, dimension(nblow:nbhgh) :: idxsfc +! band index for cld prop + integer, dimension(nblow:nbhgh) :: idxebc + + data nspa(:) / 9, 9, 9, 9, 1, 9, 9, 1, 9, 1, 0, 1, 9, 1 / + data nspb(:) / 1, 5, 1, 1, 1, 5, 1, 0, 1, 0, 0, 1, 5, 1 / + +! data idxsfc(:) / 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 1 / ! band index for sfc flux + data idxsfc(:) / 1, 1, 1, 1, 1, 1, 1, 1, 0, 2, 2, 2, 2, 1 / ! band index for sfc flux + data idxebc(:) / 5, 5, 4, 4, 3, 3, 2, 2, 1, 1, 1, 1, 1, 5 / ! band index for cld prop + +! --- band wavenumber intervals +! real (kind=kind_phys), dimension(nblow:nbhgh):: wavenum1,wavenum2 +! data wavenum1(:) / & +! & 2600.0, 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, & +! & 8050.0,12850.0,16000.0,22650.0,29000.0,38000.0, 820.0 / +! data wavenum2(:) / & +! 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, 8050.0, & +! & 12850.0,16000.0,22650.0,29000.0,38000.0,50000.0, 2600.0 / +! real (kind=kind_phys), dimension(nblow:nbhgh) :: delwave +! data delwave(:) / & +! & 650.0, 750.0, 650.0, 500.0, 1000.0, 1550.0, 350.0, & +! & 4800.0, 3150.0, 6650.0, 6350.0, 9000.0,12000.0, 1780.0 / + +! uv-b band index + integer, parameter :: nuvb = 27 + +!\name logical flags for optional output fields + logical :: lhswb = .false. + logical :: lhsw0 = .false. + logical :: lflxprf= .false. + logical :: lfdncmp= .false. + + +! those data will be set up only once by "rswinit" + real (kind=kind_phys) :: exp_tbl(0:NTBMX) + + +! the factor for heating rates (in k/day, or k/sec set by subroutine +!! 'rswinit') + real (kind=kind_phys) :: heatfac + + +! initial permutation seed used for sub-column cloud scheme + integer, parameter :: ipsdsw0 = 1 + +! --- public accessable subprograms + + public rrtmg_sw_init, rrtmg_sw_run, rrtmg_sw_finalize, rswinit, & + & kissvec, generate_stochastic_clouds_sw,mcica_subcol_sw + + +! ================= + contains +! ================= + + subroutine rrtmg_sw_init () + end subroutine rrtmg_sw_init + +!> \defgroup module_radsw_main GFS RRTMG Shortwave Module +!! This module includes NCEP's modifications of the RRTMG-SW radiation +!! code from AER. +!! +!! The SW radiation model in the current NOAA Environmental Modeling +!! System (NEMS) was adapted from the RRTM radiation model developed by +!! AER Inc. (\cite clough_et_al_2005; \cite mlawer_et_al_1997). It contains 14 +!! spectral bands spanning a spectral wavenumber range of +!! \f$50000-820 cm^{-1}\f$ (corresponding to a wavelength range +!! \f$0.2-12.2\mu m\f$), each spectral band focuses on a specific set of +!! atmospheric absorbing species as shown in Table 1. To achieve great +!! computation efficiency while at the same time to maintain a high +!! degree of accuracy, the RRTM radiation model employs a corrected-k +!! distribution method (i.e. mapping the highly spectral changing +!! absorption coefficient, k, into a monotonic and smooth varying +!! cumulative probability function, g). In the RRTM-SW, there are 16 +!! unevenly distributed g points for each of the 14 bands for a total +!! of 224 g points. The GCM version of the code (RRTMG-SW) uses a reduced +!! number (various between 2 to 16) of g points for each of the bands +!! that totals to 112 instead of the full set of 224. To get high +!! quality for the scheme, many advanced techniques are used in RRTM +!! such as carefully selecting the band structure to handle various +!! major (key-species) and minor absorbers; deriving a binary parameter +!! for a paired key molecular species in the same domain; and using two +!! pressure regions (dividing level is at about 96mb) for optimal +!! treatment of various species, etc. +!!\tableofcontents +!! Table 1. RRTMG-SW spectral bands and the corresponding absorbing species +!! |Band #| Wavenumber Range | Lower Atm (Key)| Lower Atm (Minor)| Mid/Up Atm (Key)| Mid/Up Atm (Minor)| +!! |------|------------------|----------------|------------------|-----------------|-------------------| +!! | 16 | 2600-3250 |H2O,CH4 | |CH4 | | +!! | 17 | 3250-4000 |H2O,CO2 | |H2O,CO2 | | +!! | 18 | 4000-4650 |H2O,CH4 | |CH4 | | +!! | 19 | 4650-5150 |H2O,CO2 | |CO2 | | +!! | 20 | 5150-6150 |H2O |CH4 |H2O |CH4 | +!! | 21 | 6150-7700 |H2O,CO2 | |H2O,CO2 | | +!! | 22 | 7700-8050 |H2O,O2 | |O2 | | +!! | 23 | 8050-12850 |H2O | |--- | | +!! | 24 | 12850-16000 |H2O,O2 |O3 |O2 |O3 | +!! | 25 | 16000-22650 |H2O |O3 |--- |O3 | +!! | 26 | 22650-29000 |--- | |--- | | +!! | 27 | 29000-38000 |O3 | |O3 | | +!! | 28 | 38000-50000 |O3,O2 | |O3,O2 | | +!! | 29 | 820-2600 |H2O |CO2 |CO2 |H2O | +!!\tableofcontents +!! +!! The RRTM-SW package includes three files: +!! - radsw_param.f, which contains: +!! - module_radsw_parameters: specifies major parameters of the spectral +!! bands and defines the construct structures of derived-type variables +!! for holding the output results. +!! - radsw_datatb.f, which contains: +!! - module_radsw_ref: reference temperature and pressure +!! - module_radsw_cldprtb: cloud property coefficients table +!! - module_radsw_sflux: indexes and coefficients for spectral +!! distribution of solar flux +!! - module_radsw_kgbnn: absorption coefficents for 14 bands, where +!! nn = 16-29 +!! - radsw_main.f, which contains: +!! - rrtmg_sw_run(): the main SW radiation routine +!! - rswinit(): the initialization routine +!! +!!\author Eli J. Mlawer, emlawer@aer.com +!!\author Jennifer S. Delamere, jdelamer@aer.com +!!\author Michael J. Iacono, miacono@aer.com +!!\author Shepard A. Clough +!!\version NCEP SW v5.1 Nov 2012 -RRTMG-SW v3.8 +!! +!! The authors wish to acknowledge the contributions of the +!! following people: Steven J. Taubman, Karen Cady-Pereira, +!! Patrick D. Brown, Ronald E. Farren, Luke Chen, Robert Bergstrom. +!! +!!\copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). +!! This software may be used, copied, or redistributed as long as it is +!! not sold and this copyright notice is reproduced on each copy made. +!! This model is provided as is without any express or implied warranties. +!! (http://www.rtweb.aer.com/) +!! +!> \section arg_table_rrtmg_sw_run Argument Table +!! \htmlinclude rrtmg_sw_run.html +!! +!> \section gen_swrad RRTMG Shortwave Radiation Scheme General Algorithm +!> @{ +!----------------------------------- + subroutine rrtmg_sw_run & + & ( plyr,plvl,tlyr,tlvl,qlyr,olyr, & + & gasvmr_co2,gasvmr_n2o,gasvmr_ch4,gasvmr_o2,gasvmr_co, & + & gasvmr_cfc11,gasvmr_cfc12,gasvmr_cfc22,gasvmr_ccl4, & ! --- inputs + & icseed, aeraod, aerssa, aerasy, & + & sfcalb_nir_dir, sfcalb_nir_dif, & + & sfcalb_uvis_dir, sfcalb_uvis_dif, & + & dzlyr,delpin,de_lgth, iswcliq, iovrsw, isubcsw, & + & cosz,solcon,NDAY,idxday, & + & npts, nlay, nlp1, lprnt, & + & cld_cf, lsswr, & + & hswc,topflx,sfcflx,cldtau, & ! --- outputs + & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od, cld_ssa, cld_asy,mpirank,mpiroot, errmsg, errflg ) + +! ==================== defination of variables ==================== ! +! ! +! input variables: ! +! plyr (npts,nlay) : model layer mean pressure in mb ! +! plvl (npts,nlp1) : model level pressure in mb ! +! tlyr (npts,nlay) : model layer mean temperature in k ! +! tlvl (npts,nlp1) : model level temperature in k (not in use) ! +! qlyr (npts,nlay) : layer specific humidity in gm/gm *see inside ! +! olyr (npts,nlay) : layer ozone concentration in gm/gm ! +! gasvmr(npts,nlay,:): atmospheric constent gases: ! +! (check module_radiation_gases for definition) ! +! gasvmr(:,:,1) - co2 volume mixing ratio ! +! gasvmr(:,:,2) - n2o volume mixing ratio ! +! gasvmr(:,:,3) - ch4 volume mixing ratio ! +! gasvmr(:,:,4) - o2 volume mixing ratio ! +! gasvmr(:,:,5) - co volume mixing ratio (not used) ! +! gasvmr(:,:,6) - cfc11 volume mixing ratio (not used) ! +! gasvmr(:,:,7) - cfc12 volume mixing ratio (not used) ! +! gasvmr(:,:,8) - cfc22 volume mixing ratio (not used) ! +! gasvmr(:,:,9) - ccl4 volume mixing ratio (not used) ! +! clouds(npts,nlay,:): cloud profile ! +! (check module_radiation_clouds for definition) ! +! clouds(:,:,1) - layer total cloud fraction ! +! clouds(:,:,2) - layer in-cloud liq water path (g/m**2) ! +! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! +! clouds(:,:,4) - layer in-cloud ice water path (g/m**2) ! +! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! +! clouds(:,:,6) - layer rain drop water path (g/m**2) ! +! clouds(:,:,7) - mean eff radius for rain drop (micron) ! +! clouds(:,:,8) - layer snow flake water path (g/m**2) ! +! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! icseed(npts) : auxiliary special cloud related array ! +! when module variable isubcsw=2, it provides ! +! permutation seed for each column profile that ! +! are used for generating random numbers. ! +! when isubcsw /=2, it will not be used. ! +! aerosols(npts,nlay,nbdsw,:) : aerosol optical properties ! +! (check module_radiation_aerosols for definition) ! +! (:,:,:,1) - optical depth ! +! (:,:,:,2) - single scattering albedo ! +! (:,:,:,3) - asymmetry parameter ! +! sfcalb(npts, : ) : surface albedo in fraction ! +! (check module_radiation_surface for definition) ! +! ( :, 1 ) - near ir direct beam albedo ! +! ( :, 2 ) - near ir diffused albedo ! +! ( :, 3 ) - uv+vis direct beam albedo ! +! ( :, 4 ) - uv+vis diffused albedo ! +! dzlyr(npts,nlay) : layer thickness in km ! +! delpin(npts,nlay): layer pressure thickness (mb) ! +! de_lgth(npts) : clouds decorrelation length (km) ! +! cosz (npts) : cosine of solar zenith angle ! +! solcon : solar constant (w/m**2) ! +! NDAY : num of daytime points ! +! idxday(npts) : index array for daytime points ! +! npts : number of horizontal points ! +! nlay,nlp1 : vertical layer/lavel numbers ! +! lprnt : logical check print flag ! +! ! +! output variables: ! +! hswc (npts,nlay): total sky heating rates (k/sec or k/day) ! +! topflx(npts) : radiation fluxes at toa (w/m**2), components: ! +! (check module_radsw_parameters for definition) ! +! upfxc - total sky upward flux at toa ! +! dnflx - total sky downward flux at toa ! +! upfx0 - clear sky upward flux at toa ! +! sfcflx(npts) : radiation fluxes at sfc (w/m**2), components: ! +! (check module_radsw_parameters for definition) ! +! upfxc - total sky upward flux at sfc ! +! dnfxc - total sky downward flux at sfc ! +! upfx0 - clear sky upward flux at sfc ! +! dnfx0 - clear sky downward flux at sfc ! +! cldtau(npts,nlay): spectral band layer cloud optical depth (~0.55 mu) +! ! +!!optional outputs variables: ! +! hswb(npts,nlay,nbdsw): spectral band total sky heating rates ! +! hsw0 (npts,nlay): clear sky heating rates (k/sec or k/day) ! +! flxprf(npts,nlp1): level radiation fluxes (w/m**2), components: ! +! (check module_radsw_parameters for definition) ! +! dnfxc - total sky downward flux at interface ! +! upfxc - total sky upward flux at interface ! +! dnfx0 - clear sky downward flux at interface ! +! upfx0 - clear sky upward flux at interface ! +! fdncmp(npts) : component surface downward fluxes (w/m**2): ! +! (check module_radsw_parameters for definition) ! +! uvbfc - total sky downward uv-b flux at sfc ! +! uvbf0 - clear sky downward uv-b flux at sfc ! +! nirbm - downward surface nir direct beam flux ! +! nirdf - downward surface nir diffused flux ! +! visbm - downward surface uv+vis direct beam flux ! +! visdf - downward surface uv+vis diffused flux ! +! ! +! external module variables: (in physparam) ! +! iswrgas - control flag for rare gases (ch4,n2o,o2, etc.) ! +! =0: do not include rare gases ! +! >0: include all rare gases ! +! iswcliq - control flag for liq-cloud optical properties ! +! =0: input cloud optical depth, fixed ssa, asy ! +! =1: use hu and stamnes(1993) method for liq cld ! +! =2: use updated coeffs for hu and stamnes scheme ! +! iswcice - control flag for ice-cloud optical properties ! +! *** if iswcliq==0, iswcice is ignored ! +! =1: use ebert and curry (1992) scheme for ice clouds ! +! =2: use streamer v3.0 (2001) method for ice clouds ! +! =3: use fu's method (1996) for ice clouds ! +! iswmode - control flag for 2-stream transfer scheme ! +! =1; delta-eddington (joseph et al., 1976) ! +! =2: pifm (zdunkowski et al., 1980) ! +! =3: discrete ordinates (liou, 1973) ! +! isubcsw - sub-column cloud approximation control flag ! +! =0: no sub-col cld treatment, use grid-mean cld quantities ! +! =1: mcica sub-col, prescribed seeds to get random numbers ! +! =2: mcica sub-col, providing array icseed for random numbers! +! iovrsw - cloud overlapping control flag ! +! =0: random overlapping clouds ! +! =1: maximum/random overlapping clouds ! +! =2: maximum overlap cloud ! +! =3: decorrelation-length overlap clouds ! +! =4: exponential overlapping clouds +! ivflip - control flg for direction of vertical index ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! ! +! module parameters, control variables: ! +! nblow,nbhgh - lower and upper limits of spectral bands ! +! maxgas - maximum number of absorbing gaseous ! +! ngptsw - total number of g-point subintervals ! +! ng## - number of g-points in band (##=16-29) ! +! ngb(ngptsw) - band indices for each g-point ! +! bpade - pade approximation constant (1/0.278) ! +! nspa,nspb(nblow:nbhgh) ! +! - number of lower/upper ref atm's per band ! +! ipsdsw0 - permutation seed for mcica sub-col clds ! +! ! +! major local variables: ! +! pavel (nlay) - layer pressures (mb) ! +! delp (nlay) - layer pressure thickness (mb) ! +! tavel (nlay) - layer temperatures (k) ! +! coldry (nlay) - dry air column amount ! +! (1.e-20*molecules/cm**2) ! +! cldfrc (nlay) - layer cloud fraction (norm by tot cld) ! +! cldfmc (nlay,ngptsw) - layer cloud fraction for g-point ! +! taucw (nlay,nbdsw) - cloud optical depth ! +! ssacw (nlay,nbdsw) - cloud single scattering albedo (weighted) ! +! asycw (nlay,nbdsw) - cloud asymmetry factor (weighted) ! +! tauaer (nlay,nbdsw) - aerosol optical depths ! +! ssaaer (nlay,nbdsw) - aerosol single scattering albedo ! +! asyaer (nlay,nbdsw) - aerosol asymmetry factor ! +! colamt (nlay,maxgas) - column amounts of absorbing gases ! +! 1 to maxgas are for h2o, co2, o3, n2o, ! +! ch4, o2, co, respectively (mol/cm**2) ! +! facij (nlay) - indicator of interpolation factors ! +! =0/1: indicate lower/higher temp & height ! +! selffac(nlay) - scale factor for self-continuum, equals ! +! (w.v. density)/(atm density at 296K,1013 mb) ! +! selffrac(nlay) - factor for temp interpolation of ref ! +! self-continuum data ! +! indself(nlay) - index of the lower two appropriate ref ! +! temp for the self-continuum interpolation ! +! forfac (nlay) - scale factor for w.v. foreign-continuum ! +! forfrac(nlay) - factor for temp interpolation of ref ! +! w.v. foreign-continuum data ! +! indfor (nlay) - index of the lower two appropriate ref ! +! temp for the foreign-continuum interp ! +! laytrop - layer at which switch is made from one ! +! combination of key species to another ! +! jp(nlay),jt(nlay),jt1(nlay) ! +! - lookup table indexes ! +! flxucb(nlp1,nbdsw) - spectral bnd total-sky upward flx (w/m2) ! +! flxdcb(nlp1,nbdsw) - spectral bnd total-sky downward flx (w/m2)! +! flxu0b(nlp1,nbdsw) - spectral bnd clear-sky upward flx (w/m2) ! +! flxd0b(nlp1,nbdsw) - spectral b d clear-sky downward flx (w/m2)! +! ! +! ! +! ===================== end of definitions ==================== ! + +! --- inputs: + integer, intent(in) :: npts, nlay, nlp1, NDAY + integer, intent(in) :: iswcliq,iovrsw,isubcsw + + integer, dimension(:), intent(in) :: idxday, icseed + + logical, intent(in) :: lprnt, lsswr + + real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: & + & plvl, tlvl + real (kind=kind_phys), dimension(npts,nlay), intent(in) :: & + & plyr, tlyr, qlyr, olyr, dzlyr, delpin + + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dir + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dif + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dir + real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dif + + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_n2o + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc11 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc12 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc22 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ccl4 + + real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf + real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od, cld_ssa, cld_asy + + real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aeraod + real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aerssa + real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aerasy + + real (kind=kind_phys), intent(in) :: cosz(npts), solcon, & + & de_lgth(npts) + + integer, intent(in) :: mpirank,mpiroot +! --- outputs: + real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hswc + real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & + & cldtau + + type (topfsw_type), dimension(npts), intent(inout) :: topflx + type (sfcfsw_type), dimension(npts), intent(inout) :: sfcflx + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +!! --- optional outputs: + real (kind=kind_phys), dimension(npts,nlay,nbdsw), optional, & + & intent(inout) :: hswb + + real (kind=kind_phys), dimension(npts,nlay), optional, & + & intent(inout) :: hsw0 + type (profsw_type), dimension(npts,nlp1), optional, & + & intent(inout) :: flxprf + type (cmpfsw_type), dimension(npts), optional, & + & intent(inout) :: fdncmp + +! --- locals: +!mz* HWRF -- input of mcica_subcol_sw + real(kind=kind_phys),dimension(1,nlay) :: hgt + real(kind=kind_phys) :: dzsum + real(kind=kind_phys),dimension( nbdsw, 1, nlay ) :: taucld3, & + ssacld3, & + asmcld3, & + fsfcld3 + +!mz* HWRF -- OUTPUT from mcica_subcol_sw + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: cldfmcl ! Cloud fraction + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: ciwpmcl ! In-cloud ice water path (g/m2) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: clwpmcl ! In-cloud liquid water path (g/m2) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: cswpmcl ! In-cloud snow water path (g/m2) + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=kind_phys),dimension(npts,nlay) :: relqmcl ! Cloud water drop effective radius (microns) + ! Dimensions: (ncol,nlay) + real(kind=kind_phys),dimension(npts,nlay) :: reicmcl ! Cloud ice effective size (microns) + ! Dimensions: (ncol,nlay) + real(kind=kind_phys),dimension(npts,nlay) :: resnmcl ! Snow effective size (microns) + ! Dimensions: (ncol,nlay) + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: taucmcl ! In-cloud optical depth + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: ssacmcl ! in-cloud single scattering albedo [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: asmcmcl ! in-cloud asymmetry parameter [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=kind_phys),dimension(ngptsw,npts,nlay) :: fsfcmcl ! in-cloud forward scattering fraction [mcica] + ! Dimensions: (ngptsw,ncol,nlay) +!HWRF cldprmc_sw input +! real(kind=kind_phys),dimension(ngptsw,nlay) :: cldfmc,cldfmc_save! cloud fraction [mcica] +! ! Dimensions: (ngptsw,nlayers) + real(kind=kind_phys),dimension(ngptsw,nlay) :: ciwpmc ! cloud ice water path [mcica] + ! Dimensions: (ngptsw,nlayers) + real(kind=kind_phys),dimension(ngptsw,nlay) :: clwpmc ! cloud liquid water path [mcica] + ! Dimensions: (ngptsw,nlayers) + real(kind=kind_phys),dimension(ngptsw,nlay) :: cswpmc ! cloud snow water path [mcica] + ! Dimensions: (ngptsw,nlayers) + real(kind=kind_phys),dimension(nlay) :: resnmc ! cloud snow particle effective radius (microns) + ! Dimensions: (nlayers) + real(kind=kind_phys),dimension(nlay) :: relqmc ! cloud liquid particle effective radius (microns) + ! Dimensions: (nlayers) + real(kind=kind_phys),dimension(nlay) :: reicmc ! cloud ice particle effective radius (microns) + ! Dimensions: (nlayers) + ! specific definition of reicmc depends on setting of iceflag: + ! iceflag = 1: ice effective radius, r_ec, (Ebert and Curry, 1992), + ! r_ec range is limited to 13.0 to 130.0 microns + ! iceflag = 2: ice effective radius, r_k, (Key, Streamer Ref. Manual, 1996) + ! r_k range is limited to 5.0 to 131.0 microns + ! iceflag = 3: generalized effective size, dge, (Fu, 1996), + ! dge range is limited to 5.0 to 140.0 microns + ! [dge = 1.0315 * r_ec] + real(kind=kind_phys),dimension(ngptsw,nlay) :: fsfcmc ! cloud forward scattering fraction + ! Dimensions: (ngptsw,nlayers) + +!mz* HWRF cldprmc_sw output (delta scaled) + real(kind=kind_phys),dimension(ngptsw,nlay) :: taucmc ! cloud optical depth (delta scaled) + ! Dimensions: (ngptsw,nlayers) + real(kind=kind_phys),dimension(ngptsw,nlay) :: ssacmc ! single scattering albedo (delta scaled) + ! Dimensions: (ngptsw,nlayers) + real(kind=kind_phys),dimension(ngptsw,nlay) :: asmcmc ! asymmetry parameter (delta scaled) + ! Dimensions: (ngptsw,nlayers) + real(kind=kind_phys),dimension(ngptsw,nlay) :: taormc ! cloud optical depth (non-delta scaled) + ! Dimensions: (ngptsw,nlayers) +!mz* + + real (kind=kind_phys), dimension(nlay,ngptsw) :: cldfmc, & + & cldfmc_save, & + & taug, taur + real (kind=kind_phys), dimension(nlp1,nbdsw):: fxupc, fxdnc, & + & fxup0, fxdn0 + + real (kind=kind_phys), dimension(nlay,nbdsw) :: & + & tauae, ssaae, asyae, taucw, ssacw, asycw + + real (kind=kind_phys), dimension(ngptsw) :: sfluxzen + + real (kind=kind_phys), dimension(nlay) :: cldfrc, delp, & + & pavel, tavel, coldry, colmol, h2ovmr, o3vmr, temcol, & + & cliqp, reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, & + & cfrac, fac00, fac01, fac10, fac11, forfac, forfrac, & + & selffac, selffrac, rfdelp, dz + + real (kind=kind_phys), dimension(nlp1) :: fnet, flxdc, flxuc, & + & flxd0, flxu0 + + real (kind=kind_phys), dimension(2) :: albbm, albdf, sfbmc, & + & sfbm0, sfdfc, sfdf0 + + real (kind=kind_phys) :: cosz1, sntz1, tem0, tem1, tem2, s0fac, & + & ssolar, zcf0, zcf1, ftoau0, ftoauc, ftoadc, & + & fsfcu0, fsfcuc, fsfcd0, fsfcdc, suvbfc, suvbf0, delgth + +! --- column amount of absorbing gases: +! (:,m) m = 1-h2o, 2-co2, 3-o3, 4-n2o, 5-ch4, 6-o2, 7-co + real (kind=kind_phys) :: colamt(nlay,maxgas) + + integer, dimension(npts) :: ipseed + integer, dimension(nlay) :: indfor, indself, jp, jt, jt1 + + integer :: i, ib, ipt, j1, k, kk, laytrop, mb,ig + integer :: inflgsw, iceflgsw, liqflgsw + integer :: irng, permuteseed +! +!===> ... begin here +! + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +! Select cloud liquid and ice optics parameterization options +! For passing in cloud optical properties directly: +! inflgsw = 0 +! iceflgsw = 0 +! liqflgsw = 0 +! For passing in cloud physical properties; cloud optics parameterized in RRTMG: + inflgsw = 2 + iceflgsw = 3 + liqflgsw = 1 +! + if (.not. lsswr) return + if (nday <= 0) return + + lhswb = present ( hswb ) + lhsw0 = present ( hsw0 ) + lflxprf= present ( flxprf ) + lfdncmp= present ( fdncmp ) + +!> -# Compute solar constant adjustment factor (s0fac) according to solcon. +! *** s0, the solar constant at toa in w/m**2, is hard-coded with +! each spectra band, the total flux is about 1368.22 w/m**2. + + s0fac = solcon / s0 + +!> -# Initial output arrays (and optional) as zero. + + hswc(:,:) = f_zero + cldtau(:,:) = f_zero + topflx = topfsw_type ( f_zero, f_zero, f_zero ) + sfcflx = sfcfsw_type ( f_zero, f_zero, f_zero, f_zero ) + +!! --- ... initial optional outputs + if ( lflxprf ) then + flxprf = profsw_type ( f_zero, f_zero, f_zero, f_zero ) + endif + + if ( lfdncmp ) then + fdncmp = cmpfsw_type (f_zero,f_zero,f_zero,f_zero,f_zero,f_zero) + endif + + if ( lhsw0 ) then + hsw0(:,:) = f_zero + endif + + if ( lhswb ) then + hswb(:,:,:) = f_zero + endif + +!! --- check for optional input arguments, depending on cloud method + if (iswcliq > 0) then ! use prognostic cloud method + if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & + & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & + & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & + & .not.present(cld_swp) .or. .not.present(cld_ref_snow) )then + write(errmsg,'(*(a))') & + & 'Logic error: iswcliq>0 requires the following', & + & ' optional arguments to be present:', & + & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & + & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' + errflg = 1 + return + end if + else ! use diagnostic cloud method + if ( .not.present(cld_od) .or. .not.present(cld_ssa) .or. & + & .not.present(cld_asy)) then + write(errmsg,'(*(a))') & + & 'Logic error: iswcliq<=0 requires the following', & + & ' optional arguments to be present:', & + & ' cld_od, cld_ssa, cld_asy' + errflg = 1 + return + end if + endif ! end if_iswcliq + +!> -# Change random number seed value for each radiation invocation +!! (isubcsw =1 or 2). + + if ( isubcsw == 1 ) then ! advance prescribed permutation seed + do i = 1, npts + ipseed(i) = ipsdsw0 + i + enddo + elseif ( isubcsw == 2 ) then ! use input array of permutaion seeds + do i = 1, npts + ipseed(i) = icseed(i) + enddo + endif + + if ( lprnt ) then + write(0,*)' In radsw, isubcsw, ipsdsw0,ipseed =', & + & isubcsw, ipsdsw0, ipseed + endif + +! --- ... loop over each daytime grid point + + lab_do_ipt : do ipt = 1, NDAY + + j1 = idxday(ipt) + + cosz1 = cosz(j1) + sntz1 = f_one / cosz(j1) + ssolar = s0fac * cosz(j1) + if (iovrsw == 3) delgth = de_lgth(j1) ! clouds decorr-length + +!> -# Prepare surface albedo: bm,df - dir,dif; 1,2 - nir,uvv. + albbm(1) = sfcalb_nir_dir(j1) + albdf(1) = sfcalb_nir_dif(j1) + albbm(2) = sfcalb_uvis_dir(j1) + albdf(2) = sfcalb_uvis_dif(j1) + + +! mz*: HWRF practice + if (iovrsw == 4 ) then + + +!Add layer height needed for exponential (icld=4) and +! exponential-random (icld=5) overlap options + + !iplon = 1 + irng = 0 + permuteseed = 1 + +!mz* Derive height of each layer mid-point from layer thickness. +! Needed for exponential (iovrsw=4) and exponential-random overlap +! option (iovr=5)only. + dzsum =0.0 + do k = 1,nlay + hgt(j1,k)= dzsum+0.5*dzlyr(j1,k)*1000. !km->m + dzsum = dzsum+ dzlyr(j1,k)*1000. + enddo + +! Zero out cloud optical properties here; not used when passing physical properties +! to radiation and taucld is calculated in radiation + do k = 1, nlay + do ib = 1, nbdsw + taucld3(ib,j1,k) = 0.0 + ssacld3(ib,j1,k) = 1.0 + asmcld3(ib,j1,k) = 0.0 + fsfcld3(ib,j1,k) = 0.0 + enddo + enddo + +!mz +! if(mpirank==mpiroot) then +! write(0,*) 'mcica_subcol_sw: max/min(cld_cf)=', & +! & maxval(cld_cf),minval(cld_cf) +! write(0,*) 'mcica_subcol_sw: max/min(cld_iwp)=', & +! & maxval(cld_iwp),minval(cld_iwp) +! write(0,*) 'mcica_subcol_sw: max/min(cld_lwp)=', & +! & maxval(cld_lwp),minval(cld_lwp) +! write(0,*) 'mcica_subcol_sw: max/min(cld_swp)=', & +! & maxval(cld_swp),minval(cld_swp) +! write(0,*) 'mcica_subcol_sw: max/min(cld_ref_ice)=', & +! & maxval(cld_ref_ice),minval(cld_ref_ice) +! write(0,*) 'mcica_subcol_sw: max/min(cld_ref_snow)=', & +! & maxval(cld_ref_snow),minval(cld_ref_snow) +! write(0,*) 'mcica_subcol_sw: max/min(cld_ref_liq)=', & +! & maxval(cld_ref_liq),minval(cld_ref_liq) +! endif + + + call mcica_subcol_sw (1, j1, nlay, iovrsw, permuteseed, & + & irng, plyr, hgt, & + & cld_cf, cld_iwp, cld_lwp,cld_swp, & + & cld_ref_ice, cld_ref_liq, & + & cld_ref_snow, taucld3,ssacld3,asmcld3,fsfcld3, & + & cldfmcl, ciwpmcl, clwpmcl, cswpmcl, & !--output + & reicmcl, relqmcl, resnmcl, & + & taucmcl, ssacmcl, asmcmcl, fsfcmcl) + +!mz +! if(mpirank==mpiroot) then +! write(0,*) 'mcica_subcol_sw: max/min(cldfmcl)=', & +! & maxval(cldfmcl),minval(cldfmcl) +! write(0,*) 'mcica_subcol_sw: max/min(ciwpmcl)=', & +! & maxval(ciwpmcl),minval(ciwpmcl) +! write(0,*) 'mcica_subcol_sw: max/min(clwpmcl)=', & +! & maxval(clwpmcl),minval(clwpmcl) +! write(0,*) 'mcica_subcol_sw: max/min(cswpmcl)=', & +! & maxval(cswpmcl),minval(cswpmcl) +! write(0,*) 'mcica_subcol_sw: max/min(reicmcl)=', & +! & maxval(reicmcl),minval(reicmcl) +! write(0,*) 'mcica_subcol_sw: max/min(relqmcl)=', & +! & maxval(relqmcl),minval(relqmcl) +! write(0,*) 'mcica_subcol_sw: max/min(resnmcl)=', & +! & maxval(resnmcl),minval(resnmcl) +! endif + + endif +!mz* end + +!> -# Prepare atmospheric profile for use in rrtm. +! the vertical index of internal array is from surface to top + + if (ivflip == 0) then ! input from toa to sfc + + tem1 = 100.0 * con_g + tem2 = 1.0e-20 * 1.0e3 * con_avgd + + do k = 1, nlay + kk = nlp1 - k + pavel(k) = plyr(j1,kk) + tavel(k) = tlyr(j1,kk) + delp (k) = delpin(j1,kk) + dz (k) = dzlyr (j1,kk) +!> -# Set absorber and gas column amount, convert from volume mixing +!! ratio to molec/cm2 based on coldry (scaled to 1.0e-20) +!! - colamt(nlay,maxgas):column amounts of absorbing gases 1 to +!! maxgas are for h2o,co2,o3,n2o,ch4,o2,co, respectively +!! (\f$ mol/cm^2 \f$) + +!test use +! h2ovmr(k)= max(f_zero,qlyr(j1,kk)*amdw) ! input mass mixing ratio +! h2ovmr(k)= max(f_zero,qlyr(j1,kk)) ! input vol mixing ratio +! o3vmr (k)= max(f_zero,olyr(j1,kk)) ! input vol mixing ratio +!ncep model use + h2ovmr(k)= max(f_zero,qlyr(j1,kk)*amdw/(f_one-qlyr(j1,kk))) ! input specific humidity + o3vmr (k)= max(f_zero,olyr(j1,kk)*amdo3) ! input mass mixing ratio + + tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw + coldry(k) = tem2 * delp(k) / (tem1*tem0*(f_one + h2ovmr(k))) + temcol(k) = 1.0e-12 * coldry(k) + + colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(j1,kk)) ! co2 + colamt(k,3) = max(f_zero, coldry(k)*o3vmr(k)) ! o3 + colmol(k) = coldry(k) + colamt(k,1) + enddo + +! --- ... set up gas column amount, convert from volume mixing ratio +! to molec/cm2 based on coldry (scaled to 1.0e-20) + + if (iswrgas > 0) then + do k = 1, nlay + kk = nlp1 - k + colamt(k,4) = max(temcol(k), coldry(k)*gasvmr_n2o(j1,kk)) ! n2o + colamt(k,5) = max(temcol(k), coldry(k)*gasvmr_ch4(j1,kk)) ! ch4 + colamt(k,6) = max(temcol(k), coldry(k)*gasvmr_o2(j1,kk)) ! o2 +! colamt(k,7) = max(temcol(k), coldry(k)*gasvmr(j1,kk,5)) ! co - notused + enddo + else + do k = 1, nlay + colamt(k,4) = temcol(k) ! n2o + colamt(k,5) = temcol(k) ! ch4 + colamt(k,6) = temcol(k) ! o2 +! colamt(k,7) = temcol(k) ! co - notused + enddo + endif + +!> -# Read aerosol optical properties from 'aerosols'. + + do k = 1, nlay + kk = nlp1 - k + do ib = 1, nbdsw + tauae(k,ib) = aeraod(j1,kk,ib) + ssaae(k,ib) = aerssa(j1,kk,ib) + asyae(k,ib) = aerasy(j1,kk,ib) + enddo + enddo + +!> -# Read cloud optical properties from 'clouds'. + if (iswcliq > 0) then ! use prognostic cloud method +!mz:GFS operational + !if (iovrsw .eq. 1) then + do k = 1, nlay + kk = nlp1 - k + cfrac(k) = cld_cf(j1,kk) ! cloud fraction + cliqp(k) = cld_lwp(j1,kk) ! cloud liq path + reliq(k) = cld_ref_liq(j1,kk) ! liq partical effctive radius + cicep(k) = cld_iwp(j1,kk) ! cloud ice path + reice(k) = cld_ref_ice(j1,kk) ! ice partical effctive radius + cdat1(k) = cld_rwp(j1,kk) ! cloud rain drop path + cdat2(k) = cld_ref_rain(j1,kk) ! rain partical effctive radius + cdat3(k) = cld_swp(j1,kk) ! cloud snow path + cdat4(k) = cld_ref_snow(j1,kk) ! snow partical effctive radius + enddo + if (iovrsw .eq. 4) then !mz* HWRF + do k = 1, nlay + kk = nlp1 - k + do ig = 1, ngptsw + cldfmc(k,ig) = cldfmcl(ig,j1,kk) + taucmc(ig,k) = taucmcl(ig,j1,kk) + ssacmc(ig,k) = ssacmcl(ig,j1,kk) + asmcmc(ig,k) = asmcmcl(ig,j1,kk) + fsfcmc(ig,k) = fsfcmcl(ig,j1,kk) + ciwpmc(ig,k) = ciwpmcl(ig,j1,kk) + clwpmc(ig,k) = clwpmcl(ig,j1,kk) + if (iceflgsw.eq.5) then + cswpmc(ig,k) = cswpmcl(ig,j1,kk) + endif + enddo + reicmc(k) = reicmcl(j1,kk) + relqmc(k) = relqmcl(j1,kk) + if (iceflgsw.eq.5) then + resnmc(k) = resnmcl(j1,kk) + endif + enddo + endif + else ! use diagnostic cloud method + do k = 1, nlay + kk = nlp1 - k + cfrac(k) = cld_cf(j1,kk) ! cloud fraction + cdat1(k) = cld_od(j1,kk) ! cloud optical depth + cdat2(k) = cld_ssa(j1,kk) ! cloud single scattering albedo + cdat3(k) = cld_asy(j1,kk) ! cloud asymmetry factor + enddo + endif ! end if_iswcliq + + else ! input from sfc to toa + + tem1 = 100.0 * con_g + tem2 = 1.0e-20 * 1.0e3 * con_avgd + + do k = 1, nlay + pavel(k) = plyr(j1,k) + tavel(k) = tlyr(j1,k) + delp (k) = delpin(j1,k) + dz (k) = dzlyr (j1,k) + +! --- ... set absorber amount +!test use +! h2ovmr(k)= max(f_zero,qlyr(j1,k)*amdw) ! input mass mixing ratio +! h2ovmr(k)= max(f_zero,qlyr(j1,k)) ! input vol mixing ratio +! o3vmr (k)= max(f_zero,olyr(j1,k)) ! input vol mixing ratio +!ncep model use + h2ovmr(k)= max(f_zero,qlyr(j1,k)*amdw/(f_one-qlyr(j1,k))) ! input specific humidity + o3vmr (k)= max(f_zero,olyr(j1,k)*amdo3) ! input mass mixing ratio + + tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw + coldry(k) = tem2 * delp(k) / (tem1*tem0*(f_one + h2ovmr(k))) + temcol(k) = 1.0e-12 * coldry(k) + + colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o + colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(j1,k)) ! co2 + colamt(k,3) = max(f_zero, coldry(k)*o3vmr(k)) ! o3 + colmol(k) = coldry(k) + colamt(k,1) + enddo + + + if (lprnt) then + if (ipt == 1) then + write(0,*)' pavel=',pavel + write(0,*)' tavel=',tavel + write(0,*)' delp=',delp + write(0,*)' h2ovmr=',h2ovmr*1000 + write(0,*)' o3vmr=',o3vmr*1000000 + endif + endif + +! --- ... set up gas column amount, convert from volume mixing ratio +! to molec/cm2 based on coldry (scaled to 1.0e-20) + + if (iswrgas > 0) then + do k = 1, nlay + colamt(k,4) = max(temcol(k), coldry(k)*gasvmr_n2o(j1,k)) ! n2o + colamt(k,5) = max(temcol(k), coldry(k)*gasvmr_ch4(j1,k)) ! ch4 + colamt(k,6) = max(temcol(k), coldry(k)*gasvmr_o2(j1,k)) ! o2 +! colamt(k,7) = max(temcol(k), coldry(k)*gasvmr(j1,k,5)) ! co - notused + enddo + else + do k = 1, nlay + colamt(k,4) = temcol(k) ! n2o + colamt(k,5) = temcol(k) ! ch4 + colamt(k,6) = temcol(k) ! o2 +! colamt(k,7) = temcol(k) ! co - notused + enddo + endif + +! --- ... set aerosol optical properties + + do ib = 1, nbdsw + do k = 1, nlay + tauae(k,ib) = aeraod(j1,k,ib) + ssaae(k,ib) = aerssa(j1,k,ib) + asyae(k,ib) = aerasy(j1,k,ib) + enddo + enddo + + if (iswcliq > 0) then ! use prognostic cloud method + !if (iovrsw .eq. 1) then !mz* GFS operational + do k = 1, nlay + cfrac(k) = cld_cf(j1,k) ! cloud fraction + cliqp(k) = cld_lwp(j1,k) ! cloud liq path + reliq(k) = cld_ref_liq(j1,k) ! liq partical effctive radius + cicep(k) = cld_iwp(j1,k) ! cloud ice path + reice(k) = cld_ref_ice(j1,k) ! ice partical effctive radius + cdat1(k) = cld_rwp(j1,k) ! cloud rain drop path + cdat2(k) = cld_ref_rain(j1,k) ! rain partical effctive radius + cdat3(k) = cld_swp(j1,k) ! cloud snow path + cdat4(k) = cld_ref_snow(j1,k) ! snow partical effctive radius + enddo + if (iovrsw .eq. 4) then !mz* HWRF +!mz* Move incoming GCM cloud arrays to RRTMG cloud arrays. +!For GCM input, incoming reicmcl is defined based on selected +!ice parameterization (inflglw) + do k = 1, nlay + do ig = 1, ngptsw + cldfmc(k,ig) = cldfmcl(ig,j1,k) + taucmc(ig,k) = taucmcl(ig,j1,k) + ssacmc(ig,k) = ssacmcl(ig,j1,k) + asmcmc(ig,k) = asmcmcl(ig,j1,k) + fsfcmc(ig,k) = fsfcmcl(ig,j1,k) + ciwpmc(ig,k) = ciwpmcl(ig,j1,k) + clwpmc(ig,k) = clwpmcl(ig,j1,k) + if (iceflgsw .eq. 5) then + cswpmc(ig,k) = cswpmcl(ig,j1,k) + endif + enddo + reicmc(k) = reicmcl(j1,k) + relqmc(k) = relqmcl(j1,k) + if (iceflgsw .eq. 5) then + resnmc(k) = resnmcl(j1,k) + endif + enddo + + end if + else ! use diagnostic cloud method + do k = 1, nlay + cfrac(k) = cld_cf(j1,k) ! cloud fraction + cdat1(k) = cld_od(j1,k) ! cloud optical depth + cdat2(k) = cld_ssa(j1,k) ! cloud single scattering albedo + cdat3(k) = cld_asy(j1,k) ! cloud asymmetry factor + enddo + endif ! end if_iswcliq + + endif ! if_ivflip + +!> -# Compute fractions of clear sky view: +!! - random overlapping +!! - max/ran overlapping +!! - maximum overlapping + + zcf0 = f_one + zcf1 = f_one + if (iovrsw == 0) then ! random overlapping + do k = 1, nlay + zcf0 = zcf0 * (f_one - cfrac(k)) + enddo +!mz else if (iovrsw == 1) then ! max/ran overlapping + else if (iovrsw == 1.or. iovrsw == 4) then ! mz* also exponential overlapping + do k = 1, nlay + if (cfrac(k) > ftiny) then ! cloudy layer + zcf1 = min ( zcf1, f_one-cfrac(k) ) + elseif (zcf1 < f_one) then ! clear layer + zcf0 = zcf0 * zcf1 + zcf1 = f_one + endif + enddo + zcf0 = zcf0 * zcf1 + else if (iovrsw >= 2 .and. iovrsw .ne. 4) then + do k = 1, nlay + zcf0 = min ( zcf0, f_one-cfrac(k) ) ! used only as clear/cloudy indicator + enddo + endif + + if (zcf0 <= ftiny) zcf0 = f_zero + if (zcf0 > oneminus) zcf0 = f_one + zcf1 = f_one - zcf0 + +!> -# For cloudy sky column, call cldprop() to compute the cloud +!! optical properties for each cloudy layer. + + !if (iovrsw .eq. 1 ) then + + if (zcf1 > f_zero) then ! cloudy sky column + + !mz* for HWRF, save cldfmc with mcica + if (iovrsw .eq.4) then + do k = 1, nlay + do ig = 1, ngptsw + cldfmc_save(k,ig)=cldfmc (k,ig) + enddo + enddo + endif + + + call cldprop & +! --- inputs: + & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & + & zcf1, nlay, ipseed(j1), dz, delgth,iswcliq,iovrsw,isubcsw, & +! --- outputs: + & taucw, ssacw, asycw, cldfrc, cldfmc & !mz: cldfmc(k,ig) + & ) + + if (iovrsw .eq.4) then + !mz for HWRF, still using mcica cldfmc + do k = 1, nlay + do ig = 1, ngptsw + cldfmc(k,ig)=cldfmc_save(k,ig) + enddo + enddo + endif + +! --- ... save computed layer cloud optical depth for output +! rrtm band 10 is approx to the 0.55 mu spectrum + + if (ivflip == 0) then ! input from toa to sfc + do k = 1, nlay + kk = nlp1 - k + cldtau(j1,kk) = taucw(k,10) + enddo + else ! input from sfc to toa + do k = 1, nlay + cldtau(j1,k) = taucw(k,10) + enddo + endif ! end if_ivflip_block + + else ! clear sky column + cldfrc(:) = f_zero + cldfmc(:,:)= f_zero + do i = 1, nbdsw + do k = 1, nlay + taucw(k,i) = f_zero + ssacw(k,i) = f_zero + asycw(k,i) = f_zero + enddo + enddo + endif ! end if_zcf1_block + +! if (iovrsw .eq. 4) then !mz* HWRF +!! For cloudy atmosphere, use cldprop to set cloud optical properties based on +!! input cloud physical properties. Select method based on choices described +!! in cldprop. Cloud fraction, water path, liquid droplet and ice particle +!! effective radius must be passed in cldprop. Cloud fraction and cloud +!! optical properties are transferred to rrtmg_sw arrays in cldprop. + +! call cldprmc_sw(nlayers, inflg, iceflg, liqflg, cldfmc, & +! ciwpmc, clwpmc, cswpmc, reicmc, relqmc, resnmc, & +! taormc, taucmc, ssacmc, asmcmc, fsfcmc) +! icpr = 1 + +! endif + +!> -# Call setcoef() to compute various coefficients needed in +!! radiative transfer calculations. + call setcoef & +! --- inputs: + & ( pavel,tavel,h2ovmr, nlay,nlp1, & +! --- outputs: + & laytrop,jp,jt,jt1,fac00,fac01,fac10,fac11, & + & selffac,selffrac,indself,forfac,forfrac,indfor & + & ) + +!mz* HWRF clouds +! if(iovrsw .eq.0) then +! zcldfmc(:,:) = 0._rb +! ztaucmc(:,:) = 0._rb +! ztaormc(:,:) = 0._rb +! zasycmc(:,:) = 0._rb +! zomgcmc(:,:) = 1._rb + +! elseif (iovrsw.eq.4) then +! do i=1,nlayers +! do ig=1,ngptsw +! zcldfmc(i,ig) = cldfmc(ig,i) +! ztaucmc(i,ig) = taucmc(ig,i) +! ztaormc(i,ig) = taormc(ig,i) +! zasycmc(i,ig) = asmcmc(ig,i) +! zomgcmc(i,ig) = ssacmc(ig,i) +! enddo +! enddo +!Aerosol +!mz* no aerosol at this moment (iaer .eq.0) +! ztaua(:,:) = 0._rb +! zasya(:,:) = 0._rb +! zomga(:,:) = 1._rb + +! endif +!mz* + +!> -# Call taumol() to calculate optical depths for gaseous absorption +!! and rayleigh scattering + call taumol & +! --- inputs: + & ( colamt,colmol,fac00,fac01,fac10,fac11,jp,jt,jt1,laytrop, & + & forfac,forfrac,indfor,selffac,selffrac,indself, NLAY, & +! --- outputs: + & sfluxzen, taug, taur & + & ) + +!> -# Call the 2-stream radiation transfer model: +!! - if physparam::isubcsw .le.0, using standard cloud scheme, +!! call spcvrtc(). +!! - if physparam::isubcsw .gt.0, using mcica cloud scheme, +!! call spcvrtm(). + + if ( isubcsw <= 0 ) then ! use standard cloud scheme + + call spcvrtc & +! --- inputs: + & ( ssolar,cosz1,sntz1,albbm,albdf,sfluxzen,cldfrc, & + & zcf1,zcf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & + & nlay, nlp1, & +! --- outputs: + & fxupc,fxdnc,fxup0,fxdn0, & + & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & + & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & + & ) + + else ! use mcica cloud scheme + +!mz if(iovrsw .eq. 1 ) then ! mz*:GFS operational + + call spcvrtm & +! --- inputs: + & ( ssolar,cosz1,sntz1,albbm,albdf,sfluxzen,cldfmc, & + & zcf1,zcf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & + & nlay, nlp1, & +! --- outputs: + & fxupc,fxdnc,fxup0,fxdn0, & + & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & + & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & + & ) + +!mz else if (iovrsw .eq.4 ) then +! call spcvmc_sw & +! (nlayers, istart, iend, icpr, iout, & +! pavel, tavel, pz, tz, tbound, albdif, albdir, & +! zcldfmc, ztaucmc, zasycmc, zomgcmc, ztaormc, & +! ztaua, zasya, zomga, cossza, coldry, wkl, adjflux, & +! laytrop, layswtch, laylow, jp, jt, jt1, & +! co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, & +! fac00, fac01, fac10, fac11, & +! selffac, selffrac, indself, forfac, forfrac, indfor, & +! zbbfd, zbbfu, zbbcd, zbbcu, zuvfd, zuvcd, znifd, znicd, & +! zbbfddir, zbbcddir, zuvfddir, zuvcddir, znifddir, znicddir) + + endif + +!> -# Save outputs. +! --- ... sum up total spectral fluxes for total-sky + + do k = 1, nlp1 + flxuc(k) = f_zero + flxdc(k) = f_zero + + do ib = 1, nbdsw + flxuc(k) = flxuc(k) + fxupc(k,ib) + flxdc(k) = flxdc(k) + fxdnc(k,ib) + enddo + enddo + +!! --- ... optional clear sky fluxes + + if ( lhsw0 .or. lflxprf ) then + do k = 1, nlp1 + flxu0(k) = f_zero + flxd0(k) = f_zero + + do ib = 1, nbdsw + flxu0(k) = flxu0(k) + fxup0(k,ib) + flxd0(k) = flxd0(k) + fxdn0(k,ib) + enddo + enddo + endif + +! --- ... prepare for final outputs + + do k = 1, nlay + rfdelp(k) = heatfac / delp(k) + enddo + + if ( lfdncmp ) then +!! --- ... optional uv-b surface downward flux + fdncmp(j1)%uvbf0 = suvbf0 + fdncmp(j1)%uvbfc = suvbfc + +!! --- ... optional beam and diffuse sfc fluxes + fdncmp(j1)%nirbm = sfbmc(1) + fdncmp(j1)%nirdf = sfdfc(1) + fdncmp(j1)%visbm = sfbmc(2) + fdncmp(j1)%visdf = sfdfc(2) + endif ! end if_lfdncmp + +! --- ... toa and sfc fluxes + + topflx(j1)%upfxc = ftoauc + topflx(j1)%dnfxc = ftoadc + topflx(j1)%upfx0 = ftoau0 + + sfcflx(j1)%upfxc = fsfcuc + sfcflx(j1)%dnfxc = fsfcdc + sfcflx(j1)%upfx0 = fsfcu0 + sfcflx(j1)%dnfx0 = fsfcd0 + + if (ivflip == 0) then ! output from toa to sfc + +! --- ... compute heating rates + + fnet(1) = flxdc(1) - flxuc(1) + + do k = 2, nlp1 + kk = nlp1 - k + 1 + fnet(k) = flxdc(k) - flxuc(k) + hswc(j1,kk) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) + enddo + +!! --- ... optional flux profiles + + if ( lflxprf ) then + do k = 1, nlp1 + kk = nlp1 - k + 1 + flxprf(j1,kk)%upfxc = flxuc(k) + flxprf(j1,kk)%dnfxc = flxdc(k) + flxprf(j1,kk)%upfx0 = flxu0(k) + flxprf(j1,kk)%dnfx0 = flxd0(k) + enddo + endif + +!! --- ... optional clear sky heating rates + + if ( lhsw0 ) then + fnet(1) = flxd0(1) - flxu0(1) + + do k = 2, nlp1 + kk = nlp1 - k + 1 + fnet(k) = flxd0(k) - flxu0(k) + hsw0(j1,kk) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) + enddo + endif + +!! --- ... optional spectral band heating rates + + if ( lhswb ) then + do mb = 1, nbdsw + fnet(1) = fxdnc(1,mb) - fxupc(1,mb) + + do k = 2, nlp1 + kk = nlp1 - k + 1 + fnet(k) = fxdnc(k,mb) - fxupc(k,mb) + hswb(j1,kk,mb) = (fnet(k) - fnet(k-1)) * rfdelp(k-1) + enddo + enddo + endif + + else ! output from sfc to toa + +! --- ... compute heating rates + + fnet(1) = flxdc(1) - flxuc(1) + + do k = 2, nlp1 + fnet(k) = flxdc(k) - flxuc(k) + hswc(j1,k-1) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) + enddo + +!! --- ... optional flux profiles + + if ( lflxprf ) then + do k = 1, nlp1 + flxprf(j1,k)%upfxc = flxuc(k) + flxprf(j1,k)%dnfxc = flxdc(k) + flxprf(j1,k)%upfx0 = flxu0(k) + flxprf(j1,k)%dnfx0 = flxd0(k) + enddo + endif + +!! --- ... optional clear sky heating rates + + if ( lhsw0 ) then + fnet(1) = flxd0(1) - flxu0(1) + + do k = 2, nlp1 + fnet(k) = flxd0(k) - flxu0(k) + hsw0(j1,k-1) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) + enddo + endif + +!! --- ... optional spectral band heating rates + + if ( lhswb ) then + do mb = 1, nbdsw + fnet(1) = fxdnc(1,mb) - fxupc(1,mb) + + do k = 1, nlay + fnet(k+1) = fxdnc(k+1,mb) - fxupc(k+1,mb) + hswb(j1,k,mb) = (fnet(k+1) - fnet(k)) * rfdelp(k) + enddo + enddo + endif + + endif ! if_ivflip + + enddo lab_do_ipt + + return +!................................... + end subroutine rrtmg_sw_run +!----------------------------------- +!> @} + + subroutine rrtmg_sw_finalize () + end subroutine rrtmg_sw_finalize + + +!>\ingroup module_radsw_main +!> This subroutine initializes non-varying module variables, conversion +!! factors, and look-up tables. +!!\param me print control for parallel process +!>\section rswinit_gen rswinit General Algorithm +!! @{ +!----------------------------------- + subroutine rswinit & + & (iswcliq,iovrsw,isubcsw, me ) ! --- inputs: +! --- outputs: (none) + +! =================== program usage description =================== ! +! ! +! purpose: initialize non-varying module variables, conversion factors,! +! and look-up tables. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: ! +! me - print control for parallel process ! +! ! +! outputs: (none) ! +! ! +! external module variables: (in physparam) ! +! iswrate - heating rate unit selections ! +! =1: output in k/day ! +! =2: output in k/second ! +! iswrgas - control flag for rare gases (ch4,n2o,o2, etc.) ! +! =0: do not include rare gases ! +! >0: include all rare gases ! +! iswcliq - liquid cloud optical properties contrl flag ! +! =0: input cloud opt depth from diagnostic scheme ! +! >0: input cwp,rew, and other cloud content parameters ! +! isubcsw - sub-column cloud approximation control flag ! +! =0: no sub-col cld treatment, use grid-mean cld quantities ! +! =1: mcica sub-col, prescribed seeds to get random numbers ! +! =2: mcica sub-col, providing array icseed for random numbers! +! icldflg - cloud scheme control flag ! +! =0: diagnostic scheme gives cloud tau, omiga, and g. ! +! =1: prognostic scheme gives cloud liq/ice path, etc. ! +! iovrsw - clouds vertical overlapping control flag ! +! =0: random overlapping clouds ! +! =1: maximum/random overlapping clouds ! +! =2: maximum overlap cloud ! +! =3: decorrelation-length overlap clouds ! +! iswmode - control flag for 2-stream transfer scheme ! +! =1; delta-eddington (joseph et al., 1976) ! +! =2: pifm (zdunkowski et al., 1980) ! +! =3: discrete ordinates (liou, 1973) ! +! ! +! ******************************************************************* ! +! ! +! definitions: ! +! arrays for 10000-point look-up tables: ! +! tau_tbl clear-sky optical depth ! +! exp_tbl exponential lookup table for transmittance ! +! ! +! ******************************************************************* ! +! ! +! ====================== end of description block ================= ! + +! --- inputs: + integer, intent(in) :: me,isubcsw,iswcliq + integer, intent(inout) :: iovrsw + +! --- outputs: none + +! --- locals: + real (kind=kind_phys), parameter :: expeps = 1.e-20 + + integer :: i + + real (kind=kind_phys) :: tfn, tau + +! +!===> ... begin here +! + if ( iovrsw<0 .or. iovrsw>4 ) then + print *,' *** Error in specification of cloud overlap flag', & + & ' IOVRSW=',iovrsw,' in RSWINIT !!' + stop + endif + + if (me == 0) then + print *,' - Using AER Shortwave Radiation, Version: ',VTAGSW + + if (iswmode == 1) then + print *,' --- Delta-eddington 2-stream transfer scheme' + else if (iswmode == 2) then + print *,' --- PIFM 2-stream transfer scheme' + else if (iswmode == 3) then + print *,' --- Discrete ordinates 2-stream transfer scheme' + endif + + if (iswrgas <= 0) then + print *,' --- Rare gases absorption is NOT included in SW' + else + print *,' --- Include rare gases N2O, CH4, O2, absorptions',& + & ' in SW' + endif + + if ( isubcsw == 0 ) then + print *,' --- Using standard grid average clouds, no ', & + & 'sub-column clouds approximation applied' + elseif ( isubcsw == 1 ) then + print *,' --- Using MCICA sub-colum clouds approximation ', & + & 'with a prescribed sequence of permutation seeds' + elseif ( isubcsw == 2 ) then + print *,' --- Using MCICA sub-colum clouds approximation ', & + & 'with provided input array of permutation seeds' + else + print *,' *** Error in specification of sub-column cloud ', & + & ' control flag isubcsw =',isubcsw,' !!' + stop + endif + endif + +!> -# Check cloud flags for consistency. + + if ((icldflg == 0 .and. iswcliq /= 0) .or. & + & (icldflg == 1 .and. iswcliq == 0)) then + print *,' *** Model cloud scheme inconsistent with SW', & + & ' radiation cloud radiative property setup !!' + stop + endif + + if ( isubcsw==0 .and. iovrsw>2 ) then + if (me == 0) then + print *,' *** IOVRSW=',iovrsw,' is not available for', & + & ' ISUBCSW=0 setting!!' + print *,' The program will use maximum/random overlap', & + & ' instead.' + endif + + iovrsw = 1 + endif + +!> -# Setup constant factors for heating rate +!! the 1.0e-2 is to convert pressure from mb to \f$N/m^2\f$ . + + if (iswrate == 1) then +! heatfac = 8.4391 +! heatfac = con_g * 86400. * 1.0e-2 / con_cp ! (in k/day) + heatfac = con_g * 864.0 / con_cp ! (in k/day) + else + heatfac = con_g * 1.0e-2 / con_cp ! (in k/second) + endif + +!> -# Define exponential lookup tables for transmittance. +! tau is computed as a function of the \a tau transition function, and +! transmittance is calculated as a function of tau. all tables +! are computed at intervals of 0.0001. the inverse of the +! constant used in the Pade approximation to the tau transition +! function is set to bpade. + + exp_tbl(0) = 1.0 + exp_tbl(NTBMX) = expeps + + do i = 1, NTBMX-1 + tfn = float(i) / float(NTBMX-i) + tau = bpade * tfn + exp_tbl(i) = exp( -tau ) + enddo + + return +!................................... + end subroutine rswinit +!! @} +!----------------------------------- + +!>\ingroup module_radsw_main +!> This subroutine computes the cloud optical properties for each +!! cloudy layer and g-point interval. +!!\param cfrac layer cloud fraction +!!\n for physparam::iswcliq > 0 (prognostic cloud scheme) - - - +!!\param cliqp layer in-cloud liq water path (\f$g/m^2\f$) +!!\param reliq mean eff radius for liq cloud (micron) +!!\param cicep layer in-cloud ice water path (\f$g/m^2\f$) +!!\param reice mean eff radius for ice cloud (micron) +!!\param cdat1 layer rain drop water path (\f$g/m^2\f$) +!!\param cdat2 effective radius for rain drop (micron) +!!\param cdat3 layer snow flake water path(\f$g/m^2\f$) +!!\param cdat4 mean eff radius for snow flake(micron) +!!\n for physparam::iswcliq = 0 (diagnostic cloud scheme) - - - +!!\param cliqp not used +!!\param cicep not used +!!\param reliq not used +!!\param reice not used +!!\param cdat1 layer cloud optical depth +!!\param cdat2 layer cloud single scattering albedo +!!\param cdat3 layer cloud asymmetry factor +!!\param cdat4 optional use +!!\param cf1 effective total cloud cover at surface +!!\param nlay vertical layer number +!!\param ipseed permutation seed for generating random numbers +!! (isubcsw>0) +!!\param dz layer thickness (km) +!!\param delgth layer cloud decorrelation length (km) +!!\param taucw cloud optical depth, w/o delta scaled +!!\param ssacw weighted cloud single scattering albedo +!! (ssa = ssacw / taucw) +!!\param asycw weighted cloud asymmetry factor +!! (asy = asycw / ssacw) +!!\param cldfrc cloud fraction of grid mean value +!!\param cldfmc cloud fraction for each sub-column +!!\section General_cldprop cldprop General Algorithm +!> @{ +!----------------------------------- + subroutine cldprop & + & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs + & cf1, nlay, ipseed, dz, delgth,iswcliq,iovrsw, isubcsw, & + & taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output + & ) + +! =================== program usage description =================== ! +! ! +! Purpose: Compute the cloud optical properties for each cloudy layer ! +! and g-point interval. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! cfrac - real, layer cloud fraction nlay ! +! ..... for iswcliq > 0 (prognostic cloud sckeme) - - - ! +! cliqp - real, layer in-cloud liq water path (g/m**2) nlay ! +! reliq - real, mean eff radius for liq cloud (micron) nlay ! +! cicep - real, layer in-cloud ice water path (g/m**2) nlay ! +! reice - real, mean eff radius for ice cloud (micron) nlay ! +! cdat1 - real, layer rain drop water path (g/m**2) nlay ! +! cdat2 - real, effective radius for rain drop (micron) nlay ! +! cdat3 - real, layer snow flake water path(g/m**2) nlay ! +! cdat4 - real, mean eff radius for snow flake(micron) nlay ! +! ..... for iswcliq = 0 (diagnostic cloud sckeme) - - - ! +! cdat1 - real, layer cloud optical depth nlay ! +! cdat2 - real, layer cloud single scattering albedo nlay ! +! cdat3 - real, layer cloud asymmetry factor nlay ! +! cdat4 - real, optional use nlay ! +! cliqp - real, not used nlay ! +! cicep - real, not used nlay ! +! reliq - real, not used nlay ! +! reice - real, not used nlay ! +! ! +! cf1 - real, effective total cloud cover at surface 1 ! +! nlay - integer, vertical layer number 1 ! +! ipseed- permutation seed for generating random numbers (isubcsw>0) ! +! dz - real, layer thickness (km) nlay ! +! delgth- real, layer cloud decorrelation length (km) 1 ! +! ! +! outputs: ! +! taucw - real, cloud optical depth, w/o delta scaled nlay*nbdsw ! +! ssacw - real, weighted cloud single scattering albedo nlay*nbdsw ! +! (ssa = ssacw / taucw) ! +! asycw - real, weighted cloud asymmetry factor nlay*nbdsw ! +! (asy = asycw / ssacw) ! +! cldfrc - real, cloud fraction of grid mean value nlay ! +! cldfmc - real, cloud fraction for each sub-column nlay*ngptsw! +! ! +! ! +! explanation of the method for each value of iswcliq, and iswcice. ! +! set up in module "physparam" ! +! ! +! iswcliq=0 : input cloud optical property (tau, ssa, asy). ! +! (used for diagnostic cloud method) ! +! iswcliq>0 : input cloud liq/ice path and effective radius, also ! +! require the user of 'iswcice' to specify the method ! +! used to compute aborption due to water/ice parts. ! +! ................................................................... ! +! ! +! iswcliq=1 : liquid water cloud optical properties are computed ! +! as in hu and stamnes (1993), j. clim., 6, 728-742. ! +! iswcliq=2 : updated coeffs for hu and stamnes (1993) by aer ! +! w v3.9-v4.0. ! +! ! +! iswcice used only when iswcliq > 0 ! +! the cloud ice path (g/m2) and ice effective radius ! +! (microns) are inputs. ! +! iswcice=1 : ice cloud optical properties are computed as in ! +! ebert and curry (1992), jgr, 97, 3831-3836. ! +! iswcice=2 : ice cloud optical properties are computed as in ! +! streamer v3.0 (2001), key, streamer user's guide, ! +! cooperative institude for meteorological studies,95pp! +! iswcice=3 : ice cloud optical properties are computed as in ! +! fu (1996), j. clim., 9. ! +! ! +! other cloud control module variables: ! +! isubcsw =0: standard cloud scheme, no sub-col cloud approximation ! +! >0: mcica sub-col cloud scheme using ipseed as permutation! +! seed for generating rundom numbers ! +! ! +! ====================== end of description block ================= ! +! + use module_radsw_cldprtb + +! --- inputs: + integer, intent(in) :: nlay, ipseed,iswcliq,iovrsw,isubcsw + real (kind=kind_phys), intent(in) :: cf1, delgth + + real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & + & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac, dz + +! --- outputs: + real (kind=kind_phys), dimension(nlay,ngptsw), intent(out) :: & + & cldfmc + real (kind=kind_phys), dimension(nlay,nbdsw), intent(out) :: & + & taucw, ssacw, asycw + real (kind=kind_phys), dimension(nlay), intent(out) :: cldfrc + +! --- locals: + real (kind=kind_phys), dimension(nblow:nbhgh) :: tauliq, tauice, & + & ssaliq, ssaice, ssaran, ssasnw, asyliq, asyice, & + & asyran, asysnw + real (kind=kind_phys), dimension(nlay) :: cldf + + real (kind=kind_phys) :: dgeice, factor, fint, tauran, tausnw, & + & cldliq, refliq, cldice, refice, cldran, cldsnw, refsnw, & + & extcoliq, ssacoliq, asycoliq, extcoice, ssacoice, asycoice,& + & dgesnw + + logical :: lcloudy(nlay,ngptsw) + integer :: ia, ib, ig, jb, k, index + +! +!===> ... begin here +! + do ib = 1, nbdsw + do k = 1, nlay + taucw (k,ib) = f_zero + ssacw (k,ib) = f_one + asycw (k,ib) = f_zero + enddo + enddo + +!> -# Compute cloud radiative properties for a cloudy column. + + lab_if_iswcliq : if (iswcliq > 0) then + + lab_do_k : do k = 1, nlay + lab_if_cld : if (cfrac(k) > ftiny) then + +!> - Compute optical properties for rain and snow. +!!\n For rain: tauran/ssaran/asyran +!!\n For snow: tausnw/ssasnw/asysnw +!> - Calculation of absorption coefficients due to water clouds +!!\n For water clouds: tauliq/ssaliq/asyliq +!> - Calculation of absorption coefficients due to ice clouds +!!\n For ice clouds: tauice/ssaice/asyice +!> - For Prognostic cloud scheme: sum up the cloud optical property: +!!\n \f$ taucw=tauliq+tauice+tauran+tausnw \f$ +!!\n \f$ ssacw=ssaliq+ssaice+ssaran+ssasnw \f$ +!!\n \f$ asycw=asyliq+asyice+asyran+asysnw \f$ + + cldran = cdat1(k) +! refran = cdat2(k) + cldsnw = cdat3(k) + refsnw = cdat4(k) + dgesnw = 1.0315 * refsnw ! for fu's snow formula + + tauran = cldran * a0r + +!> - If use fu's formula it needs to be normalized by snow/ice density. +!! not use snow density = 0.1 g/cm**3 = 0.1 g/(mu * m**2) +!!\n use ice density = 0.9167 g/cm**3 = 0.9167 g/(mu * m**2) +!!\n 1/0.9167 = 1.09087 +!!\n factor 1.5396=8/(3*sqrt(3)) converts reff to generalized ice particle size +!! use newer factor value 1.0315 + if (cldsnw>f_zero .and. refsnw>10.0_kind_phys) then +! tausnw = cldsnw * (a0s + a1s/refsnw) + tausnw = cldsnw*1.09087*(a0s + a1s/dgesnw) ! fu's formula + else + tausnw = f_zero + endif + + do ib = nblow, nbhgh + ssaran(ib) = tauran * (f_one - b0r(ib)) + ssasnw(ib) = tausnw * (f_one - (b0s(ib)+b1s(ib)*dgesnw)) + asyran(ib) = ssaran(ib) * c0r(ib) + asysnw(ib) = ssasnw(ib) * c0s(ib) + enddo + + cldliq = cliqp(k) + cldice = cicep(k) + refliq = reliq(k) + refice = reice(k) + +!> - Calculation of absorption coefficients due to water clouds. + + if ( cldliq <= f_zero ) then + do ib = nblow, nbhgh + tauliq(ib) = f_zero + ssaliq(ib) = f_zero + asyliq(ib) = f_zero + enddo + else + factor = refliq - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + + if ( iswcliq == 1 ) then + do ib = nblow, nbhgh + extcoliq = max(f_zero, extliq1(index,ib) & + & + fint*(extliq1(index+1,ib)-extliq1(index,ib)) ) + ssacoliq = max(f_zero, min(f_one, ssaliq1(index,ib) & + & + fint*(ssaliq1(index+1,ib)-ssaliq1(index,ib)) )) + + asycoliq = max(f_zero, min(f_one, asyliq1(index,ib) & + & + fint*(asyliq1(index+1,ib)-asyliq1(index,ib)) )) +! forcoliq = asycoliq * asycoliq + + tauliq(ib) = cldliq * extcoliq + ssaliq(ib) = tauliq(ib) * ssacoliq + asyliq(ib) = ssaliq(ib) * asycoliq + enddo + elseif ( iswcliq == 2 ) then ! use updated coeffs + do ib = nblow, nbhgh + extcoliq = max(f_zero, extliq2(index,ib) & + & + fint*(extliq2(index+1,ib)-extliq2(index,ib)) ) + ssacoliq = max(f_zero, min(f_one, ssaliq2(index,ib) & + & + fint*(ssaliq2(index+1,ib)-ssaliq2(index,ib)) )) + + asycoliq = max(f_zero, min(f_one, asyliq2(index,ib) & + & + fint*(asyliq2(index+1,ib)-asyliq2(index,ib)) )) +! forcoliq = asycoliq * asycoliq + + tauliq(ib) = cldliq * extcoliq + ssaliq(ib) = tauliq(ib) * ssacoliq + asyliq(ib) = ssaliq(ib) * asycoliq + enddo + endif ! end if_iswcliq_block + endif ! end if_cldliq_block + +!> - Calculation of absorption coefficients due to ice clouds. + + if ( cldice <= f_zero ) then + do ib = nblow, nbhgh + tauice(ib) = f_zero + ssaice(ib) = f_zero + asyice(ib) = f_zero + enddo + else + +!> - ebert and curry approach for all particle sizes though somewhat +!! unjustified for large ice particles. + + if ( iswcice == 1 ) then + refice = min(130.0_kind_phys,max(13.0_kind_phys,refice)) + + do ib = nblow, nbhgh + ia = idxebc(ib) ! eb_&_c band index for ice cloud coeff + + extcoice = max(f_zero, abari(ia)+bbari(ia)/refice ) + ssacoice = max(f_zero, min(f_one, & + & f_one-cbari(ia)-dbari(ia)*refice )) + asycoice = max(f_zero, min(f_one, & + & ebari(ia)+fbari(ia)*refice )) +! forcoice = asycoice * asycoice + + tauice(ib) = cldice * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice + enddo + +!> - streamer approach for ice effective radius between 5.0 and 131.0 microns. + + elseif ( iswcice == 2 ) then + refice = min(131.0_kind_phys,max(5.0_kind_phys,refice)) + + factor = (refice - 2.0) / 3.0 + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + + do ib = nblow, nbhgh + extcoice = max(f_zero, extice2(index,ib) & + & + fint*(extice2(index+1,ib)-extice2(index,ib)) ) + ssacoice = max(f_zero, min(f_one, ssaice2(index,ib) & + & + fint*(ssaice2(index+1,ib)-ssaice2(index,ib)) )) + asycoice = max(f_zero, min(f_one, asyice2(index,ib) & + & + fint*(asyice2(index+1,ib)-asyice2(index,ib)) )) +! forcoice = asycoice * asycoice + + tauice(ib) = cldice * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice + enddo + +!> - fu's approach for ice effective radius between 4.8 and 135 microns +!! (generalized effective size from 5 to 140 microns). + + elseif ( iswcice == 3 ) then + dgeice = max( 5.0, min( 140.0, 1.0315*refice )) + + factor = (dgeice - 2.0) / 3.0 + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + + do ib = nblow, nbhgh + extcoice = max(f_zero, extice3(index,ib) & + & + fint*(extice3(index+1,ib)-extice3(index,ib)) ) + ssacoice = max(f_zero, min(f_one, ssaice3(index,ib) & + & + fint*(ssaice3(index+1,ib)-ssaice3(index,ib)) )) + asycoice = max(f_zero, min(f_one, asyice3(index,ib) & + & + fint*(asyice3(index+1,ib)-asyice3(index,ib)) )) +! fdelta = max(f_zero, min(f_one, fdlice3(index,ib) & +! & + fint*(fdlice3(index+1,ib)-fdlice3(index,ib)) )) +! forcoice = min( asycoice, fdelta+0.5/ssacoice ) ! see fu 1996 p. 2067 + + tauice(ib) = cldice * extcoice + ssaice(ib) = tauice(ib) * ssacoice + asyice(ib) = ssaice(ib) * asycoice + enddo + + endif ! end if_iswcice_block + endif ! end if_cldice_block + + do ib = 1, nbdsw + jb = nblow + ib - 1 + taucw(k,ib) = tauliq(jb)+tauice(jb)+tauran+tausnw + ssacw(k,ib) = ssaliq(jb)+ssaice(jb)+ssaran(jb)+ssasnw(jb) + asycw(k,ib) = asyliq(jb)+asyice(jb)+asyran(jb)+asysnw(jb) + enddo + + endif lab_if_cld + enddo lab_do_k + + else lab_if_iswcliq + + do k = 1, nlay + if (cfrac(k) > ftiny) then + do ib = 1, nbdsw + taucw(k,ib) = cdat1(k) + ssacw(k,ib) = cdat1(k) * cdat2(k) + asycw(k,ib) = ssacw(k,ib) * cdat3(k) + enddo + endif + enddo + + endif lab_if_iswcliq + +!> -# if physparam::isubcsw > 0, call mcica_subcol() to distribute +!! cloud properties to each g-point. + +!mz if ( isubcsw > 0 ) then ! mcica sub-col clouds approx + if ( isubcsw > 0 .and. iovrsw .ne. 4 ) then ! mcica sub-col clouds approx + + cldf(:) = cfrac(:) + where (cldf(:) < ftiny) + cldf(:) = f_zero + end where + +! --- ... call sub-column cloud generator + + call mcica_subcol & +! --- inputs: + & ( cldf, nlay, ipseed, dz, delgth, iovrsw, & +! --- outputs: + & lcloudy & + & ) + + do ig = 1, ngptsw + do k = 1, nlay + if ( lcloudy(k,ig) ) then + cldfmc(k,ig) = f_one + else + cldfmc(k,ig) = f_zero + endif + enddo + enddo + + else ! non-mcica, normalize cloud + + do k = 1, nlay + cldfrc(k) = cfrac(k) / cf1 + enddo + endif ! end if_isubcsw_block + + return +!................................... + end subroutine cldprop +!----------------------------------- +!> @} + +!>\ingroup module_radsw_main +!> This subroutine computes the sub-colum cloud profile flag array. +!!\param cldf layer cloud fraction +!!\param nlay number of model vertical layers +!!\param ipseed permute seed for random num generator +!!\param dz layer thickness (km) +!!\param de_lgth layer cloud decorrelation length (km) +!!\param lcloudy sub-colum cloud profile flag array +!!\section mcica_sw_gen mcica_subcol General Algorithm +!> @{ +! ---------------------------------- + subroutine mcica_subcol & + & ( cldf, nlay, ipseed, dz, de_lgth,iovrsw, & ! --- inputs + & lcloudy & ! --- outputs + & ) + +! ==================== defination of variables ==================== ! +! ! +! input variables: size ! +! cldf - real, layer cloud fraction nlay ! +! nlay - integer, number of model vertical layers 1 ! +! ipseed - integer, permute seed for random num generator 1 ! +! ** note : if the cloud generator is called multiple times, need ! +! to permute the seed between each call; if between calls ! +! for lw and sw, use values differ by the number of g-pts. ! +! dz - real, layer thickness (km) nlay ! +! de_lgth-real, layer cloud decorrelation length (km) 1 ! +! ! +! output variables: ! +! lcloudy - logical, sub-colum cloud profile flag array nlay*ngptsw! +! ! +! other control flags from module variables: ! +! iovrsw : control flag for cloud overlapping method ! +! =0: random ! +! =1: maximum/random overlapping clouds ! +! =2: maximum overlap cloud ! +! =3: cloud decorrelation-length overlap method ! +! ! +! ===================== end of definitions ==================== ! + + implicit none + +! --- inputs: + integer, intent(in) :: nlay, ipseed, iovrsw + + real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz + real (kind=kind_phys), intent(in) :: de_lgth + +! --- outputs: + logical, dimension(nlay,ngptsw), intent(out):: lcloudy + +! --- locals: + real (kind=kind_phys) :: cdfunc(nlay,ngptsw), tem1, & + & rand2d(nlay*ngptsw), rand1d(ngptsw), fac_lcf(nlay), & + & cdfun2(nlay,ngptsw) + + type (random_stat) :: stat ! for thread safe random generator + + integer :: k, n, k1, ig +! +!===> ... begin here +! +!> -# Advance randum number generator by ipseed values. + + call random_setseed & +! --- inputs: + & ( ipseed, & +! --- outputs: + & stat & + & ) + +!> -# Sub-column set up according to overlapping assumption. + + select case ( iovrsw ) + + case( 0 ) ! random overlap, pick a random value at every level + + call random_number & +! --- inputs: ( none ) +! --- outputs: + & ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfunc(k,n) = rand2d(k1) + enddo + enddo + + case( 1 ) ! max-ran overlap + + call random_number & +! --- inputs: ( none ) +! --- outputs: + & ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfunc(k,n) = rand2d(k1) + enddo + enddo + +! --- first pick a random number for bottom/top layer. +! then walk up the column: (aer's code) +! if layer below is cloudy, use the same rand num in the layer below +! if layer below is clear, use a new random number + +! --- from bottom up + do k = 2, nlay + k1 = k - 1 + tem1 = f_one - cldf(k1) + + do n = 1, ngptsw + if ( cdfunc(k1,n) > tem1 ) then + cdfunc(k,n) = cdfunc(k1,n) + else + cdfunc(k,n) = cdfunc(k,n) * tem1 + endif + enddo + enddo + +! --- then walk down the column: (if use original author's method) +! if layer above is cloudy, use the same rand num in the layer above +! if layer above is clear, use a new random number + +! --- from top down +! do k = nlay-1, 1, -1 +! k1 = k + 1 +! tem1 = f_one - cldf(k1) + +! do n = 1, ngptsw +! if ( cdfunc(k1,n) > tem1 ) then +! cdfunc(k,n) = cdfunc(k1,n) +! else +! cdfunc(k,n) = cdfunc(k,n) * tem1 +! endif +! enddo +! enddo + + case( 2 ) ! maximum overlap, pick same random numebr at every level + + call random_number & +! --- inputs: ( none ) +! --- outputs: + & ( rand1d, stat ) + + do n = 1, ngptsw + tem1 = rand1d(n) + + do k = 1, nlay + cdfunc(k,n) = tem1 + enddo + enddo + + case( 3 ) ! decorrelation length overlap + +! --- compute overlapping factors based on layer midpoint distances +! and decorrelation depths + + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dz(k)+dz(k-1)) / de_lgth ) + enddo + +! --- setup 2 sets of random numbers + + call random_number ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfunc(k,n) = rand2d(k1) + enddo + enddo + + call random_number ( rand2d, stat ) + + k1 = 0 + do n = 1, ngptsw + do k = 1, nlay + k1 = k1 + 1 + cdfun2(k,n) = rand2d(k1) + enddo + enddo + +! --- then working from the top down: +! if a random number (from an independent set -cdfun2) is smaller then the +! scale factor: use the upper layer's number, otherwise use a new random +! number (keep the original assigned one). + + do n = 1, ngptsw + do k = nlay-1, 1, -1 + k1 = k + 1 + if ( cdfun2(k,n) <= fac_lcf(k1) ) then + cdfunc(k,n) = cdfunc(k1,n) + endif + enddo + enddo + + end select + +!> -# Generate subcolumns for homogeneous clouds. + + do k = 1, nlay + tem1 = f_one - cldf(k) + + do n = 1, ngptsw + lcloudy(k,n) = cdfunc(k,n) >= tem1 + enddo + enddo + + return +! .................................. + end subroutine mcica_subcol +!> @} +! ---------------------------------- + +!>\ingroup module_radsw_main +!> This subroutine computes various coefficients needed in radiative +!! transfer calculation. +!!\param pavel layer pressure (mb) +!!\param tavel layer temperature (k) +!!\param h2ovmr layer w.v. volumn mixing ratio (kg/kg) +!!\param nlay total number of vertical layers +!!\param nlp1 total number of vertical levels +!!\param laytrop tropopause layer index (unitless) +!!\param jp indices of lower reference pressure +!!\param jt,jt1 indices of lower reference temperatures at +!! levels of jp and jp+1 +!!\param fac00,fac01,fac10,fac11 factors mltiply the reference ks,i,j=0/1 for +!! lower/higher of the 2 appropriate temperature +!! and altitudes. +!!\param selffac scale factor for w. v. self-continuum equals +!! (w.v. density)/(atmospheric density at 296k +!! and 1013 mb) +!!\param selffrac factor for temperature interpolation of +!! reference w.v. self-continuum data +!!\param indself index of lower ref temp for selffac +!!\param forfac scale factor for w. v. foreign-continuum +!!\param forfrac factor for temperature interpolation of +!! reference w.v. foreign-continuum data +!!\param indfor index of lower ref temp for forfac +!>\section setcoef_gen_rw setcoef General Algorithm +!! @{ +! ---------------------------------- + subroutine setcoef & + & ( pavel,tavel,h2ovmr, nlay,nlp1, & ! --- inputs + & laytrop,jp,jt,jt1,fac00,fac01,fac10,fac11, & ! --- outputs + & selffac,selffrac,indself,forfac,forfrac,indfor & + & ) + +! =================== program usage description =================== ! +! ! +! purpose: compute various coefficients needed in radiative transfer ! +! calculations. ! +! ! +! subprograms called: none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: -size- ! +! pavel - real, layer pressures (mb) nlay ! +! tavel - real, layer temperatures (k) nlay ! +! h2ovmr - real, layer w.v. volum mixing ratio (kg/kg) nlay ! +! nlay/nlp1 - integer, total number of vertical layers, levels 1 ! +! ! +! outputs: ! +! laytrop - integer, tropopause layer index (unitless) 1 ! +! jp - real, indices of lower reference pressure nlay ! +! jt, jt1 - real, indices of lower reference temperatures nlay ! +! at levels of jp and jp+1 ! +! facij - real, factors multiply the reference ks, nlay ! +! i,j=0/1 for lower/higher of the 2 appropriate ! +! temperatures and altitudes. ! +! selffac - real, scale factor for w. v. self-continuum nlay ! +! equals (w. v. density)/(atmospheric density ! +! at 296k and 1013 mb) ! +! selffrac - real, factor for temperature interpolation of nlay ! +! reference w. v. self-continuum data ! +! indself - integer, index of lower ref temp for selffac nlay ! +! forfac - real, scale factor for w. v. foreign-continuum nlay ! +! forfrac - real, factor for temperature interpolation of nlay ! +! reference w.v. foreign-continuum data ! +! indfor - integer, index of lower ref temp for forfac nlay ! +! ! +! ====================== end of definitions =================== ! + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(:), intent(in) :: pavel, tavel, & + & h2ovmr + +! --- outputs: + integer, dimension(nlay), intent(out) :: indself, indfor, & + & jp, jt, jt1 + integer, intent(out) :: laytrop + + real (kind=kind_phys), dimension(nlay), intent(out) :: fac00, & + & fac01, fac10, fac11, selffac, selffrac, forfac, forfrac + +! --- locals: + real (kind=kind_phys) :: plog, fp, fp1, ft, ft1, tem1, tem2 + + integer :: i, k, jp1 +! +!===> ... begin here +! + laytrop= nlay + + do k = 1, nlay + + forfac(k) = pavel(k)*stpfac / (tavel(k)*(f_one + h2ovmr(k))) + +!> -# Find the two reference pressures on either side of the +!! layer pressure. store them in jp and jp1. store in fp the +!! fraction of the difference (in ln(pressure)) between these +!! two values that the layer pressure lies. + + plog = log(pavel(k)) + jp(k) = max(1, min(58, int(36.0 - 5.0*(plog+0.04)) )) + jp1 = jp(k) + 1 + fp = 5.0 * (preflog(jp(k)) - plog) + +!> -# Determine, for each reference pressure (jp and jp1), which +!! reference temperature (these are different for each reference +!! pressure) is nearest the layer temperature but does not exceed it. +!! store these indices in jt and jt1, resp. store in ft (resp. ft1) +!! the fraction of the way between jt (jt1) and the next highest +!! reference temperature that the layer temperature falls. + + tem1 = (tavel(k) - tref(jp(k))) / 15.0 + tem2 = (tavel(k) - tref(jp1 )) / 15.0 + jt (k) = max(1, min(4, int(3.0 + tem1) )) + jt1(k) = max(1, min(4, int(3.0 + tem2) )) + ft = tem1 - float(jt (k) - 3) + ft1 = tem2 - float(jt1(k) - 3) + +!> -# We have now isolated the layer ln pressure and temperature, +!! between two reference pressures and two reference temperatures +!! (for each reference pressure). we multiply the pressure +!! fraction fp with the appropriate temperature fractions to get +!! the factors that will be needed for the interpolation that yields +!! the optical depths (performed in routines taugbn for band n). + + fp1 = f_one - fp + fac10(k) = fp1 * ft + fac00(k) = fp1 * (f_one - ft) + fac11(k) = fp * ft1 + fac01(k) = fp * (f_one - ft1) + +!> -# If the pressure is less than ~100mb, perform a different +!! set of species interpolations. + + if ( plog > 4.56 ) then + + laytrop = k + +!> -# Set up factors needed to separately include the water vapor +!! foreign-continuum in the calculation of absorption coefficient. + + tem1 = (332.0 - tavel(k)) / 36.0 + indfor (k) = min(2, max(1, int(tem1))) + forfrac(k) = tem1 - float(indfor(k)) + +!> -# Set up factors needed to separately include the water vapor +!! self-continuum in the calculation of absorption coefficient. + + tem2 = (tavel(k) - 188.0) / 7.2 + indself (k) = min(9, max(1, int(tem2)-7)) + selffrac(k) = tem2 - float(indself(k) + 7) + selffac (k) = h2ovmr(k) * forfac(k) + + else + +! --- ... set up factors needed to separately include the water vapor +! foreign-continuum in the calculation of absorption coefficient. + + tem1 = (tavel(k) - 188.0) / 36.0 + indfor (k) = 3 + forfrac(k) = tem1 - f_one + + indself (k) = 0 + selffrac(k) = f_zero + selffac (k) = f_zero + + endif + + enddo ! end_do_k_loop + + return +! .................................. + end subroutine setcoef +!! @} +! ---------------------------------- + +!>\ingroup module_radsw_main +!> This subroutine computes the shortwave radiative fluxes using +!! two-stream method. +!!\param ssolar incoming solar flux at top +!!\param cosz cosine solar zenith angle +!!\param sntz secant solar zenith angle +!!\param albbm surface albedo for direct beam radiation +!!\param albdf surface albedo for diffused radiation +!!\param sfluxzen spectral distribution of incoming solar flux +!!\param cldfrc layer cloud fraction +!!\param cf1 >0: cloudy sky, otherwise: clear sky +!!\param cf0 =1-cf1 +!!\param taug spectral optical depth for gases +!!\param taur optical depth for rayleigh scattering +!!\param tauae aerosols optical depth +!!\param ssaae aerosols single scattering albedo +!!\param asyae aerosols asymmetry factor +!!\param taucw weighted cloud optical depth +!!\param ssacw weighted cloud single scat albedo +!!\param asycw weighted cloud asymmetry factor +!!\param nlay,nlp1 number of layers/levels +!!\param fxupc tot sky upward flux +!!\param fxdnc tot sky downward flux +!!\param fxup0 clr sky upward flux +!!\param fxdn0 clr sky downward flux +!!\param ftoauc tot sky toa upwd flux +!!\param ftoau0 clr sky toa upwd flux +!!\param ftoadc toa downward (incoming) solar flux +!!\param fsfcuc tot sky sfc upwd flux +!!\param fsfcu0 clr sky sfc upwd flux +!!\param fsfcdc tot sky sfc dnwd flux +!!\param fsfcd0 clr sky sfc dnwd flux +!!\param sfbmc tot sky sfc dnwd beam flux (nir/uv+vis) +!!\param sfdfc tot sky sfc dnwd diff flux (nir/uv+vis) +!!\param sfbm0 clr sky sfc dnwd beam flux (nir/uv+vis) +!!\param sfdf0 clr sky sfc dnwd diff flux (nir/uv+vis) +!!\param suvbfc tot sky sfc dnwd uv-b flux +!!\param suvbf0 clr sky sfc dnwd uv-b flux +!>\section General_spcvrtc spcvrtc General Algorithm +!! @{ +!----------------------------------- + subroutine spcvrtc & + & ( ssolar,cosz,sntz,albbm,albdf,sfluxzen,cldfrc, & ! --- inputs + & cf1,cf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & + & nlay, nlp1, & + & fxupc,fxdnc,fxup0,fxdn0, & ! --- outputs + & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & + & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & + & ) + +! =================== program usage description =================== ! +! ! +! purpose: computes the shortwave radiative fluxes using two-stream ! +! method ! +! ! +! subprograms called: vrtqdr ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! ssolar - real, incoming solar flux at top 1 ! +! cosz - real, cosine solar zenith angle 1 ! +! sntz - real, secant solar zenith angle 1 ! +! albbm - real, surface albedo for direct beam radiation 2 ! +! albdf - real, surface albedo for diffused radiation 2 ! +! sfluxzen- real, spectral distribution of incoming solar flux ngptsw! +! cldfrc - real, layer cloud fraction nlay ! +! cf1 - real, >0: cloudy sky, otherwise: clear sky 1 ! +! cf0 - real, =1-cf1 1 ! +! taug - real, spectral optical depth for gases nlay*ngptsw! +! taur - real, optical depth for rayleigh scattering nlay*ngptsw! +! tauae - real, aerosols optical depth nlay*nbdsw ! +! ssaae - real, aerosols single scattering albedo nlay*nbdsw ! +! asyae - real, aerosols asymmetry factor nlay*nbdsw ! +! taucw - real, weighted cloud optical depth nlay*nbdsw ! +! ssacw - real, weighted cloud single scat albedo nlay*nbdsw ! +! asycw - real, weighted cloud asymmetry factor nlay*nbdsw ! +! nlay,nlp1 - integer, number of layers/levels 1 ! +! ! +! output variables: ! +! fxupc - real, tot sky upward flux nlp1*nbdsw ! +! fxdnc - real, tot sky downward flux nlp1*nbdsw ! +! fxup0 - real, clr sky upward flux nlp1*nbdsw ! +! fxdn0 - real, clr sky downward flux nlp1*nbdsw ! +! ftoauc - real, tot sky toa upwd flux 1 ! +! ftoau0 - real, clr sky toa upwd flux 1 ! +! ftoadc - real, toa downward (incoming) solar flux 1 ! +! fsfcuc - real, tot sky sfc upwd flux 1 ! +! fsfcu0 - real, clr sky sfc upwd flux 1 ! +! fsfcdc - real, tot sky sfc dnwd flux 1 ! +! fsfcd0 - real, clr sky sfc dnwd flux 1 ! +! sfbmc - real, tot sky sfc dnwd beam flux (nir/uv+vis) 2 ! +! sfdfc - real, tot sky sfc dnwd diff flux (nir/uv+vis) 2 ! +! sfbm0 - real, clr sky sfc dnwd beam flux (nir/uv+vis) 2 ! +! sfdf0 - real, clr sky sfc dnwd diff flux (nir/uv+vis) 2 ! +! suvbfc - real, tot sky sfc dnwd uv-b flux 1 ! +! suvbf0 - real, clr sky sfc dnwd uv-b flux 1 ! +! ! +! internal variables: ! +! zrefb - real, direct beam reflectivity for clear/cloudy nlp1 ! +! zrefd - real, diffuse reflectivity for clear/cloudy nlp1 ! +! ztrab - real, direct beam transmissivity for clear/cloudy nlp1 ! +! ztrad - real, diffuse transmissivity for clear/cloudy nlp1 ! +! zldbt - real, layer beam transmittance for clear/cloudy nlp1 ! +! ztdbt - real, lev total beam transmittance for clr/cld nlp1 ! +! ! +! control parameters in module "physparam" ! +! iswmode - control flag for 2-stream transfer schemes ! +! = 1 delta-eddington (joseph et al., 1976) ! +! = 2 pifm (zdunkowski et al., 1980) ! +! = 3 discrete ordinates (liou, 1973) ! +! ! +! ******************************************************************* ! +! original code description ! +! ! +! method: ! +! ------- ! +! standard delta-eddington, p.i.f.m., or d.o.m. layer calculations. ! +! kmodts = 1 eddington (joseph et al., 1976) ! +! = 2 pifm (zdunkowski et al., 1980) ! +! = 3 discrete ordinates (liou, 1973) ! +! ! +! modifications: ! +! -------------- ! +! original: h. barker ! +! revision: merge with rrtmg_sw: j.-j.morcrette, ecmwf, feb 2003 ! +! revision: add adjustment for earth/sun distance:mjiacono,aer,oct2003! +! revision: bug fix for use of palbp and palbd: mjiacono, aer, nov2003! +! revision: bug fix to apply delta scaling to clear sky: aer, dec2004 ! +! revision: code modified so that delta scaling is not done in cloudy ! +! profiles if routine cldprop is used; delta scaling can be ! +! applied by swithcing code below if cldprop is not used to ! +! get cloud properties. aer, jan 2005 ! +! revision: uniform formatting for rrtmg: mjiacono, aer, jul 2006 ! +! revision: use exponential lookup table for transmittance: mjiacono, ! +! aer, aug 2007 ! +! ! +! ******************************************************************* ! +! ====================== end of description block ================= ! + +! --- constant parameters: + real (kind=kind_phys), parameter :: zcrit = 0.9999995 ! thresold for conservative scattering + real (kind=kind_phys), parameter :: zsr3 = sqrt(3.0) + real (kind=kind_phys), parameter :: od_lo = 0.06 + real (kind=kind_phys), parameter :: eps1 = 1.0e-8 + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(nlay,ngptsw), intent(in) :: & + & taug, taur + real (kind=kind_phys), dimension(nlay,nbdsw), intent(in) :: & + & taucw, ssacw, asycw, tauae, ssaae, asyae + + real (kind=kind_phys), dimension(ngptsw), intent(in) :: sfluxzen + real (kind=kind_phys), dimension(nlay), intent(in) :: cldfrc + + real (kind=kind_phys), dimension(2), intent(in) :: albbm, albdf + + real (kind=kind_phys), intent(in) :: cosz, sntz, cf1, cf0, ssolar + +! --- outputs: + real (kind=kind_phys), dimension(nlp1,nbdsw), intent(out) :: & + & fxupc, fxdnc, fxup0, fxdn0 + + real (kind=kind_phys), dimension(2), intent(out) :: sfbmc, sfdfc, & + & sfbm0, sfdf0 + + real (kind=kind_phys), intent(out) :: suvbfc, suvbf0, ftoadc, & + & ftoauc, ftoau0, fsfcuc, fsfcu0, fsfcdc, fsfcd0 + +! --- locals: + real (kind=kind_phys), dimension(nlay) :: ztaus, zssas, zasys, & + & zldbt0 + + real (kind=kind_phys), dimension(nlp1) :: zrefb, zrefd, ztrab, & + & ztrad, ztdbt, zldbt, zfu, zfd + + real (kind=kind_phys) :: ztau1, zssa1, zasy1, ztau0, zssa0, & + & zasy0, zasy3, zssaw, zasyw, zgam1, zgam2, zgam3, zgam4, & + & zc0, zc1, za1, za2, zb1, zb2, zrk, zrk2, zrp, zrp1, zrm1, & + & zrpp, zrkg1, zrkg3, zrkg4, zexp1, zexm1, zexp2, zexm2, & + & zexp3, zexp4, zden1, ze1r45, ftind, zsolar, zrefb1, & + & zrefd1, ztrab1, ztrad1, ztdbt0, zr1, zr2, zr3, zr4, zr5, & + & zt1, zt2, zt3, zf1, zf2, zrpp1 + + integer :: ib, ibd, jb, jg, k, kp, itind +! +!===> ... begin here + +!> -# Initialize output fluxes. + do ib = 1, nbdsw + do k = 1, nlp1 + fxdnc(k,ib) = f_zero + fxupc(k,ib) = f_zero + fxdn0(k,ib) = f_zero + fxup0(k,ib) = f_zero + enddo + enddo + + ftoadc = f_zero + ftoauc = f_zero + ftoau0 = f_zero + fsfcuc = f_zero + fsfcu0 = f_zero + fsfcdc = f_zero + fsfcd0 = f_zero + +!! --- ... uv-b surface downward fluxes + suvbfc = f_zero + suvbf0 = f_zero + +!! --- ... output surface flux components + sfbmc(1) = f_zero + sfbmc(2) = f_zero + sfdfc(1) = f_zero + sfdfc(2) = f_zero + sfbm0(1) = f_zero + sfbm0(2) = f_zero + sfdf0(1) = f_zero + sfdf0(2) = f_zero + +!> -# Loop over all g-points in each band. + + lab_do_jg : do jg = 1, ngptsw + + jb = NGB(jg) + ib = jb + 1 - nblow + ibd = idxsfc(jb) + + zsolar = ssolar * sfluxzen(jg) + +!> -# Set up toa direct beam and surface values (beam and diff). + + ztdbt(nlp1) = f_one + ztdbt0 = f_one + + zldbt(1) = f_zero + if (ibd /= 0) then + zrefb(1) = albbm(ibd) + zrefd(1) = albdf(ibd) + else + zrefb(1) = 0.5 * (albbm(1) + albbm(2)) + zrefd(1) = 0.5 * (albdf(1) + albdf(2)) + endif + ztrab(1) = f_zero + ztrad(1) = f_zero + +!> -# Compute clear-sky optical parameters, layer reflectance and +!! transmittance. +! - Set up toa direct beam and surface values (beam and diff). +! - Delta scaling for clear-sky condition. +! - General two-stream expressions for physparam::iswmode . +! - Compute homogeneous reflectance and transmittance for both +! conservative and non-conservative scattering. +! - Pre-delta-scaling clear and cloudy direct beam transmittance. +! - Call swflux() to compute the upward and downward radiation +! fluxes. + + do k = nlay, 1, -1 + kp = k + 1 + + ztau0 = max( ftiny, taur(k,jg)+taug(k,jg)+tauae(k,ib) ) + zssa0 = taur(k,jg) + tauae(k,ib)*ssaae(k,ib) + zasy0 = asyae(k,ib)*ssaae(k,ib)*tauae(k,ib) + zssaw = min( oneminus, zssa0 / ztau0 ) + zasyw = zasy0 / max( ftiny, zssa0 ) + +!> - Saving clear-sky quantities for later total-sky usage. + ztaus(k) = ztau0 + zssas(k) = zssa0 + zasys(k) = zasy0 + +!> - Delta scaling for clear-sky condition. + za1 = zasyw * zasyw + za2 = zssaw * za1 + + ztau1 = (f_one - za2) * ztau0 + zssa1 = (zssaw - za2) / (f_one - za2) +!org zasy1 = (zasyw - za1) / (f_one - za1) ! this line is replaced by the next + zasy1 = zasyw / (f_one + zasyw) ! to reduce truncation error + zasy3 = 0.75 * zasy1 + +!> - Perform general two-stream expressions: +!!\n control parameters in module "physparam" +!!\n iswmode - control flag for 2-stream transfer schemes +!!\n = 1 delta-eddington (joseph et al., 1976) +!!\n = 2 pifm (zdunkowski et al., 1980) +!!\n = 3 discrete ordinates (liou, 1973) + if ( iswmode == 1 ) then + zgam1 = 1.75 - zssa1 * (f_one + zasy3) + zgam2 =-0.25 + zssa1 * (f_one - zasy3) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 2 ) then ! pifm + zgam1 = 2.0 - zssa1 * (1.25 + zasy3) + zgam2 = 0.75* zssa1 * (f_one- zasy1) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 3 ) then ! discrete ordinates + zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 + zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 + zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 + endif + zgam4 = f_one - zgam3 + +!> - Compute homogeneous reflectance and transmittance for both conservative +!! scattering and non-conservative scattering. + + if ( zssaw >= zcrit ) then ! for conservative scattering + za1 = zgam1 * cosz - zgam3 + za2 = zgam1 * ztau1 + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( ztau1*sntz , 500.0 ) + if ( zb1 <= od_lo ) then + zb2 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zb2 = exp_tbl(itind) + endif + +! ... collimated beam + zrefb(kp) = max(f_zero, min(f_one, & + & (za2 - za1*(f_one - zb2))/(f_one + za2) )) + ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp) )) + +! ... isotropic incidence + zrefd(kp) = max(f_zero, min(f_one, za2/(f_one + za2) )) + ztrad(kp) = max(f_zero, min(f_one, f_one-zrefd(kp) )) + + else ! for non-conservative scattering + za1 = zgam1*zgam4 + zgam2*zgam3 + za2 = zgam1*zgam3 + zgam2*zgam4 + zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) + zrk2= 2.0 * zrk + + zrp = zrk * cosz + zrp1 = f_one + zrp + zrm1 = f_one - zrp + zrpp1= f_one - zrp*zrp + zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity + zrkg1= zrk + zgam1 + zrkg3= zrk * zgam3 + zrkg4= zrk * zgam4 + + zr1 = zrm1 * (za2 + zrkg3) + zr2 = zrp1 * (za2 - zrkg3) + zr3 = zrk2 * (zgam3 - za2*cosz) + zr4 = zrpp * zrkg1 + zr5 = zrpp * (zrk - zgam1) + + zt1 = zrp1 * (za1 + zrkg4) + zt2 = zrm1 * (za1 - zrkg4) + zt3 = zrk2 * (zgam4 + za1*cosz) + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( zrk*ztau1, 500.0 ) + if ( zb1 <= od_lo ) then + zexm1 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zexm1 = exp_tbl(itind) + endif + zexp1 = f_one / zexm1 + + zb2 = min ( sntz*ztau1, 500.0 ) + if ( zb2 <= od_lo ) then + zexm2 = f_one - zb2 + 0.5*zb2*zb2 + else + ftind = zb2 / (bpade + zb2) + itind = ftind*NTBMX + 0.5 + zexm2 = exp_tbl(itind) + endif + zexp2 = f_one / zexm2 + ze1r45 = zr4*zexp1 + zr5*zexm1 + +! ... collimated beam + if (ze1r45>=-eps1 .and. ze1r45<=eps1) then + zrefb(kp) = eps1 + ztrab(kp) = zexm2 + else + zden1 = zssa1 / ze1r45 + zrefb(kp) = max(f_zero, min(f_one, & + & (zr1*zexp1 - zr2*zexm1 - zr3*zexm2)*zden1 )) + ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one & + & - (zt1*zexp1 - zt2*zexm1 - zt3*zexp2)*zden1) )) + endif + +! ... diffuse beam + zden1 = zr4 / (ze1r45 * zrkg1) + zrefd(kp) = max(f_zero, min(f_one, & + & zgam2*(zexp1 - zexm1)*zden1 )) + ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) + endif ! end if_zssaw_block + +!> - Calculate direct beam transmittance. use exponential lookup table +!! for transmittance, or expansion of exponential for low optical depth. + + zr1 = ztau1 * sntz + if ( zr1 <= od_lo ) then + zexp3 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp3 = exp_tbl(itind) + endif + + ztdbt(k) = zexp3 * ztdbt(kp) + zldbt(kp) = zexp3 + +!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. +! (must use 'orig', unscaled cloud optical depth) + + zr1 = ztau0 * sntz + if ( zr1 <= od_lo ) then + zexp4 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp4 = exp_tbl(itind) + endif + + zldbt0(k) = zexp4 + ztdbt0 = zexp4 * ztdbt0 + enddo ! end do_k_loop + +!> -# Call vrtqdr(), to compute the upward and downward radiation fluxes. + call vrtqdr & +! --- inputs: + & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & + & nlay, nlp1, & +! --- outputs: + & zfu, zfd & + & ) + +!> -# Compute upward and downward fluxes at levels. + do k = 1, nlp1 + fxup0(k,ib) = fxup0(k,ib) + zsolar*zfu(k) + fxdn0(k,ib) = fxdn0(k,ib) + zsolar*zfd(k) + enddo + +!> -# Compute surface downward beam/diffused flux components. + zb1 = zsolar*ztdbt0 + zb2 = zsolar*(zfd(1) - ztdbt0) + + if (ibd /= 0) then + sfbm0(ibd) = sfbm0(ibd) + zb1 + sfdf0(ibd) = sfdf0(ibd) + zb2 + else + zf1 = 0.5 * zb1 + zf2 = 0.5 * zb2 + sfbm0(1) = sfbm0(1) + zf1 + sfdf0(1) = sfdf0(1) + zf2 + sfbm0(2) = sfbm0(2) + zf1 + sfdf0(2) = sfdf0(2) + zf2 + endif +! sfbm0(ibd) = sfbm0(ibd) + zsolar*ztdbt0 +! sfdf0(ibd) = sfdf0(ibd) + zsolar*(zfd(1) - ztdbt0) + +!> -# Compute total sky optical parameters, layer reflectance and +!! transmittance. +! - Set up toa direct beam and surface values (beam and diff) +! - Delta scaling for total-sky condition +! - General two-stream expressions for physparam::iswmode +! - Compute homogeneous reflectance and transmittance for +! conservative scattering and non-conservative scattering +! - Pre-delta-scaling clear and cloudy direct beam transmittance +! - Call swflux() to compute the upward and downward radiation fluxes + + if ( cf1 > eps ) then + +!> - Set up toa direct beam and surface values (beam and diff). + ztdbt0 = f_one + zldbt(1) = f_zero + + do k = nlay, 1, -1 + kp = k + 1 + zc0 = f_one - cldfrc(k) + zc1 = cldfrc(k) + if ( zc1 > ftiny ) then ! it is a cloudy-layer + + ztau0 = ztaus(k) + taucw(k,ib) + zssa0 = zssas(k) + ssacw(k,ib) + zasy0 = zasys(k) + asycw(k,ib) + zssaw = min(oneminus, zssa0 / ztau0) + zasyw = zasy0 / max(ftiny, zssa0) + +!> - Perform delta scaling for total-sky condition. + za1 = zasyw * zasyw + za2 = zssaw * za1 + + ztau1 = (f_one - za2) * ztau0 + zssa1 = (zssaw - za2) / (f_one - za2) +!org zasy1 = (zasyw - za1) / (f_one - za1) + zasy1 = zasyw / (f_one + zasyw) + zasy3 = 0.75 * zasy1 + +!> - Perform general two-stream expressions: +!!\n control parameters in module "physparam" +!!\n iswmode - control flag for 2-stream transfer schemes +!!\n = 1 delta-eddington (joseph et al., 1976) +!!\n = 2 pifm (zdunkowski et al., 1980) +!!\n = 3 discrete ordinates (liou, 1973) + + if ( iswmode == 1 ) then + zgam1 = 1.75 - zssa1 * (f_one + zasy3) + zgam2 =-0.25 + zssa1 * (f_one - zasy3) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 2 ) then ! pifm + zgam1 = 2.0 - zssa1 * (1.25 + zasy3) + zgam2 = 0.75* zssa1 * (f_one- zasy1) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 3 ) then ! discrete ordinates + zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 + zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 + zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 + endif + zgam4 = f_one - zgam3 + + zrefb1 = zrefb(kp) + zrefd1 = zrefd(kp) + ztrab1 = ztrab(kp) + ztrad1 = ztrad(kp) + +!> - Compute homogeneous reflectance and transmittance for both conservative +!! and non-conservative scattering. + + if ( zssaw >= zcrit ) then ! for conservative scattering + za1 = zgam1 * cosz - zgam3 + za2 = zgam1 * ztau1 + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( ztau1*sntz , 500.0 ) + if ( zb1 <= od_lo ) then + zb2 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zb2 = exp_tbl(itind) + endif + +! ... collimated beam + zrefb(kp) = max(f_zero, min(f_one, & + & (za2 - za1*(f_one - zb2))/(f_one + za2) )) + ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp))) + +! ... isotropic incidence + zrefd(kp) = max(f_zero, min(f_one, za2 / (f_one+za2) )) + ztrad(kp) = max(f_zero, min(f_one, f_one - zrefd(kp) )) + + else ! for non-conservative scattering + za1 = zgam1*zgam4 + zgam2*zgam3 + za2 = zgam1*zgam3 + zgam2*zgam4 + zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) + zrk2= 2.0 * zrk + + zrp = zrk * cosz + zrp1 = f_one + zrp + zrm1 = f_one - zrp + zrpp1= f_one - zrp*zrp + zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity + zrkg1= zrk + zgam1 + zrkg3= zrk * zgam3 + zrkg4= zrk * zgam4 + + zr1 = zrm1 * (za2 + zrkg3) + zr2 = zrp1 * (za2 - zrkg3) + zr3 = zrk2 * (zgam3 - za2*cosz) + zr4 = zrpp * zrkg1 + zr5 = zrpp * (zrk - zgam1) + + zt1 = zrp1 * (za1 + zrkg4) + zt2 = zrm1 * (za1 - zrkg4) + zt3 = zrk2 * (zgam4 + za1*cosz) + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( zrk*ztau1, 500.0 ) + if ( zb1 <= od_lo ) then + zexm1 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zexm1 = exp_tbl(itind) + endif + zexp1 = f_one / zexm1 + + zb2 = min ( ztau1*sntz, 500.0 ) + if ( zb2 <= od_lo ) then + zexm2 = f_one - zb2 + 0.5*zb2*zb2 + else + ftind = zb2 / (bpade + zb2) + itind = ftind*NTBMX + 0.5 + zexm2 = exp_tbl(itind) + endif + zexp2 = f_one / zexm2 + ze1r45 = zr4*zexp1 + zr5*zexm1 + +! ... collimated beam + if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then + zrefb(kp) = eps1 + ztrab(kp) = zexm2 + else + zden1 = zssa1 / ze1r45 + zrefb(kp) = max(f_zero, min(f_one, & + & (zr1*zexp1-zr2*zexm1-zr3*zexm2)*zden1 )) + ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one - & + & (zt1*zexp1-zt2*zexm1-zt3*zexp2)*zden1) )) + endif + +! ... diffuse beam + zden1 = zr4 / (ze1r45 * zrkg1) + zrefd(kp) = max(f_zero, min(f_one, & + & zgam2*(zexp1 - zexm1)*zden1 )) + ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) + endif ! end if_zssaw_block + +! --- ... combine clear and cloudy contributions for total sky +! and calculate direct beam transmittances + + zrefb(kp) = zc0*zrefb1 + zc1*zrefb(kp) + zrefd(kp) = zc0*zrefd1 + zc1*zrefd(kp) + ztrab(kp) = zc0*ztrab1 + zc1*ztrab(kp) + ztrad(kp) = zc0*ztrad1 + zc1*ztrad(kp) + +! --- ... direct beam transmittance. use exponential lookup table +! for transmittance, or expansion of exponential for low +! optical depth + + zr1 = ztau1 * sntz + if ( zr1 <= od_lo ) then + zexp3 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp3 = exp_tbl(itind) + endif + + zldbt(kp) = zc0*zldbt(kp) + zc1*zexp3 + ztdbt(k) = zldbt(kp) * ztdbt(kp) + +!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. +! (must use 'orig', unscaled cloud optical depth) + + zr1 = ztau0 * sntz + if ( zr1 <= od_lo ) then + zexp4 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp4 = exp_tbl(itind) + endif + + ztdbt0 = (zc0*zldbt0(k) + zc1*zexp4) * ztdbt0 + + else ! if_zc1_block --- it is a clear layer + +! --- ... direct beam transmittance + ztdbt(k) = zldbt(kp) * ztdbt(kp) + +! --- ... pre-delta-scaling clear and cloudy direct beam transmittance + ztdbt0 = zldbt0(k) * ztdbt0 + + endif ! end if_zc1_block + enddo ! end do_k_loop + +!> -# Call vrtqdr(), to compute the upward and downward radiation fluxes. + + call vrtqdr & +! --- inputs: + & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & + & nlay, nlp1, & +! --- outputs: + & zfu, zfd & + & ) + +!> -# Compute upward and downward fluxes at levels. + do k = 1, nlp1 + fxupc(k,ib) = fxupc(k,ib) + zsolar*zfu(k) + fxdnc(k,ib) = fxdnc(k,ib) + zsolar*zfd(k) + enddo + +!> -# Process and save outputs. +!! - surface downward beam/diffused flux components + zb1 = zsolar*ztdbt0 + zb2 = zsolar*(zfd(1) - ztdbt0) + + if (ibd /= 0) then + sfbmc(ibd) = sfbmc(ibd) + zb1 + sfdfc(ibd) = sfdfc(ibd) + zb2 + else + zf1 = 0.5 * zb1 + zf2 = 0.5 * zb2 + sfbmc(1) = sfbmc(1) + zf1 + sfdfc(1) = sfdfc(1) + zf2 + sfbmc(2) = sfbmc(2) + zf1 + sfdfc(2) = sfdfc(2) + zf2 + endif +! sfbmc(ibd) = sfbmc(ibd) + zsolar*ztdbt0 +! sfdfc(ibd) = sfdfc(ibd) + zsolar*(zfd(1) - ztdbt0) + + endif ! end if_cf1_block + + enddo lab_do_jg + +! --- ... end of g-point loop + + do ib = 1, nbdsw + ftoadc = ftoadc + fxdn0(nlp1,ib) + ftoau0 = ftoau0 + fxup0(nlp1,ib) + fsfcu0 = fsfcu0 + fxup0(1,ib) + fsfcd0 = fsfcd0 + fxdn0(1,ib) + enddo + +!> - uv-b surface downward flux + ibd = nuvb - nblow + 1 + suvbf0 = fxdn0(1,ibd) + + if ( cf1 <= eps ) then ! clear column, set total-sky=clear-sky fluxes + do ib = 1, nbdsw + do k = 1, nlp1 + fxupc(k,ib) = fxup0(k,ib) + fxdnc(k,ib) = fxdn0(k,ib) + enddo + enddo + + ftoauc = ftoau0 + fsfcuc = fsfcu0 + fsfcdc = fsfcd0 + +!> - surface downward beam/diffused flux components + sfbmc(1) = sfbm0(1) + sfdfc(1) = sfdf0(1) + sfbmc(2) = sfbm0(2) + sfdfc(2) = sfdf0(2) + +!> - uv-b surface downward flux + suvbfc = suvbf0 + else ! cloudy column, compute total-sky fluxes + do ib = 1, nbdsw + do k = 1, nlp1 + fxupc(k,ib) = cf1*fxupc(k,ib) + cf0*fxup0(k,ib) + fxdnc(k,ib) = cf1*fxdnc(k,ib) + cf0*fxdn0(k,ib) + enddo + enddo + + do ib = 1, nbdsw + ftoauc = ftoauc + fxupc(nlp1,ib) + fsfcuc = fsfcuc + fxupc(1,ib) + fsfcdc = fsfcdc + fxdnc(1,ib) + enddo + +!> - uv-b surface downward flux + suvbfc = fxdnc(1,ibd) + +!> - surface downward beam/diffused flux components + sfbmc(1) = cf1*sfbmc(1) + cf0*sfbm0(1) + sfbmc(2) = cf1*sfbmc(2) + cf0*sfbm0(2) + sfdfc(1) = cf1*sfdfc(1) + cf0*sfdf0(1) + sfdfc(2) = cf1*sfdfc(2) + cf0*sfdf0(2) + endif ! end if_cf1_block + + return +!................................... + end subroutine spcvrtc +!----------------------------------- +!> @} + +!>\ingroup module_radsw_main +!> This subroutine computes the shortwave radiative fluxes using +!! two-stream method of h. barder and mcica,the monte-carlo independent +!! column approximation, for the representation of sub-grid cloud +!! variability (i.e. cloud overlap). +!!\param ssolar incoming solar flux at top +!!\param cosz cosine solar zenith angle +!!\param sntz secant solar zenith angle +!!\param albbm surface albedo for direct beam radiation +!!\param albdf surface albedo for diffused radiation +!!\param sfluxzen spectral distribution of incoming solar flux +!!\param cldfmc layer cloud fraction for g-point +!!\param cf1 >0: cloudy sky, otherwise: clear sky +!!\param cf0 =1-cf1 +!!\param taug spectral optical depth for gases +!!\param taur optical depth for rayleigh scattering +!!\param tauae aerosols optical depth +!!\param ssaae aerosols single scattering albedo +!!\param asyae aerosols asymmetry factor +!!\param taucw weighted cloud optical depth +!!\param ssacw weighted cloud single scat albedo +!!\param asycw weighted cloud asymmetry factor +!!\param nlay,nlp1 number of layers/levels +!!\param fxupc tot sky upward flux +!!\param fxdnc tot sky downward flux +!!\param fxup0 clr sky upward flux +!!\param fxdn0 clr sky downward flux +!!\param ftoauc tot sky toa upwd flux +!!\param ftoau0 clr sky toa upwd flux +!!\param ftoadc toa downward (incoming) solar flux +!!\param fsfcuc tot sky sfc upwd flux +!!\param fsfcu0 clr sky sfc upwd flux +!!\param fsfcdc tot sky sfc dnwd flux +!!\param fsfcd0 clr sky sfc dnwd flux +!!\param sfbmc tot sky sfc dnwd beam flux (nir/uv+vis) +!!\param sfdfc tot sky sfc dnwd diff flux (nir/uv+vis) +!!\param sfbm0 clr sky sfc dnwd beam flux (nir/uv+vis) +!!\param sfdf0 clr sky sfc dnwd diff flux (nir/uv+vis) +!!\param suvbfc tot sky sfc dnwd uv-b flux +!!\param suvbf0 clr sky sfc dnwd uv-b flux +!>\section spcvrtm_gen spcvrtm General Algorithm +!! @{ +!----------------------------------- + subroutine spcvrtm & + & ( ssolar,cosz,sntz,albbm,albdf,sfluxzen,cldfmc, & ! --- inputs + & cf1,cf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & + & nlay, nlp1, & + & fxupc,fxdnc,fxup0,fxdn0, & ! --- outputs + & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & + & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & + & ) + +! =================== program usage description =================== ! +! ! +! purpose: computes the shortwave radiative fluxes using two-stream ! +! method of h. barker and mcica, the monte-carlo independent! +! column approximation, for the representation of sub-grid ! +! cloud variability (i.e. cloud overlap). ! +! ! +! subprograms called: vrtqdr ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! ssolar - real, incoming solar flux at top 1 ! +! cosz - real, cosine solar zenith angle 1 ! +! sntz - real, secant solar zenith angle 1 ! +! albbm - real, surface albedo for direct beam radiation 2 ! +! albdf - real, surface albedo for diffused radiation 2 ! +! sfluxzen- real, spectral distribution of incoming solar flux ngptsw! +! cldfmc - real, layer cloud fraction for g-point nlay*ngptsw! +! cf1 - real, >0: cloudy sky, otherwise: clear sky 1 ! +! cf0 - real, =1-cf1 1 ! +! taug - real, spectral optical depth for gases nlay*ngptsw! +! taur - real, optical depth for rayleigh scattering nlay*ngptsw! +! tauae - real, aerosols optical depth nlay*nbdsw ! +! ssaae - real, aerosols single scattering albedo nlay*nbdsw ! +! asyae - real, aerosols asymmetry factor nlay*nbdsw ! +! taucw - real, weighted cloud optical depth nlay*nbdsw ! +! ssacw - real, weighted cloud single scat albedo nlay*nbdsw ! +! asycw - real, weighted cloud asymmetry factor nlay*nbdsw ! +! nlay,nlp1 - integer, number of layers/levels 1 ! +! ! +! output variables: ! +! fxupc - real, tot sky upward flux nlp1*nbdsw ! +! fxdnc - real, tot sky downward flux nlp1*nbdsw ! +! fxup0 - real, clr sky upward flux nlp1*nbdsw ! +! fxdn0 - real, clr sky downward flux nlp1*nbdsw ! +! ftoauc - real, tot sky toa upwd flux 1 ! +! ftoau0 - real, clr sky toa upwd flux 1 ! +! ftoadc - real, toa downward (incoming) solar flux 1 ! +! fsfcuc - real, tot sky sfc upwd flux 1 ! +! fsfcu0 - real, clr sky sfc upwd flux 1 ! +! fsfcdc - real, tot sky sfc dnwd flux 1 ! +! fsfcd0 - real, clr sky sfc dnwd flux 1 ! +! sfbmc - real, tot sky sfc dnwd beam flux (nir/uv+vis) 2 ! +! sfdfc - real, tot sky sfc dnwd diff flux (nir/uv+vis) 2 ! +! sfbm0 - real, clr sky sfc dnwd beam flux (nir/uv+vis) 2 ! +! sfdf0 - real, clr sky sfc dnwd diff flux (nir/uv+vis) 2 ! +! suvbfc - real, tot sky sfc dnwd uv-b flux 1 ! +! suvbf0 - real, clr sky sfc dnwd uv-b flux 1 ! +! ! +! internal variables: ! +! zrefb - real, direct beam reflectivity for clear/cloudy nlp1 ! +! zrefd - real, diffuse reflectivity for clear/cloudy nlp1 ! +! ztrab - real, direct beam transmissivity for clear/cloudy nlp1 ! +! ztrad - real, diffuse transmissivity for clear/cloudy nlp1 ! +! zldbt - real, layer beam transmittance for clear/cloudy nlp1 ! +! ztdbt - real, lev total beam transmittance for clr/cld nlp1 ! +! ! +! control parameters in module "physparam" ! +! iswmode - control flag for 2-stream transfer schemes ! +! = 1 delta-eddington (joseph et al., 1976) ! +! = 2 pifm (zdunkowski et al., 1980) ! +! = 3 discrete ordinates (liou, 1973) ! +! ! +! ******************************************************************* ! +! original code description ! +! ! +! method: ! +! ------- ! +! standard delta-eddington, p.i.f.m., or d.o.m. layer calculations. ! +! kmodts = 1 eddington (joseph et al., 1976) ! +! = 2 pifm (zdunkowski et al., 1980) ! +! = 3 discrete ordinates (liou, 1973) ! +! ! +! modifications: ! +! -------------- ! +! original: h. barker ! +! revision: merge with rrtmg_sw: j.-j.morcrette, ecmwf, feb 2003 ! +! revision: add adjustment for earth/sun distance:mjiacono,aer,oct2003! +! revision: bug fix for use of palbp and palbd: mjiacono, aer, nov2003! +! revision: bug fix to apply delta scaling to clear sky: aer, dec2004 ! +! revision: code modified so that delta scaling is not done in cloudy ! +! profiles if routine cldprop is used; delta scaling can be ! +! applied by swithcing code below if cldprop is not used to ! +! get cloud properties. aer, jan 2005 ! +! revision: uniform formatting for rrtmg: mjiacono, aer, jul 2006 ! +! revision: use exponential lookup table for transmittance: mjiacono, ! +! aer, aug 2007 ! +! ! +! ******************************************************************* ! +! ====================== end of description block ================= ! + +! --- constant parameters: + real (kind=kind_phys), parameter :: zcrit = 0.9999995 ! thresold for conservative scattering + real (kind=kind_phys), parameter :: zsr3 = sqrt(3.0) + real (kind=kind_phys), parameter :: od_lo = 0.06 + real (kind=kind_phys), parameter :: eps1 = 1.0e-8 + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(nlay,ngptsw), intent(in) :: & + & taug, taur, cldfmc + real (kind=kind_phys), dimension(nlay,nbdsw), intent(in) :: & + & taucw, ssacw, asycw, tauae, ssaae, asyae + + real (kind=kind_phys), dimension(ngptsw), intent(in) :: sfluxzen + + real (kind=kind_phys), dimension(2), intent(in) :: albbm, albdf + + real (kind=kind_phys), intent(in) :: cosz, sntz, cf1, cf0, ssolar + +! --- outputs: + real (kind=kind_phys), dimension(nlp1,nbdsw), intent(out) :: & + & fxupc, fxdnc, fxup0, fxdn0 + + real (kind=kind_phys), dimension(2), intent(out) :: sfbmc, sfdfc, & + & sfbm0, sfdf0 + + real (kind=kind_phys), intent(out) :: suvbfc, suvbf0, ftoadc, & + & ftoauc, ftoau0, fsfcuc, fsfcu0, fsfcdc, fsfcd0 + +! --- locals: + real (kind=kind_phys), dimension(nlay) :: ztaus, zssas, zasys, & + & zldbt0 + + real (kind=kind_phys), dimension(nlp1) :: zrefb, zrefd, ztrab, & + & ztrad, ztdbt, zldbt, zfu, zfd + + real (kind=kind_phys) :: ztau1, zssa1, zasy1, ztau0, zssa0, & + & zasy0, zasy3, zssaw, zasyw, zgam1, zgam2, zgam3, zgam4, & + & za1, za2, zb1, zb2, zrk, zrk2, zrp, zrp1, zrm1, zrpp, & + & zrkg1, zrkg3, zrkg4, zexp1, zexm1, zexp2, zexm2, zden1, & + & zexp3, zexp4, ze1r45, ftind, zsolar, ztdbt0, zr1, zr2, & + & zr3, zr4, zr5, zt1, zt2, zt3, zf1, zf2, zrpp1 + + integer :: ib, ibd, jb, jg, k, kp, itind +! +!===> ... begin here +! +!> -# Initialize output fluxes. + + do ib = 1, nbdsw + do k = 1, nlp1 + fxdnc(k,ib) = f_zero + fxupc(k,ib) = f_zero + fxdn0(k,ib) = f_zero + fxup0(k,ib) = f_zero + enddo + enddo + + ftoadc = f_zero + ftoauc = f_zero + ftoau0 = f_zero + fsfcuc = f_zero + fsfcu0 = f_zero + fsfcdc = f_zero + fsfcd0 = f_zero + +!! --- ... uv-b surface downward fluxes + suvbfc = f_zero + suvbf0 = f_zero + +!! --- ... output surface flux components + sfbmc(1) = f_zero + sfbmc(2) = f_zero + sfdfc(1) = f_zero + sfdfc(2) = f_zero + sfbm0(1) = f_zero + sfbm0(2) = f_zero + sfdf0(1) = f_zero + sfdf0(2) = f_zero + +!> -# Loop over all g-points in each band. + + lab_do_jg : do jg = 1, ngptsw + + jb = NGB(jg) + ib = jb + 1 - nblow + ibd = idxsfc(jb) ! spectral band index + + zsolar = ssolar * sfluxzen(jg) + +!> -# Set up toa direct beam and surface values (beam and diff). + + ztdbt(nlp1) = f_one + ztdbt0 = f_one + + zldbt(1) = f_zero + if (ibd /= 0) then + zrefb(1) = albbm(ibd) + zrefd(1) = albdf(ibd) + else + zrefb(1) = 0.5 * (albbm(1) + albbm(2)) + zrefd(1) = 0.5 * (albdf(1) + albdf(2)) + endif + ztrab(1) = f_zero + ztrad(1) = f_zero + +!> -# Compute clear-sky optical parameters, layer reflectance and +!! transmittance. +! - Set up toa direct beam and surface values (beam and diff) +! - Delta scaling for clear-sky condition +! - General two-stream expressions for physparam::iswmode +! - Compute homogeneous reflectance and transmittance for both +! conservative and non-conservative scattering +! - Pre-delta-scaling clear and cloudy direct beam transmittance +! - Call swflux() to compute the upward and downward radiation fluxes + + do k = nlay, 1, -1 + kp = k + 1 + + ztau0 = max( ftiny, taur(k,jg)+taug(k,jg)+tauae(k,ib) ) + zssa0 = taur(k,jg) + tauae(k,ib)*ssaae(k,ib) + zasy0 = asyae(k,ib)*ssaae(k,ib)*tauae(k,ib) + zssaw = min( oneminus, zssa0 / ztau0 ) + zasyw = zasy0 / max( ftiny, zssa0 ) + +!> - Saving clear-sky quantities for later total-sky usage. + ztaus(k) = ztau0 + zssas(k) = zssa0 + zasys(k) = zasy0 + +!> - Delta scaling for clear-sky condition. + za1 = zasyw * zasyw + za2 = zssaw * za1 + + ztau1 = (f_one - za2) * ztau0 + zssa1 = (zssaw - za2) / (f_one - za2) +!org zasy1 = (zasyw - za1) / (f_one - za1) ! this line is replaced by the next + zasy1 = zasyw / (f_one + zasyw) ! to reduce truncation error + zasy3 = 0.75 * zasy1 + +!> - Perform general two-stream expressions: +!!\n control parameters in module "physparam" +!!\n iswmode - control flag for 2-stream transfer schemes +!!\n = 1 delta-eddington (joseph et al., 1976) +!!\n = 2 pifm (zdunkowski et al., 1980) +!!\n = 3 discrete ordinates (liou, 1973) + if ( iswmode == 1 ) then + zgam1 = 1.75 - zssa1 * (f_one + zasy3) + zgam2 =-0.25 + zssa1 * (f_one - zasy3) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 2 ) then ! pifm + zgam1 = 2.0 - zssa1 * (1.25 + zasy3) + zgam2 = 0.75* zssa1 * (f_one- zasy1) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 3 ) then ! discrete ordinates + zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 + zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 + zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 + endif + zgam4 = f_one - zgam3 + +!> - Compute homogeneous reflectance and transmittance. + + if ( zssaw >= zcrit ) then ! for conservative scattering + za1 = zgam1 * cosz - zgam3 + za2 = zgam1 * ztau1 + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( ztau1*sntz , 500.0 ) + if ( zb1 <= od_lo ) then + zb2 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zb2 = exp_tbl(itind) + endif + +! ... collimated beam + zrefb(kp) = max(f_zero, min(f_one, & + & (za2 - za1*(f_one - zb2))/(f_one + za2) )) + ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp) )) + +! ... isotropic incidence + zrefd(kp) = max(f_zero, min(f_one, za2/(f_one + za2) )) + ztrad(kp) = max(f_zero, min(f_one, f_one-zrefd(kp) )) + + else ! for non-conservative scattering + za1 = zgam1*zgam4 + zgam2*zgam3 + za2 = zgam1*zgam3 + zgam2*zgam4 + zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) + zrk2= 2.0 * zrk + + zrp = zrk * cosz + zrp1 = f_one + zrp + zrm1 = f_one - zrp + zrpp1= f_one - zrp*zrp + zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity + zrkg1= zrk + zgam1 + zrkg3= zrk * zgam3 + zrkg4= zrk * zgam4 + + zr1 = zrm1 * (za2 + zrkg3) + zr2 = zrp1 * (za2 - zrkg3) + zr3 = zrk2 * (zgam3 - za2*cosz) + zr4 = zrpp * zrkg1 + zr5 = zrpp * (zrk - zgam1) + + zt1 = zrp1 * (za1 + zrkg4) + zt2 = zrm1 * (za1 - zrkg4) + zt3 = zrk2 * (zgam4 + za1*cosz) + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( zrk*ztau1, 500.0 ) + if ( zb1 <= od_lo ) then + zexm1 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zexm1 = exp_tbl(itind) + endif + zexp1 = f_one / zexm1 + + zb2 = min ( sntz*ztau1, 500.0 ) + if ( zb2 <= od_lo ) then + zexm2 = f_one - zb2 + 0.5*zb2*zb2 + else + ftind = zb2 / (bpade + zb2) + itind = ftind*NTBMX + 0.5 + zexm2 = exp_tbl(itind) + endif + zexp2 = f_one / zexm2 + ze1r45 = zr4*zexp1 + zr5*zexm1 + +! ... collimated beam + if (ze1r45>=-eps1 .and. ze1r45<=eps1) then + zrefb(kp) = eps1 + ztrab(kp) = zexm2 + else + zden1 = zssa1 / ze1r45 + zrefb(kp) = max(f_zero, min(f_one, & + & (zr1*zexp1 - zr2*zexm1 - zr3*zexm2)*zden1 )) + ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one & + & - (zt1*zexp1 - zt2*zexm1 - zt3*zexp2)*zden1) )) + endif + +! ... diffuse beam + zden1 = zr4 / (ze1r45 * zrkg1) + zrefd(kp) = max(f_zero, min(f_one, & + & zgam2*(zexp1 - zexm1)*zden1 )) + ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) + endif ! end if_zssaw_block + +!> - Calculate direct beam transmittance. use exponential lookup table +!! for transmittance, or expansion of exponential for low optical depth. + + zr1 = ztau1 * sntz + if ( zr1 <= od_lo ) then + zexp3 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp3 = exp_tbl(itind) + endif + + ztdbt(k) = zexp3 * ztdbt(kp) + zldbt(kp) = zexp3 + +!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. +! (must use 'orig', unscaled cloud optical depth) + + zr1 = ztau0 * sntz + if ( zr1 <= od_lo ) then + zexp4 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp4 = exp_tbl(itind) + endif + + zldbt0(k) = zexp4 + ztdbt0 = zexp4 * ztdbt0 + enddo ! end do_k_loop + +!> -# Call vrtqdr(), to compute the upward and downward radiation fluxes. + call vrtqdr & +! --- inputs: + & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & + & nlay, nlp1, & +! --- outputs: + & zfu, zfd & + & ) + +!> -# Compute upward and downward fluxes at levels. + do k = 1, nlp1 + fxup0(k,ib) = fxup0(k,ib) + zsolar*zfu(k) + fxdn0(k,ib) = fxdn0(k,ib) + zsolar*zfd(k) + enddo + +!> -# Compute surface downward beam/diffuse flux components. + zb1 = zsolar*ztdbt0 + zb2 = zsolar*(zfd(1) - ztdbt0) + + if (ibd /= 0) then + sfbm0(ibd) = sfbm0(ibd) + zb1 + sfdf0(ibd) = sfdf0(ibd) + zb2 + else + zf1 = 0.5 * zb1 + zf2 = 0.5 * zb2 + sfbm0(1) = sfbm0(1) + zf1 + sfdf0(1) = sfdf0(1) + zf2 + sfbm0(2) = sfbm0(2) + zf1 + sfdf0(2) = sfdf0(2) + zf2 + endif +! sfbm0(ibd) = sfbm0(ibd) + zsolar*ztdbt0 +! sfdf0(ibd) = sfdf0(ibd) + zsolar*(zfd(1) - ztdbt0) + +!> -# Compute total sky optical parameters, layer reflectance and +!! transmittance. +! - Set up toa direct beam and surface values (beam and diff) +! - Delta scaling for total-sky condition +! - General two-stream expressions for physparam::iswmode +! - Compute homogeneous reflectance and transmittance for +! conservative scattering and non-conservative scattering +! - Pre-delta-scaling clear and cloudy direct beam transmittance +! - Call swflux() to compute the upward and downward radiation fluxes + + if ( cf1 > eps ) then + +!> - Set up toa direct beam and surface values (beam and diff). + ztdbt0 = f_one + zldbt(1) = f_zero + + do k = nlay, 1, -1 + kp = k + 1 + if ( cldfmc(k,jg) > ftiny ) then ! it is a cloudy-layer + + ztau0 = ztaus(k) + taucw(k,ib) + zssa0 = zssas(k) + ssacw(k,ib) + zasy0 = zasys(k) + asycw(k,ib) + zssaw = min(oneminus, zssa0 / ztau0) + zasyw = zasy0 / max(ftiny, zssa0) + +!> - Perform delta scaling for total-sky condition. + za1 = zasyw * zasyw + za2 = zssaw * za1 + + ztau1 = (f_one - za2) * ztau0 + zssa1 = (zssaw - za2) / (f_one - za2) +!org zasy1 = (zasyw - za1) / (f_one - za1) + zasy1 = zasyw / (f_one + zasyw) + zasy3 = 0.75 * zasy1 + +!> - Perform general two-stream expressions. + if ( iswmode == 1 ) then + zgam1 = 1.75 - zssa1 * (f_one + zasy3) + zgam2 =-0.25 + zssa1 * (f_one - zasy3) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 2 ) then ! pifm + zgam1 = 2.0 - zssa1 * (1.25 + zasy3) + zgam2 = 0.75* zssa1 * (f_one- zasy1) + zgam3 = 0.5 - zasy3 * cosz + elseif ( iswmode == 3 ) then ! discrete ordinates + zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 + zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 + zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 + endif + zgam4 = f_one - zgam3 + +!> - Compute homogeneous reflectance and transmittance for both convertive +!! and non-convertive scattering. + + if ( zssaw >= zcrit ) then ! for conservative scattering + za1 = zgam1 * cosz - zgam3 + za2 = zgam1 * ztau1 + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( ztau1*sntz , 500.0 ) + if ( zb1 <= od_lo ) then + zb2 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zb2 = exp_tbl(itind) + endif + +! ... collimated beam + zrefb(kp) = max(f_zero, min(f_one, & + & (za2 - za1*(f_one - zb2))/(f_one + za2) )) + ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp))) + +! ... isotropic incidence + zrefd(kp) = max(f_zero, min(f_one, za2 / (f_one+za2) )) + ztrad(kp) = max(f_zero, min(f_one, f_one - zrefd(kp) )) + + else ! for non-conservative scattering + za1 = zgam1*zgam4 + zgam2*zgam3 + za2 = zgam1*zgam3 + zgam2*zgam4 + zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) + zrk2= 2.0 * zrk + + zrp = zrk * cosz + zrp1 = f_one + zrp + zrm1 = f_one - zrp + zrpp1= f_one - zrp*zrp + zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity + zrkg1= zrk + zgam1 + zrkg3= zrk * zgam3 + zrkg4= zrk * zgam4 + + zr1 = zrm1 * (za2 + zrkg3) + zr2 = zrp1 * (za2 - zrkg3) + zr3 = zrk2 * (zgam3 - za2*cosz) + zr4 = zrpp * zrkg1 + zr5 = zrpp * (zrk - zgam1) + + zt1 = zrp1 * (za1 + zrkg4) + zt2 = zrm1 * (za1 - zrkg4) + zt3 = zrk2 * (zgam4 + za1*cosz) + +! --- ... use exponential lookup table for transmittance, or expansion +! of exponential for low optical depth + + zb1 = min ( zrk*ztau1, 500.0 ) + if ( zb1 <= od_lo ) then + zexm1 = f_one - zb1 + 0.5*zb1*zb1 + else + ftind = zb1 / (bpade + zb1) + itind = ftind*NTBMX + 0.5 + zexm1 = exp_tbl(itind) + endif + zexp1 = f_one / zexm1 + + zb2 = min ( ztau1*sntz, 500.0 ) + if ( zb2 <= od_lo ) then + zexm2 = f_one - zb2 + 0.5*zb2*zb2 + else + ftind = zb2 / (bpade + zb2) + itind = ftind*NTBMX + 0.5 + zexm2 = exp_tbl(itind) + endif + zexp2 = f_one / zexm2 + ze1r45 = zr4*zexp1 + zr5*zexm1 + +! ... collimated beam + if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then + zrefb(kp) = eps1 + ztrab(kp) = zexm2 + else + zden1 = zssa1 / ze1r45 + zrefb(kp) = max(f_zero, min(f_one, & + & (zr1*zexp1-zr2*zexm1-zr3*zexm2)*zden1 )) + ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one - & + & (zt1*zexp1-zt2*zexm1-zt3*zexp2)*zden1) )) + endif + +! ... diffuse beam + zden1 = zr4 / (ze1r45 * zrkg1) + zrefd(kp) = max(f_zero, min(f_one, & + & zgam2*(zexp1 - zexm1)*zden1 )) + ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) + endif ! end if_zssaw_block + +! --- ... direct beam transmittance. use exponential lookup table +! for transmittance, or expansion of exponential for low +! optical depth + + zr1 = ztau1 * sntz + if ( zr1 <= od_lo ) then + zexp3 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp3 = exp_tbl(itind) + endif + + zldbt(kp) = zexp3 + ztdbt(k) = zexp3 * ztdbt(kp) + +! --- ... pre-delta-scaling clear and cloudy direct beam transmittance +! (must use 'orig', unscaled cloud optical depth) + + zr1 = ztau0 * sntz + if ( zr1 <= od_lo ) then + zexp4 = f_one - zr1 + 0.5*zr1*zr1 + else + ftind = zr1 / (bpade + zr1) + itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) + zexp4 = exp_tbl(itind) + endif + + ztdbt0 = zexp4 * ztdbt0 + + else ! if_cldfmc_block --- it is a clear layer + +! --- ... direct beam transmittance + ztdbt(k) = zldbt(kp) * ztdbt(kp) + +!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. + ztdbt0 = zldbt0(k) * ztdbt0 + + endif ! end if_cldfmc_block + enddo ! end do_k_loop + +!> -# Call vrtqdr(), to perform vertical quadrature + + call vrtqdr & +! --- inputs: + & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & + & nlay, nlp1, & +! --- outputs: + & zfu, zfd & + & ) + +! --- ... compute upward and downward fluxes at levels + do k = 1, nlp1 + fxupc(k,ib) = fxupc(k,ib) + zsolar*zfu(k) + fxdnc(k,ib) = fxdnc(k,ib) + zsolar*zfd(k) + enddo + +!> -# Process and save outputs. +!! - surface downward beam/diffused flux components + zb1 = zsolar*ztdbt0 + zb2 = zsolar*(zfd(1) - ztdbt0) + + if (ibd /= 0) then + sfbmc(ibd) = sfbmc(ibd) + zb1 + sfdfc(ibd) = sfdfc(ibd) + zb2 + else + zf1 = 0.5 * zb1 + zf2 = 0.5 * zb2 + sfbmc(1) = sfbmc(1) + zf1 + sfdfc(1) = sfdfc(1) + zf2 + sfbmc(2) = sfbmc(2) + zf1 + sfdfc(2) = sfdfc(2) + zf2 + endif +! sfbmc(ibd) = sfbmc(ibd) + zsolar*ztdbt0 +! sfdfc(ibd) = sfdfc(ibd) + zsolar*(zfd(1) - ztdbt0) + + endif ! end if_cf1_block + + enddo lab_do_jg + +! --- ... end of g-point loop + + do ib = 1, nbdsw + ftoadc = ftoadc + fxdn0(nlp1,ib) + ftoau0 = ftoau0 + fxup0(nlp1,ib) + fsfcu0 = fsfcu0 + fxup0(1,ib) + fsfcd0 = fsfcd0 + fxdn0(1,ib) + enddo + +!> - uv-b surface downward flux + ibd = nuvb - nblow + 1 + suvbf0 = fxdn0(1,ibd) + + if ( cf1 <= eps ) then ! clear column, set total-sky=clear-sky fluxes + do ib = 1, nbdsw + do k = 1, nlp1 + fxupc(k,ib) = fxup0(k,ib) + fxdnc(k,ib) = fxdn0(k,ib) + enddo + enddo + + ftoauc = ftoau0 + fsfcuc = fsfcu0 + fsfcdc = fsfcd0 + +!> - surface downward beam/diffused flux components + sfbmc(1) = sfbm0(1) + sfdfc(1) = sfdf0(1) + sfbmc(2) = sfbm0(2) + sfdfc(2) = sfdf0(2) + +!> - uv-b surface downward flux + suvbfc = suvbf0 + else ! cloudy column, compute total-sky fluxes + do ib = 1, nbdsw + ftoauc = ftoauc + fxupc(nlp1,ib) + fsfcuc = fsfcuc + fxupc(1,ib) + fsfcdc = fsfcdc + fxdnc(1,ib) + enddo + +!! --- ... uv-b surface downward flux + suvbfc = fxdnc(1,ibd) + endif ! end if_cf1_block + + return +!................................... + end subroutine spcvrtm +!! @} +!----------------------------------- + +!>\ingroup module_radsw_main +!> This subroutine is called by spcvrtc() and spcvrtm(), and computes +!! the upward and downward radiation fluxes. +!!\param zrefb layer direct beam reflectivity +!!\param zrefd layer diffuse reflectivity +!!\param ztrab layer direct beam transmissivity +!!\param ztrad layer diffuse transmissivity +!!\param zldbt layer mean beam transmittance +!!\param ztdbt total beam transmittance at levels +!!\param NLAY, NLP1 number of layers/levels +!!\param zfu upward flux at layer interface +!!\param zfd downward flux at layer interface +!!\section General_vrtqdr vrtqdr General Algorithm +!> @{ +!----------------------------------- + subroutine vrtqdr & + & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & ! inputs + & NLAY, NLP1, & + & zfu, zfd & ! outputs: + & ) + +! =================== program usage description =================== ! +! ! +! purpose: computes the upward and downward radiation fluxes ! +! ! +! interface: "vrtqdr" is called by "spcvrc" and "spcvrm" ! +! ! +! subroutines called : none ! +! ! +! ==================== defination of variables ==================== ! +! ! +! input variables: ! +! zrefb(NLP1) - layer direct beam reflectivity ! +! zrefd(NLP1) - layer diffuse reflectivity ! +! ztrab(NLP1) - layer direct beam transmissivity ! +! ztrad(NLP1) - layer diffuse transmissivity ! +! zldbt(NLP1) - layer mean beam transmittance ! +! ztdbt(NLP1) - total beam transmittance at levels ! +! NLAY, NLP1 - number of layers/levels ! +! ! +! output variables: ! +! zfu (NLP1) - upward flux at layer interface ! +! zfd (NLP1) - downward flux at layer interface ! +! ! +! ******************************************************************* ! +! ====================== end of description block ================= ! + +! --- inputs: + integer, intent(in) :: nlay, nlp1 + + real (kind=kind_phys), dimension(nlp1), intent(in) :: zrefb, & + & zrefd, ztrab, ztrad, ztdbt, zldbt + +! --- outputs: + real (kind=kind_phys), dimension(nlp1), intent(out) :: zfu, zfd + +! --- locals: + real (kind=kind_phys), dimension(nlp1) :: zrupb,zrupd,zrdnd,ztdn + + real (kind=kind_phys) :: zden1 + + integer :: k, kp +! +!===> ... begin here +! + +!> -# Link lowest layer with surface. + zrupb(1) = zrefb(1) ! direct beam + zrupd(1) = zrefd(1) ! diffused + +!> -# Pass from bottom to top. + do k = 1, nlay + kp = k + 1 + + zden1 = f_one / ( f_one - zrupd(k)*zrefd(kp) ) + zrupb(kp) = zrefb(kp) + ( ztrad(kp) * & + & ( (ztrab(kp) - zldbt(kp))*zrupd(k) + & + & zldbt(kp)*zrupb(k)) ) * zden1 + zrupd(kp) = zrefd(kp) + ztrad(kp)*ztrad(kp)*zrupd(k)*zden1 + enddo + +!> -# Upper boundary conditions + ztdn (nlp1) = f_one + zrdnd(nlp1) = f_zero + ztdn (nlay) = ztrab(nlp1) + zrdnd(nlay) = zrefd(nlp1) + +!> -# Pass from top to bottom + do k = nlay, 2, -1 + zden1 = f_one / (f_one - zrefd(k)*zrdnd(k)) + ztdn (k-1) = ztdbt(k)*ztrab(k) + ( ztrad(k) * & + & ( (ztdn(k) - ztdbt(k)) + ztdbt(k) * & + & zrefb(k)*zrdnd(k) )) * zden1 + zrdnd(k-1) = zrefd(k) + ztrad(k)*ztrad(k)*zrdnd(k)*zden1 + enddo + +!> -# Up and down-welling fluxes at levels. + do k = 1, nlp1 + zden1 = f_one / (f_one - zrdnd(k)*zrupd(k)) + zfu(k) = ( ztdbt(k)*zrupb(k) + & + & (ztdn(k) - ztdbt(k))*zrupd(k) ) * zden1 + zfd(k) = ztdbt(k) + ( ztdn(k) - ztdbt(k) + & + & ztdbt(k)*zrupb(k)*zrdnd(k) ) * zden1 + enddo + + return +!................................... + end subroutine vrtqdr +!----------------------------------- +!> @} + +!>\ingroup module_radsw_main +!> This subroutine calculates optical depths for gaseous absorption and +!! rayleigh scattering +!!\n subroutine called taumol## (## = 16-29) +!!\param colamt column amounts of absorbing gases the index +!! are for h2o, co2, o3, n2o, ch4, and o2, +!! respectively \f$(mol/cm^2)\f$ +!!\param colmol total column amount (dry air+water vapor) +!!\param fac00,fac01,fac10,fac11 for each layer, these are factors that are +!! needed to compute the interpolation factors +!! that multiply the appropriate reference +!! k-values. a value of 0/1 for i,j indicates +!! that the corresponding factor multiplies +!! reference k-value for the lower/higher of the +!! two appropriate temperatures, and altitudes, +!! respectively. +!!\param jp the index of the lower (in altitude) of the +!! two appropriate ref pressure levels needed +!! for interpolation. +!!\param jt, jt1 the indices of the lower of the two approp +!! ref temperatures needed for interpolation +!! (for pressure levels jp and jp+1, respectively) +!!\param laytrop tropopause layer index +!!\param forfac scale factor needed to foreign-continuum. +!!\param forfrac factor needed for temperature interpolation +!!\param indfor index of the lower of the two appropriate +!! reference temperatures needed for +!! foreign-continuum interpolation +!!\param selffac scale factor needed to h2o self-continuum. +!!\param selffrac factor needed for temperature interpolation +!! of reference h2o self-continuum data +!!\param indself index of the lower of the two appropriate +!! reference temperatures needed for the +!! self-continuum interpolation +!!\param nlay number of vertical layers +!!\param sfluxzen spectral distribution of incoming solar flux +!!\param taug spectral optical depth for gases +!!\param taur opt depth for rayleigh scattering +!>\section gen_al_taumol taumol General Algorithm +!! @{ +!----------------------------------- + subroutine taumol & + & ( colamt,colmol,fac00,fac01,fac10,fac11,jp,jt,jt1,laytrop, & ! --- inputs + & forfac,forfrac,indfor,selffac,selffrac,indself, nlay, & + & sfluxzen, taug, taur & ! --- outputs + & ) + +! ================== program usage description ================== ! +! ! +! description: ! +! calculate optical depths for gaseous absorption and rayleigh ! +! scattering. ! +! ! +! subroutines called: taugb## (## = 16 - 29) ! +! ! +! ==================== defination of variables ==================== ! +! ! +! inputs: size ! +! colamt - real, column amounts of absorbing gases the index ! +! are for h2o, co2, o3, n2o, ch4, and o2, ! +! respectively (molecules/cm**2) nlay*maxgas! +! colmol - real, total column amount (dry air+water vapor) nlay ! +! facij - real, for each layer, these are factors that are ! +! needed to compute the interpolation factors ! +! that multiply the appropriate reference k- ! +! values. a value of 0/1 for i,j indicates ! +! that the corresponding factor multiplies ! +! reference k-value for the lower/higher of the ! +! two appropriate temperatures, and altitudes, ! +! respectively. naly ! +! jp - real, the index of the lower (in altitude) of the ! +! two appropriate ref pressure levels needed ! +! for interpolation. nlay ! +! jt, jt1 - integer, the indices of the lower of the two approp ! +! ref temperatures needed for interpolation (for ! +! pressure levels jp and jp+1, respectively) nlay ! +! laytrop - integer, tropopause layer index 1 ! +! forfac - real, scale factor needed to foreign-continuum. nlay ! +! forfrac - real, factor needed for temperature interpolation nlay ! +! indfor - integer, index of the lower of the two appropriate ! +! reference temperatures needed for foreign- ! +! continuum interpolation nlay ! +! selffac - real, scale factor needed to h2o self-continuum. nlay ! +! selffrac- real, factor needed for temperature interpolation ! +! of reference h2o self-continuum data nlay ! +! indself - integer, index of the lower of the two appropriate ! +! reference temperatures needed for the self- ! +! continuum interpolation nlay ! +! nlay - integer, number of vertical layers 1 ! +! ! +! output: ! +! sfluxzen- real, spectral distribution of incoming solar flux ngptsw! +! taug - real, spectral optical depth for gases nlay*ngptsw! +! taur - real, opt depth for rayleigh scattering nlay*ngptsw! +! ! +! =================================================================== ! +! ************ original subprogram description *************** ! +! ! +! optical depths developed for the ! +! ! +! rapid radiative transfer model (rrtm) ! +! ! +! atmospheric and environmental research, inc. ! +! 131 hartwell avenue ! +! lexington, ma 02421 ! +! ! +! ! +! eli j. mlawer ! +! jennifer delamere ! +! steven j. taubman ! +! shepard a. clough ! +! ! +! ! +! ! +! email: mlawer@aer.com ! +! email: jdelamer@aer.com ! +! ! +! the authors wish to acknowledge the contributions of the ! +! following people: patrick d. brown, michael j. iacono, ! +! ronald e. farren, luke chen, robert bergstrom. ! +! ! +! ******************************************************************* ! +! ! +! taumol ! +! ! +! this file contains the subroutines taugbn (where n goes from ! +! 16 to 29). taugbn calculates the optical depths and Planck ! +! fractions per g-value and layer for band n. ! +! ! +! output: optical depths (unitless) ! +! fractions needed to compute planck functions at every layer ! +! and g-value ! +! ! +! modifications: ! +! ! +! revised: adapted to f90 coding, j.-j.morcrette, ecmwf, feb 2003 ! +! revised: modified for g-point reduction, mjiacono, aer, dec 2003 ! +! revised: reformatted for consistency with rrtmg_lw, mjiacono, aer, ! +! jul 2006 ! +! ! +! ******************************************************************* ! +! ====================== end of description block ================= ! + +! --- inputs: + integer, intent(in) :: nlay, laytrop + + integer, dimension(nlay), intent(in) :: indfor, indself, & + & jp, jt, jt1 + + real (kind=kind_phys), dimension(nlay), intent(in) :: colmol, & + & fac00, fac01, fac10, fac11, forfac, forfrac, selffac, & + & selffrac + + real (kind=kind_phys), dimension(nlay,maxgas),intent(in) :: colamt + +! --- outputs: + real (kind=kind_phys), dimension(ngptsw), intent(out) :: sfluxzen + + real (kind=kind_phys), dimension(nlay,ngptsw), intent(out) :: & + & taug, taur + +! --- locals: + real (kind=kind_phys) :: fs, speccomb, specmult, colm1, colm2 + + integer, dimension(nlay,nblow:nbhgh) :: id0, id1 + + integer :: ibd, j, jb, js, k, klow, khgh, klim, ks, njb, ns +! +!===> ... begin here +! +! --- ... loop over each spectral band + + do jb = nblow, nbhgh + +! --- ... indices for layer optical depth + + do k = 1, laytrop + id0(k,jb) = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(jb) + id1(k,jb) = ( jp(k) *5 + (jt1(k)-1)) * nspa(jb) + enddo + + do k = laytrop+1, nlay + id0(k,jb) = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(jb) + id1(k,jb) = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(jb) + enddo + +! --- ... calculate spectral flux at toa + + ibd = ibx(jb) + njb = ng (jb) + ns = ngs(jb) + + select case (jb) + + case (16, 20, 23, 25, 26, 29) + + do j = 1, njb + sfluxzen(ns+j) = sfluxref01(j,1,ibd) + enddo + + case (27) + + do j = 1, njb + sfluxzen(ns+j) = scalekur * sfluxref01(j,1,ibd) + enddo + + case default + + if (jb==17 .or. jb==28) then + + ks = nlay + lab_do_k1 : do k = laytrop, nlay-1 + if (jp(k)=layreffr(jb)) then + ks = k + 1 + exit lab_do_k1 + endif + enddo lab_do_k1 + + colm1 = colamt(ks,ix1(jb)) + colm2 = colamt(ks,ix2(jb)) + speccomb = colm1 + strrat(jb)*colm2 + specmult = specwt(jb) * min( oneminus, colm1/speccomb ) + js = 1 + int( specmult ) + fs = mod(specmult, f_one) + + do j = 1, njb + sfluxzen(ns+j) = sfluxref02(j,js,ibd) & + & + fs * (sfluxref02(j,js+1,ibd) - sfluxref02(j,js,ibd)) + enddo + + else + + ks = laytrop + lab_do_k2 : do k = 1, laytrop-1 + if (jp(k)=layreffr(jb)) then + ks = k + 1 + exit lab_do_k2 + endif + enddo lab_do_k2 + + colm1 = colamt(ks,ix1(jb)) + colm2 = colamt(ks,ix2(jb)) + speccomb = colm1 + strrat(jb)*colm2 + specmult = specwt(jb) * min( oneminus, colm1/speccomb ) + js = 1 + int( specmult ) + fs = mod(specmult, f_one) + + do j = 1, njb + sfluxzen(ns+j) = sfluxref03(j,js,ibd) & + & + fs * (sfluxref03(j,js+1,ibd) - sfluxref03(j,js,ibd)) + enddo + + endif + + end select + + enddo + +!> - Call taumol## (##: 16-29) to calculate layer optical depth. + +!> - call taumol16() + call taumol16 +!> - call taumol17() + call taumol17 +!> - call taumol18() + call taumol18 +!> - call taumol19() + call taumol19 +!> - call taumol20() + call taumol20 +!> - call taumol21() + call taumol21 +!> - call taumol22() + call taumol22 +!> - call taumol23() + call taumol23 +!> - call taumol24() + call taumol24 +!> - call taumol25() + call taumol25 +!> - call taumol26() + call taumol26 +!> - call taumol27() + call taumol27 +!> - call taumol28() + call taumol28 +!> - call taumol29() + call taumol29 + + +! ================= + contains +! ================= + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 16: 2600-3250 +!! cm-1 (low - h2o,ch4; high - ch4) +!----------------------------------- + subroutine taumol16 +!................................... + +! ------------------------------------------------------------------ ! +! band 16: 2600-3250 cm-1 (low - h2o,ch4; high - ch4) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb16 + +! --- locals: + + real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: inds, indf, indsp, indfp, j, js, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG16 + taur(k,NS16+j) = tauray + enddo + enddo + + do k = 1, laytrop + speccomb = colamt(k,1) + strrat(16)*colamt(k,5) + specmult = 8.0 * min( oneminus, colamt(k,1)/speccomb ) + + js = 1 + int( specmult ) + fs = mod( specmult, f_one ) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,16) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,16) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG16 + taug(k,NS16+j) = speccomb & + & *( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & + & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & + & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + enddo + enddo + + do k = laytrop+1, nlay + ind01 = id0(k,16) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,16) + 1 + ind12 = ind11 + 1 + + do j = 1, NG16 + taug(k,NS16+j) = colamt(k,5) & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) + enddo + enddo + + return +!................................... + end subroutine taumol16 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 17: 3250-4000 +!! cm-1 (low - h2o,co2; high - h2o,co2) +!----------------------------------- + subroutine taumol17 +!................................... + +! ------------------------------------------------------------------ ! +! band 17: 3250-4000 cm-1 (low - h2o,co2; high - h2o,co2) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb17 + +! --- locals: + real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: inds, indf, indsp, indfp, j, js, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG17 + taur(k,NS17+j) = tauray + enddo + enddo + + do k = 1, laytrop + speccomb = colamt(k,1) + strrat(17)*colamt(k,2) + specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,17) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,17) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG17 + taug(k,NS17+j) = speccomb & + & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & + & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & + & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + enddo + enddo + + do k = laytrop+1, nlay + speccomb = colamt(k,1) + strrat(17)*colamt(k,2) + specmult = 4.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,17) + js + ind02 = ind01 + 1 + ind03 = ind01 + 5 + ind04 = ind01 + 6 + ind11 = id1(k,17) + js + ind12 = ind11 + 1 + ind13 = ind11 + 5 + ind14 = ind11 + 6 + + indf = indfor(k) + indfp= indf + 1 + + do j = 1, NG17 + taug(k,NS17+j) = speccomb & + & * ( fac000 * absb(ind01,j) + fac100 * absb(ind02,j) & + & + fac010 * absb(ind03,j) + fac110 * absb(ind04,j) & + & + fac001 * absb(ind11,j) + fac101 * absb(ind12,j) & + & + fac011 * absb(ind13,j) + fac111 * absb(ind14,j) ) & + & + colamt(k,1) * forfac(k) * (forref(indf,j) & + & + forfrac(k) * (forref(indfp,j) - forref(indf,j))) + enddo + enddo + + return +!................................... + end subroutine taumol17 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 18: 4000-4650 +!! cm-1 (low - h2o,ch4; high - ch4) +!----------------------------------- + subroutine taumol18 +!................................... + +! ------------------------------------------------------------------ ! +! band 18: 4000-4650 cm-1 (low - h2o,ch4; high - ch4) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb18 + +! --- locals: + real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: inds, indf, indsp, indfp, j, js, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG18 + taur(k,NS18+j) = tauray + enddo + enddo + + do k = 1, laytrop + speccomb = colamt(k,1) + strrat(18)*colamt(k,5) + specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,18) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,18) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG18 + taug(k,NS18+j) = speccomb & + & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & + & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & + & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + enddo + enddo + + do k = laytrop+1, nlay + ind01 = id0(k,18) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,18) + 1 + ind12 = ind11 + 1 + + do j = 1, NG18 + taug(k,NS18+j) = colamt(k,5) & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) + enddo + enddo + + return +!................................... + end subroutine taumol18 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 19: 4650-5150 +!! cm-1 (low - h2o,co2; high - co2) +!----------------------------------- + subroutine taumol19 +!................................... + +! ------------------------------------------------------------------ ! +! band 19: 4650-5150 cm-1 (low - h2o,co2; high - co2) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb19 + +! --- locals: + real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: inds, indf, indsp, indfp, j, js, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG19 + taur(k,NS19+j) = tauray + enddo + enddo + + do k = 1, laytrop + speccomb = colamt(k,1) + strrat(19)*colamt(k,2) + specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,19) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,19) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG19 + taug(k,NS19+j) = speccomb & + & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & + & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & + & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + enddo + enddo + + do k = laytrop+1, nlay + ind01 = id0(k,19) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,19) + 1 + ind12 = ind11 + 1 + + do j = 1, NG19 + taug(k,NS19+j) = colamt(k,2) & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) + enddo + enddo + +!................................... + end subroutine taumol19 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 20: 5150-6150 +!! cm-1 (low - h2o; high - h2o) +!----------------------------------- + subroutine taumol20 +!................................... + +! ------------------------------------------------------------------ ! +! band 20: 5150-6150 cm-1 (low - h2o; high - h2o) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb20 + +! --- locals: + real (kind=kind_phys) :: tauray + + integer :: ind01, ind02, ind11, ind12 + integer :: inds, indf, indsp, indfp, j, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG20 + taur(k,NS20+j) = tauray + enddo + enddo + + do k = 1, laytrop + ind01 = id0(k,20) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,20) + 1 + ind12 = ind11 + 1 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG20 + taug(k,NS20+j) = colamt(k,1) & + & * ( (fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & + & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j)) & + & + selffac(k) * (selfref(inds,j) + selffrac(k) & + & * (selfref(indsp,j) - selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j))) ) & + & + colamt(k,5) * absch4(j) + enddo + enddo + + do k = laytrop+1, nlay + ind01 = id0(k,20) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,20) + 1 + ind12 = ind11 + 1 + + indf = indfor(k) + indfp= indf + 1 + + do j = 1, NG20 + taug(k,NS20+j) = colamt(k,1) & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j))) ) & + & + colamt(k,5) * absch4(j) + enddo + enddo + + return +!................................... + end subroutine taumol20 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 21: 6150-7700 +!! cm-1 (low - h2o,co2; high - h2o,co2) +!----------------------------------- + subroutine taumol21 +!................................... + +! ------------------------------------------------------------------ ! +! band 21: 6150-7700 cm-1 (low - h2o,co2; high - h2o,co2) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb21 + +! --- locals: + real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: inds, indf, indsp, indfp, j, js, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG21 + taur(k,NS21+j) = tauray + enddo + enddo + + do k = 1, laytrop + speccomb = colamt(k,1) + strrat(21)*colamt(k,2) + specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,21) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,21) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG21 + taug(k,NS21+j) = speccomb & + & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & + & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & + & + selffrac(k) * (selfref(indsp,j) - selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + enddo + enddo + + do k = laytrop+1, nlay + speccomb = colamt(k,1) + strrat(21)*colamt(k,2) + specmult = 4.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,21) + js + ind02 = ind01 + 1 + ind03 = ind01 + 5 + ind04 = ind01 + 6 + ind11 = id1(k,21) + js + ind12 = ind11 + 1 + ind13 = ind11 + 5 + ind14 = ind11 + 6 + + indf = indfor(k) + indfp= indf + 1 + + do j = 1, NG21 + taug(k,NS21+j) = speccomb & + & * ( fac000 * absb(ind01,j) + fac100 * absb(ind02,j) & + & + fac010 * absb(ind03,j) + fac110 * absb(ind04,j) & + & + fac001 * absb(ind11,j) + fac101 * absb(ind12,j) & + & + fac011 * absb(ind13,j) + fac111 * absb(ind14,j) ) & + & + colamt(k,1) * forfac(k) * (forref(indf,j) & + & + forfrac(k) * (forref(indfp,j) - forref(indf,j))) + enddo + enddo + +!................................... + end subroutine taumol21 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 22: 7700-8050 +!! cm-1 (low - h2o,o2; high - o2) +!----------------------------------- + subroutine taumol22 +!................................... + +! ------------------------------------------------------------------ ! +! band 22: 7700-8050 cm-1 (low - h2o,o2; high - o2) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb22 + +! --- locals: + real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111, & + & o2adj, o2cont, o2tem + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: inds, indf, indsp, indfp, j, js, k + +! +!===> ... begin here +! +! --- ... the following factor is the ratio of total o2 band intensity (lines +! and mate continuum) to o2 band intensity (line only). it is needed +! to adjust the optical depths since the k's include only lines. + + o2adj = 1.6 + o2tem = 4.35e-4 / (350.0*2.0) + + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG22 + taur(k,NS22+j) = tauray + enddo + enddo + + do k = 1, laytrop + o2cont = o2tem * colamt(k,6) + speccomb = colamt(k,1) + strrat(22)*colamt(k,6) + specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,22) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,22) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG22 + taug(k,NS22+j) = speccomb & + & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & + & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & + & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + o2cont + enddo + enddo + + do k = laytrop+1, nlay + o2cont = o2tem * colamt(k,6) + + ind01 = id0(k,22) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,22) + 1 + ind12 = ind11 + 1 + + do j = 1, NG22 + taug(k,NS22+j) = colamt(k,6) * o2adj & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) & + & + o2cont + enddo + enddo + + return +!................................... + end subroutine taumol22 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 23: 8050-12850 +!! cm-1 (low - h2o; high - nothing) +!----------------------------------- + subroutine taumol23 +!................................... + +! ------------------------------------------------------------------ ! +! band 23: 8050-12850 cm-1 (low - h2o; high - nothing) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb23 + +! --- locals: + integer :: ind01, ind02, ind11, ind12 + integer :: inds, indf, indsp, indfp, j, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + do j = 1, NG23 + taur(k,NS23+j) = colmol(k) * rayl(j) + enddo + enddo + + do k = 1, laytrop + ind01 = id0(k,23) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,23) + 1 + ind12 = ind11 + 1 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG23 + taug(k,NS23+j) = colamt(k,1) * (givfac & + & * ( fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & + & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) & + & + selffac(k) * (selfref(inds,j) + selffrac(k) & + & * (selfref(indsp,j) - selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + enddo + enddo + + do k = laytrop+1, nlay + do j = 1, NG23 + taug(k,NS23+j) = f_zero + enddo + enddo + +!................................... + end subroutine taumol23 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 24: 12850-16000 +!! cm-1 (low - h2o,o2; high - o2) +!----------------------------------- + subroutine taumol24 +!................................... + +! ------------------------------------------------------------------ ! +! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb24 + +! --- locals: + real (kind=kind_phys) :: speccomb, specmult, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: inds, indf, indsp, indfp, j, js, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, laytrop + speccomb = colamt(k,1) + strrat(24)*colamt(k,6) + specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,24) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,24) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG24 + taug(k,NS24+j) = speccomb & + & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & + & + colamt(k,3) * abso3a(j) + colamt(k,1) & + & * (selffac(k) * (selfref(inds,j) + selffrac(k) & + & * (selfref(indsp,j) - selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) + + taur(k,NS24+j) = colmol(k) & + & * (rayla(j,js) + fs*(rayla(j,js+1) - rayla(j,js))) + enddo + enddo + + do k = laytrop+1, nlay + ind01 = id0(k,24) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,24) + 1 + ind12 = ind11 + 1 + + do j = 1, NG24 + taug(k,NS24+j) = colamt(k,6) & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) & + & + colamt(k,3) * abso3b(j) + + taur(k,NS24+j) = colmol(k) * raylb(j) + enddo + enddo + + return +!................................... + end subroutine taumol24 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 25: 16000-22650 +!! cm-1 (low - h2o; high - nothing) +!----------------------------------- + subroutine taumol25 +!................................... + +! ------------------------------------------------------------------ ! +! band 25: 16000-22650 cm-1 (low - h2o; high - nothing) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb25 + +! --- locals: + integer :: ind01, ind02, ind11, ind12 + integer :: j, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + do j = 1, NG25 + taur(k,NS25+j) = colmol(k) * rayl(j) + enddo + enddo + + do k = 1, laytrop + ind01 = id0(k,25) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,25) + 1 + ind12 = ind11 + 1 + + do j = 1, NG25 + taug(k,NS25+j) = colamt(k,1) & + & * ( fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & + & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) & + & + colamt(k,3) * abso3a(j) + enddo + enddo + + do k = laytrop+1, nlay + do j = 1, NG25 + taug(k,NS25+j) = colamt(k,3) * abso3b(j) + enddo + enddo + + return +!................................... + end subroutine taumol25 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 26: 22650-29000 +!! cm-1 (low - nothing; high - nothing) +!----------------------------------- + subroutine taumol26 +!................................... + +! ------------------------------------------------------------------ ! +! band 26: 22650-29000 cm-1 (low - nothing; high - nothing) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb26 + +! --- locals: + integer :: j, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + do j = 1, NG26 + taug(k,NS26+j) = f_zero + taur(k,NS26+j) = colmol(k) * rayl(j) + enddo + enddo + + return +!................................... + end subroutine taumol26 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 27: 29000-38000 +!! cm-1 (low - o3; high - o3) +!----------------------------------- + subroutine taumol27 +!................................... + +! ------------------------------------------------------------------ ! +! band 27: 29000-38000 cm-1 (low - o3; high - o3) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb27 +! +! --- locals: + integer :: ind01, ind02, ind11, ind12 + integer :: j, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + do j = 1, NG27 + taur(k,NS27+j) = colmol(k) * rayl(j) + enddo + enddo + + do k = 1, laytrop + ind01 = id0(k,27) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,27) + 1 + ind12 = ind11 + 1 + + do j = 1, NG27 + taug(k,NS27+j) = colamt(k,3) & + & * ( fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & + & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) + enddo + enddo + + do k = laytrop+1, nlay + ind01 = id0(k,27) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,27) + 1 + ind12 = ind11 + 1 + + do j = 1, NG27 + taug(k,NS27+j) = colamt(k,3) & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) + enddo + enddo + + return +!................................... + end subroutine taumol27 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 28: 38000-50000 +!! cm-1 (low - o3,o2; high - o3,o2) +!----------------------------------- + subroutine taumol28 +!................................... + +! ------------------------------------------------------------------ ! +! band 28: 38000-50000 cm-1 (low - o3,o2; high - o3,o2) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb28 + +! --- locals: + real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & + & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 + + integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 + integer :: j, js, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG28 + taur(k,NS28+j) = tauray + enddo + enddo + + do k = 1, laytrop + speccomb = colamt(k,3) + strrat(28)*colamt(k,6) + specmult = 8.0 * min(oneminus, colamt(k,3) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,28) + js + ind02 = ind01 + 1 + ind03 = ind01 + 9 + ind04 = ind01 + 10 + ind11 = id1(k,28) + js + ind12 = ind11 + 1 + ind13 = ind11 + 9 + ind14 = ind11 + 10 + + do j = 1, NG28 + taug(k,NS28+j) = speccomb & + & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & + & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & + & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & + & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) + enddo + enddo + + do k = laytrop+1, nlay + speccomb = colamt(k,3) + strrat(28)*colamt(k,6) + specmult = 4.0 * min(oneminus, colamt(k,3) / speccomb) + + js = 1 + int(specmult) + fs = mod(specmult, f_one) + fs1= f_one - fs + fac000 = fs1 * fac00(k) + fac010 = fs1 * fac10(k) + fac100 = fs * fac00(k) + fac110 = fs * fac10(k) + fac001 = fs1 * fac01(k) + fac011 = fs1 * fac11(k) + fac101 = fs * fac01(k) + fac111 = fs * fac11(k) + + ind01 = id0(k,28) + js + ind02 = ind01 + 1 + ind03 = ind01 + 5 + ind04 = ind01 + 6 + ind11 = id1(k,28) + js + ind12 = ind11 + 1 + ind13 = ind11 + 5 + ind14 = ind11 + 6 + + do j = 1, NG28 + taug(k,NS28+j) = speccomb & + & * ( fac000 * absb(ind01,j) + fac100 * absb(ind02,j) & + & + fac010 * absb(ind03,j) + fac110 * absb(ind04,j) & + & + fac001 * absb(ind11,j) + fac101 * absb(ind12,j) & + & + fac011 * absb(ind13,j) + fac111 * absb(ind14,j) ) + enddo + enddo + + return +!................................... + end subroutine taumol28 +!----------------------------------- + +!>\ingroup module_radsw_main +!> The subroutine computes the optical depth in band 29: 820-2600 +!! cm-1 (low - h2o; high - co2) +!----------------------------------- + subroutine taumol29 +!................................... + +! ------------------------------------------------------------------ ! +! band 29: 820-2600 cm-1 (low - h2o; high - co2) ! +! ------------------------------------------------------------------ ! +! + use module_radsw_kgb29 + +! --- locals: + real (kind=kind_phys) :: tauray + + integer :: ind01, ind02, ind11, ind12 + integer :: inds, indf, indsp, indfp, j, k + +! +!===> ... begin here +! + +! --- ... compute the optical depth by interpolating in ln(pressure), +! temperature, and appropriate species. below laytrop, the water +! vapor self-continuum is interpolated (in temperature) separately. + + do k = 1, nlay + tauray = colmol(k) * rayl + + do j = 1, NG29 + taur(k,NS29+j) = tauray + enddo + enddo + + do k = 1, laytrop + ind01 = id0(k,29) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,29) + 1 + ind12 = ind11 + 1 + + inds = indself(k) + indf = indfor (k) + indsp= inds + 1 + indfp= indf + 1 + + do j = 1, NG29 + taug(k,NS29+j) = colamt(k,1) & + & * ( (fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & + & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) & + & + selffac(k) * (selfref(inds,j) + selffrac(k) & + & * (selfref(indsp,j) - selfref(inds,j))) & + & + forfac(k) * (forref(indf,j) + forfrac(k) & + & * (forref(indfp,j) - forref(indf,j)))) & + & + colamt(k,2) * absco2(j) + enddo + enddo + + do k = laytrop+1, nlay + ind01 = id0(k,29) + 1 + ind02 = ind01 + 1 + ind11 = id1(k,29) + 1 + ind12 = ind11 + 1 + + do j = 1, NG29 + taug(k,NS29+j) = colamt(k,2) & + & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & + & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) & + & + colamt(k,1) * absh2o(j) + enddo + enddo + + return +!................................... + end subroutine taumol29 +!----------------------------------- + +!................................... + end subroutine taumol +!----------------------------------- + +!mz* HWRF subroutines + subroutine mcica_subcol_sw(iplon, ncol, nlay, icld, permuteseed, & + & irng, play, hgt, & + & cldfrac, ciwp, clwp, cswp, rei, rel, res, tauc, & + & ssac, asmc, fsfc, & + & cldfmcl, ciwpmcl, clwpmcl, cswpmcl, reicmcl, & + & relqmcl, resnmcl, & + & taucmcl, ssacmcl, asmcmcl, fsfcmcl) + +! ----- Input ----- +! Control + integer(kind=im), intent(in) :: iplon ! column/longitude dimension + integer(kind=im), intent(in) :: ncol ! number of columns + integer(kind=im), intent(in) :: nlay ! number of model layers + integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag + integer(kind=im), intent(in) :: permuteseed ! if the cloud generator is called multiple times, + ! permute the seed between each call; + ! between calls for LW and SW, recommended + ! permuteseed differs by 'ngpt' + integer(kind=im), intent(inout) :: irng ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne Twister + +! Atmosphere + real(kind=rb), intent(in) :: play(:,:) ! layer pressures (mb) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) + +! Atmosphere/clouds - cldprop + real(kind=rb), intent(in) :: cldfrac(:,:) ! layer cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: fsfc(:,:,:) ! in-cloud forward scattering fraction (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow water path + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: rei(:,:) ! cloud ice particle size + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: rel(:,:) ! cloud liquid particle size + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: res(:,:) ! cloud snow particle size + ! Dimensions: (ncol,nlay) + +! ----- Output ----- +! Atmosphere/clouds - cldprmc [mcica] + real(kind=rb), intent(out) :: cldfmcl(:,:,:) ! cloud fraction [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: ciwpmcl(:,:,:) ! in-cloud ice water path [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: clwpmcl(:,:,:) ! in-cloud liquid water path [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: cswpmcl(:,:,:) ! in-cloud snow water path [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: relqmcl(:,:) ! liquid particle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: reicmcl(:,:) ! ice partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: resnmcl(:,:) ! snow partcle size (microns) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: taucmcl(:,:,:) ! in-cloud optical depth [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: ssacmcl(:,:,:) ! in-cloud single scattering albedo [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: asmcmcl(:,:,:) ! in-cloud asymmetry parameter [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: fsfcmcl(:,:,:) ! in-cloud forward scattering fraction [mcica] + ! Dimensions: (ngptsw,ncol,nlay) + +! ----- Local ----- + +! Stochastic cloud generator variables [mcica] + integer(kind=im), parameter :: nsubcsw = ngptsw ! number of sub-columns (g-point intervals) + integer(kind=im) :: ilev ! loop index + + real(kind=rb) :: pmid(ncol,nlay) ! layer pressures (Pa) +! real(kind=rb) :: pdel(ncol,nlay) ! layer pressure thickness (Pa) +! real(kind=rb) :: qi(ncol,nlay) ! ice water (specific humidity) +! real(kind=rb) :: ql(ncol,nlay) ! liq water (specific humidity) + +! Return if clear sky + if (icld.eq.0) return + +! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at least number of subcolumns + +! Pass particle sizes to new arrays, no subcolumns for these properties yet +! Convert pressures from mb to Pa + + reicmcl(:ncol,:nlay) = rei(:ncol,:nlay) + relqmcl(:ncol,:nlay) = rel(:ncol,:nlay) + resnmcl(:ncol,:nlay) = res(:ncol,:nlay) + pmid(:ncol,:nlay) = play(:ncol,:nlay)*1.e2_rb + +! Convert input ice and liquid cloud water paths to specific humidity ice and liquid components + +! cwp = (q * pdel * 1000.) / gravit) +! = (kg/kg * kg m-1 s-2 *1000.) / m s-2 +! = (g m-2) +! +! q = (cwp * gravit) / (pdel *1000.) +! = (g m-2 * m s-2) / (kg m-1 s-2 * 1000.) +! = kg/kg + +! do ilev = 1, nlay +! qi(ilev) = (ciwp(ilev) * grav) / (pdel(ilev) * 1000._rb) +! ql(ilev) = (clwp(ilev) * grav) / (pdel(ilev) * 1000._rb) +! enddo + + call generate_stochastic_clouds_sw (ncol, nlay, nsubcsw, icld, & + & irng, pmid, hgt, cldfrac, clwp, ciwp, cswp, & + & tauc, ssac, asmc, fsfc, cldfmcl, clwpmcl, & + & ciwpmcl, cswpmcl, & + & taucmcl, ssacmcl, asmcmcl, fsfcmcl, permuteseed) + + end subroutine mcica_subcol_sw + +!------------------------------------------------------------------------------------------------- + subroutine generate_stochastic_clouds_sw(ncol, nlay, nsubcol, & + & icld, irng, pmid, hgt, cld, clwp, ciwp, cswp, & + & tauc, ssac, asmc, fsfc, cld_stoch, clwp_stoch, & + & ciwp_stoch, cswp_stoch, & + & tauc_stoch, ssac_stoch, asmc_stoch, fsfc_stoch, changeSeed) +!------------------------------------------------------------------------------------------------- +! Contact: Cecile Hannay (hannay@ucar.edu) +! +! Original code: Based on Raisanen et al., QJRMS, 2004. +! +! Modifications: Generalized for use with RRTMG and added Mersenne Twister as the default +! random number generator, which can be changed to the optional kissvec random number generator +! with flag 'irng'. Some extra functionality has been commented or removed. +! Michael J. Iacono, AER, Inc., February 2007 +! +! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns. +! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one +! and uniform cloud liquid and cloud ice concentration. +! The ensemble as a whole reproduces the probability function of cloud liquid and ice within each layer +! and obeys an overlap assumption in the vertical. +! +! Overlap assumption: +! The cloud are consistent with 4 overlap assumptions: random, maximum, maximum-random and exponential. +! The default option is maximum-random (option 3) +! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap +! This is set with the variable "overlap" +!mji - Exponential overlap option (overlap=4) has been deactivated in this version +! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) +! +! Seed: +! If the stochastic cloud generator is called several times during the same timestep, +! one should change the seed between the call to insure that the subcolumns are different. +! This is done by changing the argument 'changeSeed' +! For example, if one wants to create a set of columns for the shortwave and another set for the longwave , +! use 'changeSeed = 1' for the first call and'changeSeed = 2' for the second call +! +! PDF assumption: +! We can use arbitrary complicated PDFS. +! In the present version, we produce homogeneuous clouds (the simplest case). +! Future developments include using the PDF scheme of Ben Johnson. +! +! History file: +! Option to add diagnostics variables in the history file. (using FINCL in the namelist) +! nsubcol = number of subcolumns +! overlap = overlap type (1-3) +! Zo = length scale +! CLOUD_S = mean of the subcolumn cloud fraction ('_S" means Stochastic) +! CLDLIQ_S = mean of the subcolumn cloud water +! CLDICE_S = mean of the subcolumn cloud ice +! +! +! Note: +! Here: we force that the cloud condensate to be consistent with the cloud fraction +! i.e we only have cloud condensate when the cell is cloudy. +! In CAM: The cloud condensate and the cloud fraction are obtained from 2 different equations +! and the 2 quantities can be inconsistent (i.e. CAM can produce cloud fraction +! without cloud condensate or the opposite). +!---------------------------------------------------------------------- + + use mcica_random_numbers +! The Mersenne Twister random number engine + use MersenneTwister, only: randomNumberSequence, & + new_RandomNumberSequence, getRandomReal + + type(randomNumberSequence) :: randomNumbers + +! -- Arguments + + integer(kind=im), intent(in) :: ncol ! number of layers + integer(kind=im), intent(in) :: nlay ! number of layers + integer(kind=im), intent(in) :: icld ! clear/cloud, cloud overlap flag + integer(kind=im), intent(inout) :: irng ! flag for random number generator + ! 0 = kissvec + ! 1 = Mersenne Twister + integer(kind=im), intent(in) :: nsubcol ! number of sub-columns (g-point intervals) + integer(kind=im), optional, intent(in) :: changeSeed ! allows permuting seed + +! Column state (cloud fraction, cloud water, cloud ice) + variables needed to read physics state + real(kind=rb), intent(in) :: pmid(:,:) ! layer pressure (Pa) + ! Dimensions: (ncol,nlay) +! mji - Add height + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cld(:,:) ! cloud fraction + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path (g/m2) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: ciwp(:,:) ! in-cloud ice water path (g/m2) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: cswp(:,:) ! in-cloud snow water path (g/m2) + ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: tauc(:,:,:) ! in-cloud optical depth (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: ssac(:,:,:) ! in-cloud single scattering albedo (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: fsfc(:,:,:) ! in-cloud forward scattering fraction (non-delta scaled) + ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: clwp_stoch(:,:,:) ! subcolumn in-cloud liquid water path + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: ciwp_stoch(:,:,:) ! subcolumn in-cloud ice water path + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: cswp_stoch(:,:,:) ! subcolumn in-cloud snow water path + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: tauc_stoch(:,:,:) ! subcolumn in-cloud optical depth + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: ssac_stoch(:,:,:) ! subcolumn in-cloud single scattering albedo + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: asmc_stoch(:,:,:) ! subcolumn in-cloud asymmetry parameter + ! Dimensions: (ngptsw,ncol,nlay) + real(kind=rb), intent(out) :: fsfc_stoch(:,:,:) ! subcolumn in-cloud forward scattering fraction + ! Dimensions: (ngptsw,ncol,nlay) + +! -- Local variables + real(kind=rb) :: cldf(ncol,nlay) ! cloud fraction + ! Dimensions: (ncol,nlay) + +! Mean over the subcolumns (cloud fraction, cloud water , cloud ice) - inactive +! real(kind=rb) :: mean_cld_stoch(ncol,nlay) ! cloud fraction +! real(kind=rb) :: mean_clwp_stoch(ncol,nlay) ! cloud water +! real(kind=rb) :: mean_ciwp_stoch(ncol,nlay) ! cloud ice +! real(kind=rb) :: mean_tauc_stoch(ncol,nlay) ! cloud optical depth +! real(kind=rb) :: mean_ssac_stoch(ncol,nlay) ! cloud single scattering albedo +! real(kind=rb) :: mean_asmc_stoch(ncol,nlay) ! cloud asymmetry parameter +! real(kind=rb) :: mean_fsfc_stoch(ncol,nlay) ! cloud forward scattering fraction + +! Set overlap + integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum-random, + ! 3 = maximum overlap, 4 = exponential, + ! 5 = exponential-random + real(kind=rb), parameter :: Zo = 2500._rb ! length scale (m) + real(kind=rb), dimension(ncol,nlay) :: alpha ! overlap parameter + +! Constants (min value for cloud fraction and cloud water and ice) + real(kind=rb), parameter :: cldmin = 1.0e-20_rb ! min cloud fraction +! real(kind=rb), parameter :: qmin = 1.0e-10_rb ! min cloud water and cloud ice (not used) + +! Variables related to random number and seed + real(kind=rb), dimension(nsubcol, ncol, nlay) :: CDF, CDF2 ! random numbers + integer(kind=im), dimension(ncol) :: seed1, seed2, seed3, seed4 ! seed to create random number + real(kind=rb), dimension(ncol) :: rand_num ! random number (kissvec) + integer(kind=im) :: iseed ! seed to create random number (Mersenne Twister) + real(kind=rb) :: rand_num_mt ! random number (Mersenne Twister) + +! Flag to identify cloud fraction in subcolumns + logical, dimension(nsubcol, ncol, nlay) :: isCloudy ! flag that says whether a gridbox is cloudy + +! Indices + integer(kind=im) :: ilev, isubcol, i, n, ngbm ! indices + +!------------------------------------------------------------------------------------------ + +! Check that irng is in bounds; if not, set to default + if (irng .ne. 0) irng = 1 + +! Pass input cloud overlap setting to local variable + overlap = icld + +! Ensure that cloud fractions are in bounds + do ilev = 1, nlay + do i = 1, ncol + cldf(i,ilev) = cld(i,ilev) + if (cldf(i,ilev) < cldmin) then + cldf(i,ilev) = 0._rb + endif + enddo + enddo + +! ----- Create seed -------- + +! Advance randum number generator by changeseed values + if (irng.eq.0) then +! For kissvec, create a seed that depends on the state of the columns. Maybe not the best way, but it works. + +! Must use pmid from bottom four layers. + do i=1,ncol + if (pmid(i,1).lt.pmid(i,2)) then + stop 'MCICA_SUBCOL: KISSVEC SEED GENERATOR REQUIRES PMID FROM BOTTOM FOUR LAYERS.' + endif + seed1(i) = (pmid(i,1) - int(pmid(i,1))) * 1000000000_im + seed2(i) = (pmid(i,2) - int(pmid(i,2))) * 1000000000_im + seed3(i) = (pmid(i,3) - int(pmid(i,3))) * 1000000000_im + seed4(i) = (pmid(i,4) - int(pmid(i,4))) * 1000000000_im + enddo + do i=1,changeSeed + call kissvec(seed1, seed2, seed3, seed4, rand_num) + enddo + elseif (irng.eq.1) then + randomNumbers = new_RandomNumberSequence(seed = changeSeed) + endif + + +! ------ Apply overlap assumption -------- + +! generate the random numbers + + select case (overlap) + + + case(1) +! Random overlap +! i) pick a random value at every level + + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + case(2) +! Maximum-Random overlap +! i) pick a random number for top layer. +! ii) walk down the column: +! - if the layer above is cloudy, we use the same random number than in the layer above +! - if the layer above is clear, we use a new random number + + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + do ilev = 2,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if (CDF(isubcol, i, ilev-1) > 1._rb - cldf(i,ilev-1) ) then + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev-1) + else + CDF(isubcol,i,ilev) = CDF(isubcol,i,ilev) * (1._rb - cldf(i,ilev-1)) + endif + enddo + enddo + enddo + + + case(3) +! Maximum overlap +! i) pick same random numebr at every level + + if (irng.eq.0) then + do isubcol = 1,nsubcol + call kissvec(seed1, seed2, seed3, seed4, rand_num) + do ilev = 1,nlay + CDF(isubcol,:,ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + rand_num_mt = getRandomReal(randomNumbers) + do ilev = 1, nlay + CDF(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + +! mji - Activate exponential cloud overlap option + case(4) + ! Exponential overlap: weighting between maximum and random overlap increases with the distance. + ! The random numbers for exponential overlap verify: + ! j=1 RAN(j)=RND1 + ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) + ! RAN(j) = RND2 + ! alpha is obtained from the equation + ! alpha = exp(-(Z(j)-Z(j-1))/Zo) where Zo is a characteristic length scale + + ! compute alpha + do i = 1, ncol + alpha(i, 1) = 0._rb + do ilev = 2,nlay + alpha(i, ilev) = exp( -( hgt (i, ilev) - hgt (i, ilev-1)) / Zo) + enddo + enddo + + ! generate 2 streams of random numbers + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol, :, ilev) = rand_num + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF2(isubcol, :, ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + rand_num_mt = getRandomReal(randomNumbers) + CDF2(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + ! generate random numbers + do ilev = 2,nlay + where (CDF2(:, :, ilev) < spread(alpha (:,ilev), dim=1, nCopies=nsubcol) ) + CDF(:,:,ilev) = CDF(:,:,ilev-1) + end where + end do + +! mji - Activate exponential-random cloud overlap option + case(5) + ! Exponential-random overlap: +! call wrf_error_fatal("Cloud Overlap case 5: ER has not yet been implemented. Stopping...") + + end select + + +! -- generate subcolumns for homogeneous clouds ----- + do ilev = 1, nlay + isCloudy(:,:,ilev) = (CDF(:,:,ilev) >= 1._rb - spread(cldf(:,ilev), dim=1, nCopies=nsubcol) ) + enddo + +! where the subcolumn is cloudy, the subcolumn cloud fraction is 1; +! where the subcolumn is not cloudy, the subcolumn cloud fraction is 0; +! where there is a cloud, define the subcolumn cloud properties, +! otherwise set these to zero + + ngbm = ngb(1) - 1 + do ilev = 1,nlay + do i = 1, ncol + do isubcol = 1, nsubcol + if ( iscloudy(isubcol,i,ilev) ) then + cld_stoch(isubcol,i,ilev) = 1._rb + clwp_stoch(isubcol,i,ilev) = clwp(i,ilev) + ciwp_stoch(isubcol,i,ilev) = ciwp(i,ilev) + cswp_stoch(isubcol,i,ilev) = cswp(i,ilev) + n = ngb(isubcol) - ngbm + tauc_stoch(isubcol,i,ilev) = tauc(n,i,ilev) + ssac_stoch(isubcol,i,ilev) = ssac(n,i,ilev) + asmc_stoch(isubcol,i,ilev) = asmc(n,i,ilev) + fsfc_stoch(isubcol,i,ilev) = fsfc(n,i,ilev) + else + cld_stoch(isubcol,i,ilev) = 0._rb + clwp_stoch(isubcol,i,ilev) = 0._rb + ciwp_stoch(isubcol,i,ilev) = 0._rb + cswp_stoch(isubcol,i,ilev) = 0._rb + tauc_stoch(isubcol,i,ilev) = 0._rb + ssac_stoch(isubcol,i,ilev) = 1._rb + asmc_stoch(isubcol,i,ilev) = 0._rb + fsfc_stoch(isubcol,i,ilev) = 0._rb + endif + enddo + enddo + enddo + + +! -- compute the means of the subcolumns --- +! mean_cld_stoch(:,:) = 0._rb +! mean_clwp_stoch(:,:) = 0._rb +! mean_ciwp_stoch(:,:) = 0._rb +! mean_tauc_stoch(:,:) = 0._rb +! mean_ssac_stoch(:,:) = 0._rb +! mean_asmc_stoch(:,:) = 0._rb +! mean_fsfc_stoch(:,:) = 0._rb +! do i = 1, nsubcol +! mean_cld_stoch(:,:) = cld_stoch(i,:,:) + mean_cld_stoch(:,:) +! mean_clwp_stoch(:,:) = clwp_stoch( i,:,:) + mean_clwp_stoch(:,:) +! mean_ciwp_stoch(:,:) = ciwp_stoch( i,:,:) + mean_ciwp_stoch(:,:) +! mean_tauc_stoch(:,:) = tauc_stoch( i,:,:) + mean_tauc_stoch(:,:) +! mean_ssac_stoch(:,:) = ssac_stoch( i,:,:) + mean_ssac_stoch(:,:) +! mean_asmc_stoch(:,:) = asmc_stoch( i,:,:) + mean_asmc_stoch(:,:) +! mean_fsfc_stoch(:,:) = fsfc_stoch( i,:,:) + mean_fsfc_stoch(:,:) +! end do +! mean_cld_stoch(:,:) = mean_cld_stoch(:,:) / nsubcol +! mean_clwp_stoch(:,:) = mean_clwp_stoch(:,:) / nsubcol +! mean_ciwp_stoch(:,:) = mean_ciwp_stoch(:,:) / nsubcol +! mean_tauc_stoch(:,:) = mean_tauc_stoch(:,:) / nsubcol +! mean_ssac_stoch(:,:) = mean_ssac_stoch(:,:) / nsubcol +! mean_asmc_stoch(:,:) = mean_asmc_stoch(:,:) / nsubcol +! mean_fsfc_stoch(:,:) = mean_fsfc_stoch(:,:) / nsubcol + + end subroutine generate_stochastic_clouds_sw + + +!-------------------------------------------------------------------------------------------------- + subroutine kissvec(seed1,seed2,seed3,seed4,ran_arr) +!-------------------------------------------------------------------------------------------------- + +! public domain code made available from http://www.fortran.com/ +! downloaded by pjr on 03/16/04 for NCAR CAM +! converted to vector form, functions inlined by pjr,mvr on 05/10/2004 + +! The KISS (Keep It Simple Stupid) random number generator. Combines: +! (1) The congruential generator x(n)=69069*x(n-1)+1327217885, period 2^32. +! (2) A 3-shift shift-register generator, period 2^32-1, +! (3) Two 16-bit multiply-with-carry generators, period 597273182964842497>2^59 +! Overall period>2^123; + +! + real(kind=rb), dimension(:), intent(inout) :: ran_arr + integer(kind=im), dimension(:), intent(inout) :: seed1,seed2,seed3,seed4 + integer(kind=im) :: i,sz,kiss + integer(kind=im) :: m, k, n + +! inline function + m(k, n) = ieor (k, ishft (k, n) ) + + sz = size(ran_arr) + do i = 1, sz + seed1(i) = 69069_im * seed1(i) + 1327217885_im + seed2(i) = m (m (m (seed2(i), 13_im), - 17_im), 5_im) + seed3(i) = 18000_im * iand (seed3(i), 65535_im) + ishft (seed3(i), - 16_im) + seed4(i) = 30903_im * iand (seed4(i), 65535_im) + ishft (seed4(i), - 16_im) + kiss = seed1(i) + seed2(i) + ishft (seed3(i), 16_im) + seed4(i) + ran_arr(i) = kiss*2.328306e-10_rb + 0.5_rb + end do + + end subroutine kissvec + +!! @} + +! +!........................................! + end module rrtmg_sw ! +!========================================! From 28d1bc22802b30220a3f5f0782b50b9d2d66d9f4 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 7 Apr 2020 10:29:48 -0600 Subject: [PATCH 020/274] Clean up HWRF RRTMG additions --- physics/GFS_rrtmg_pre.F90 | 265 +- physics/GFS_rrtmg_pre.meta | 17 - physics/GFS_rrtmg_setup.F90 | 32 +- physics/GFS_rrtmg_setup.meta | 4 +- physics/module_MP_FER_HIRES.F90 | 4 +- physics/physparam.f | 2 + physics/radiation_clouds.f | 151 +- physics/radlw_main.F90 | 191 +- physics/radlw_main.meta | 32 - physics/radsw_main.F90 | 175 +- physics/radsw_main.f | 5472 ------------------------------- physics/radsw_main.meta | 40 - 12 files changed, 265 insertions(+), 6120 deletions(-) delete mode 100644 physics/radsw_main.f diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 952673f95..8acb24a50 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -20,7 +20,7 @@ end subroutine GFS_rrtmg_pre_init ! in the CCPP version - they are defined in the interstitial_create routine subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & - Radtend,dx, & ! input/output + Radtend, dx, & ! input/output f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output @@ -32,47 +32,50 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input faerlw1, faerlw2, faerlw3, aerodp, & clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & clouds7, clouds8, clouds9, cldsa, & - mtopa, mbota, de_lgth, alb1d, errmsg, errflg, & - mpirank, mpiroot) + mtopa, mbota, de_lgth, alb1d, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, & - GFS_stateout_type, & - GFS_sfcprop_type, & - GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_tbd_type, & - GFS_cldprop_type, & - GFS_radtend_type, & + use GFS_typedefs, only: GFS_statein_type, & + GFS_stateout_type, & + GFS_sfcprop_type, & + GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_tbd_type, & + GFS_cldprop_type, & + GFS_radtend_type, & GFS_diag_type use physparam - use physcons, only: eps => con_eps, & - & epsm1 => con_epsm1, & - & fvirt => con_fvirt & - &, rog => con_rog & - &, rocp => con_rocp - use radcons, only: itsfc,ltp, lextop, qmin, & + use physcons, only: eps => con_eps, & + epsm1 => con_epsm1, & + fvirt => con_fvirt, & + rog => con_rog, & + rocp => con_rocp, & + con_rd + use radcons, only: itsfc,ltp, lextop, qmin, & qme5, qme6, epsq, prsmin use funcphys, only: fpvs - use module_radiation_astronomy,only: coszmn ! sol_init, sol_update - use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, - use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, - & NSPC1 - use module_radiation_clouds, only: NF_CLDS, & ! cld_init - & progcld1, progcld3, & -! & progcld2, & - & progcld4, progcld5, & - & progcld6, & !F-A - & progclduni, & - & cal_cldfra3, find_cloudLayers,adjust_cloudIce,adjust_cloudH2O, & - & adjust_cloudFinal - - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & - & profsw_type, NBDSW - use module_radlw_parameters, only: topflw_type, sfcflw_type, & - & proflw_type, NBDLW + use module_radiation_astronomy,only: coszmn ! sol_init, sol_update + use module_radiation_gases, only: NF_VGAS, getgases, getozn ! gas_init, gas_update, + use module_radiation_aerosols, only: NF_AESW, NF_AELW, setaer, & ! aer_init, aer_update, + NSPC1 + use module_radiation_clouds, only: NF_CLDS, & ! cld_init + progcld1, progcld3, & + progcld2, & + progcld4, progcld5, & + progcld6, & ! F-A + progclduni, & + cal_cldfra3, & + find_cloudLayers, & + adjust_cloudIce, & + adjust_cloudH2O, & + adjust_cloudFinal + + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & + profsw_type, NBDSW + use module_radlw_parameters, only: topflw_type, sfcflw_type, & + proflw_type, NBDLW use surface_perturbation, only: cdfnor implicit none @@ -86,19 +89,18 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input type(GFS_cldprop_type), intent(in) :: Cldprop type(GFS_coupling_type), intent(in) :: Coupling - integer, intent(in) :: im, lm, lmk, lmp - integer, intent(out) :: kd, kt, kb + integer, intent(in) :: im, lm, lmk, lmp + integer, intent(out) :: kd, kt, kb ! F-A mp scheme only - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_ice + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rain + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(in) :: f_rimef + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: cwm + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin real(kind=kind_phys), intent(out) :: raddt - - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: dx - INTEGER, INTENT(IN) :: mpirank,mpiroot + + real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: dx real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: delp real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP), intent(out) :: dz real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+1+LTP), intent(out) :: plvl @@ -160,11 +162,12 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & cldcov, deltaq, cnvc, cnvw, & - effrl, effri, effrr, effrs,rho,plyrpa + effrl, effri, effrr, effrs, rho, plyrpa real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP+1) :: tem2db - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qc_save, qi_save - real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qs_save + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qc_save + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qi_save + real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP) :: qs_save real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,min(4,Model%ncnd)) :: ccnd real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,2:Model%ntrac) :: tracer1 @@ -172,11 +175,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NF_VGAS) :: gasvmr real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDSW,NF_AESW)::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),Model%levr+LTP,NBDLW,NF_AELW)::faerlw -!mz *temporary - real(kind=kind_phys),parameter:: con_rd =2.8705e+2_kind_phys - INTEGER :: ids, ide, jds, jde, kds, kde, & - & ims, ime, jms, jme, kms, kme, & - & its, ite, jts, jte, kts, kte + + integer :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ! !===> ... begin here @@ -188,8 +190,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input if (.not. (Model%lsswr .or. Model%lslwr)) return !--- set commonly used integers - me = Model%me - NFXR = Model%nfxr + me = Model%me + NFXR = Model%nfxr NTRAC = Model%ntrac ! tracers in grrad strip off sphum - start tracer1(2:NTRAC) ntcw = Model%ntcw ntiw = Model%ntiw @@ -542,7 +544,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water/ice enddo enddo - elseif (Model%ncnd == 2) then ! MG or + elseif (Model%ncnd == 2) then ! MG do k=1,LMK do i=1,IM ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water @@ -651,7 +653,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input cldcov = 0.0 endif - ! ! --- add suspended convective cloud water to grid-scale cloud water ! only for cloud fraction & radiation computation @@ -687,79 +688,71 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo endif -!mz HWRF physics: icloud=3 - ! Set internal dimensions - ids = 1 - ims = 1 - its = 1 - ide = size(Grid%xlon,1) - ime = size(Grid%xlon,1) - ite = size(Grid%xlon,1) - jds = 1 - jms = 1 - jts = 1 - jde = 1 - jme = 1 - jte = 1 - kds = 1 - kms = 1 - kts = 1 - kde = Model%levr+LTP - kme = Model%levr+LTP - kte = Model%levr+LTP - - do k = 1, LMK - do i = 1, IM - rho(i,k)=plyr(i,k)*100./(con_rd*tlyr(i,k)) - plyrpa(i,k)=plyr(i,k)*100. !hPa->Pa - end do - end do - - do i=1,im - if (Sfcprop%slmsk(i)==1. .or. Sfcprop%slmsk(i)==2.) then !sea/land/ice mask (=0/1/2) in FV3 - xland(i)=1.0 !but land/water = (1/2) in HWRF - else - xland(i)=2.0 - endif - enddo - - - gridkm = 1.414*SQRT(dx(1)*0.001*dx(1)*0.001 ) + !mz HWRF physics: icloud=3 + if(Model%icloud == 3) then + + ! Set internal dimensions + ids = 1 + ims = 1 + its = 1 + ide = size(Grid%xlon,1) + ime = size(Grid%xlon,1) + ite = size(Grid%xlon,1) + jds = 1 + jms = 1 + jts = 1 + jde = 1 + jme = 1 + jte = 1 + kds = 1 + kms = 1 + kts = 1 + kde = Model%levr+LTP + kme = Model%levr+LTP + kte = Model%levr+LTP + do k = 1, LMK + do i = 1, IM + rho(i,k)=plyr(i,k)*100./(con_rd*tlyr(i,k)) + plyrpa(i,k)=plyr(i,k)*100. !hPa->Pa + end do + end do - if(Model%icloud == 3) then - do i =1, im - do k =1, lmk - qc_save(i,k) = ccnd(i,k,1) - qi_save(i,k) = ccnd(i,k,2) - qs_save(i,k) = ccnd(i,k,4) - enddo - enddo + do i=1,im + if (Sfcprop%slmsk(i)==1. .or. Sfcprop%slmsk(i)==2.) then ! sea/land/ice mask (=0/1/2) in FV3 + xland(i)=1.0 ! but land/water = (1/2) in HWRF + else + xland(i)=2.0 + endif + enddo + gridkm = sqrt(2.0)*sqrt(dx(1)*0.001*dx(1)*0.001) - CALL cal_cldfra3(cldcov,qlyr,ccnd(:,:,1),ccnd(:,:,2), & - & ccnd(:,:,4),plyrpa,tlyr, RHO,XLAND,GRIDKM, & - & ids,ide, jds,jde, kds,kde, & - & ims,ime, jms,jme, kms,kme, & - & its,ite, jts,jte, kts,kte) -! if(mpirank == mpiroot) then -! write(0,*)'cal_cldfra3::max/min(cldcov) =', maxval(cldcov), & -! & minval(cldcov) -! endif + do i =1, im + do k =1, lmk + qc_save(i,k) = ccnd(i,k,1) + qi_save(i,k) = ccnd(i,k,2) + qs_save(i,k) = ccnd(i,k,4) + enddo + enddo - !mz* back to micro-only qc qi,qs - do i =1, im - do k =1, lmk - ccnd(i,k,1) = qc_save(i,k) - ccnd(i,k,2) = qi_save(i,k) - ccnd(i,k,4) = qs_save(i,k) - enddo - enddo - endif + call cal_cldfra3(cldcov,qlyr,ccnd(:,:,1),ccnd(:,:,2), & + ccnd(:,:,4),plyrpa,tlyr,rho,xland,gridkm, & + ids,ide,jds,jde,kds,kde, & + ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte) + !mz* back to micro-only qc qi,qs + do i =1, im + do k =1, lmk + ccnd(i,k,1) = qc_save(i,k) + ccnd(i,k,2) = qi_save(i,k) + ccnd(i,k,4) = qs_save(i,k) + enddo + enddo -!mz*end + endif ! icloud == 3 if (lextop) then do i=1,im @@ -787,12 +780,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! or unified cloud and/or with MG microphysics if (Model%uni_cld .and. Model%ncld >= 2) then - call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & - IM, LMK, LMP, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & - Model%iovr_lw, Model%iovr_sw, & ! mz* for iovr=3 should come from - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs + Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & + IM, LMK, LMP, cldcov, & + effrl, effri, effrr, effrs, Model%effr_in, & + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ccnd(1:IM,1:LMK,1), Grid%xlat,Grid%xlon, & @@ -800,7 +792,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Model%uni_cld, Model%lmfshal, & Model%lmfdeep2, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & - Model%iovr_lw, Model%iovr_sw, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif @@ -811,7 +802,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input cnvw, cnvc, Grid%xlat, Grid%xlon, & Sfcprop%slmsk, dz, delp, im, lmk, lmp, deltaq, & Model%sup, Model%kdt, me, & - Model%iovr_lw, Model%iovr_sw, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs @@ -822,16 +812,14 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(1:IM,1:LMK,1), cnvw, cnvc, & Grid%xlat, Grid%xlon, Sfcprop%slmsk, & cldcov, dz, delp, im, lmk, lmp, & - Model%iovr_lw, Model%iovr_sw, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & IM, LMK, LMP, cldcov, & effrl, effri, effrr, effrs, Model%effr_in, & - Model%iovr_lw, Model%iovr_sw, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs ! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs ! tracer1, Grid%xlat, Grid%xlon, Sfcprop%slmsk, & ! dz, delp, & @@ -841,14 +829,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6 ) then + elseif(Model%imp_physics == 8) then if (Model%kdt == 1) then Tbd%phy_f3d(:,:,Model%nleffr) = 10. Tbd%phy_f3d(:,:,Model%nieffr) = 50. Tbd%phy_f3d(:,:,Model%nseffr) = 250. endif - !mz* this is original progcld5 - temporary + ! mz* this is the original progcld5 - temporary + ! will be replaced with GSL's version of progcld6 for Thompson MP call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & @@ -857,8 +846,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Model%lmfshal,Model%lmfdeep2, & cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & - Model%iovr_lw, Model%iovr_sw, & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs elseif(Model%imp_physics == 15) then @@ -876,7 +864,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Model%lmfshal,Model%lmfdeep2, & cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & - Model%iovr_lw, Model%iovr_sw, & clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs endif ! end if_imp_physics diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 716090962..2c00f697b 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -573,23 +573,6 @@ type = integer intent = out optional = F -[mpirank] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[mpiroot] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F - ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 043ea8560..7a52f573c 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -5,9 +5,9 @@ module GFS_rrtmg_setup use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg,& ! & iaermdl, laswflg, lalwflg, lavoflg, icldflg, & & iaermdl, icldflg, & - & lcrick , lcnorm , lnoprec, & - & ialbflg, iemsflg, ivflip , ipsd0, & -! & iswcliq, & + & iovrsw , iovrlw , lcrick , lcnorm , lnoprec, & + & ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & + & iswcliq, & & kind_phys use radcons, only: ltp, lextop @@ -178,8 +178,8 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: num_p3d integer, intent(in) :: npdf3d integer, intent(in) :: ntoz - integer, intent(inout) :: iovr_sw - integer, intent(inout) :: iovr_lw + integer, intent(in) :: iovr_sw + integer, intent(in) :: iovr_lw integer, intent(in) :: isubc_sw integer, intent(in) :: isubc_lw integer, intent(in) :: icliq_sw @@ -205,8 +205,6 @@ subroutine GFS_rrtmg_setup_init ( & real(kind_phys), dimension(im,NSPC1) :: aerodp_check ! End for consistency checks - integer :: iswcliq - ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -271,14 +269,14 @@ subroutine GFS_rrtmg_setup_init ( & iswcliq = icliq_sw ! optical property for liquid clouds for sw - ! iovrsw = iovr_sw ! cloud overlapping control flag for sw - ! iovrlw = iovr_lw ! cloud overlapping control flag for lw + iovrsw = iovr_sw ! cloud overlapping control flag for sw + iovrlw = iovr_lw ! cloud overlapping control flag for lw lcrick = crick_proof ! control flag for eliminating CRICK lcnorm = ccnorm ! control flag for in-cld condensate lnoprec = norad_precip ! precip effect on radiation flag (ferrier microphysics) -! isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation -! isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation + isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation + isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation ialbflg= ialb ! surface albedo control flag iemsflg= iems ! surface emissivity control flag @@ -306,7 +304,7 @@ subroutine GFS_rrtmg_setup_init ( & call radinit & ! --- inputs: - & ( si, levr, imp_physics,iswcliq, iovr_lw, iovr_sw, isubc_lw, isubc_sw, me ) + & ( si, levr, imp_physics, me ) ! --- outputs: ! ( none ) @@ -387,7 +385,7 @@ end subroutine GFS_rrtmg_setup_finalize ! Private functions - subroutine radinit( si, NLAY, imp_physics,iswcliq, iovrlw,iovrsw,isubclw,isubcsw, me ) + subroutine radinit( si, NLAY, imp_physics, me ) !................................... ! --- inputs: @@ -512,10 +510,8 @@ subroutine radinit( si, NLAY, imp_physics,iswcliq, iovrlw,iovrsw,isubclw,isubcsw implicit none ! --- inputs: - integer, intent(in) :: NLAY, me, imp_physics, & - & isubclw,isubcsw,iswcliq + integer, intent(in) :: NLAY, me, imp_physics - integer, intent(inout) :: iovrlw,iovrsw real (kind=kind_phys), intent(in) :: si(:) ! --- outputs: (none, to module variables) @@ -624,9 +620,9 @@ subroutine radinit( si, NLAY, imp_physics,iswcliq, iovrlw,iovrsw,isubclw,isubcsw call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine - call rlwinit (iovrlw,isubclw, me ) ! --- ... lw radiation initialization routine + call rlwinit ( me ) ! --- ... lw radiation initialization routine - call rswinit (iswcliq, iovrsw,isubcsw, me ) ! --- ... sw radiation initialization routine + call rswinit ( me ) ! --- ... sw radiation initialization routine ! return !................................... diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 4f96b76f1..18ed4c49c 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -112,7 +112,7 @@ units = flag dimensions = () type = integer - intent = inout + intent = in optional = F [iovr_lw] standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation @@ -120,7 +120,7 @@ units = flag dimensions = () type = integer - intent = inout + intent = in optional = F [isubc_sw] standard_name = flag_for_sw_clouds_grid_approximation diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index 23a2de7d7..02a09481b 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -306,7 +306,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !----------------------------------------------------------------------- ! -! MZ: HWRF practice start +! MZ: HWRF start !---------- !2015-03-30, recalculate some constants which may depend on phy time step CALL MY_GROWTH_RATES_NMM_hr (DT) @@ -341,7 +341,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !write(*,*)'braut=',braut !! END OF adding, 2015-03-30 !----------- -! MZ: HWRF practice end +! MZ: HWRF end ! DO j = jms,jme diff --git a/physics/physparam.f b/physics/physparam.f index 795cb4fab..e722297de 100644 --- a/physics/physparam.f +++ b/physics/physparam.f @@ -234,6 +234,7 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4: exponential overlapping cloud !!\n Opr GFS/CFS=1; see IOVR_SW in run scripts integer, save :: iovrsw = 1 !> cloud overlapping control flag for LW @@ -241,6 +242,7 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method +!!\n =4: exponential overlapping cloud !!\n Opr GFS/CFS=1; see IOVR_LW in run scripts integer, save :: iovrlw = 1 diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index b76d57eaf..8a943a032 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -194,8 +194,7 @@ !> This module computes cloud related quantities for radiation computations. module module_radiation_clouds ! -!mz* iovrsw, iovrlw need to come from NML - use physparam, only : icldflg, &!mz:iovrsw, iovrlw,& + use physparam, only : icldflg, iovrsw, iovrlw, & & lcrick, lcnorm, lnoprec, & & ivflip use physcons, only : con_fvirt, con_ttp, con_rocp, & @@ -242,13 +241,13 @@ module module_radiation_clouds real (kind=kind_phys), parameter :: cldasy_def = 0.84 !< default cld asymmetry factor integer :: llyr = 2 !< upper limit of boundary layer clouds -!mz integer :: iovr = 1 !< maximum-random cloud overlapping method +! DH* TODO - HOW TO GET/SET THIS CORRECTLY? + integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld4o, & - & progcld6, & !mz- for GSL suite - & cal_cldfra3, find_cloudLayers,adjust_cloudIce,adjust_cloudH2O, & - & adjust_cloudFinal + & cld_init, progcld5, progcld6, progcld4o, cal_cldfra3, & + & find_cloudLayers, adjust_cloudIce, adjust_cloudH2O, & + & adjust_cloudFinal ! ================= @@ -307,6 +306,7 @@ subroutine cld_init & ! =1: max/ran overlapping clouds ! ! =2: maximum overlap clouds (mcica only) ! ! =3: decorrelation-length overlap (mcica only) ! +! =4: exponential overlapping cloud ! ! ivflip : control flag for direction of vertical index ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! @@ -333,7 +333,7 @@ subroutine cld_init & ! ! --- set up module variables -!mz iovr = max( iovrsw, iovrlw ) !cld ovlp used for diag HML cld output + iovr = max( iovrsw, iovrlw ) !cld ovlp used for diag HML cld output if (me == 0) print *, VTAGCLD !print out version tag @@ -443,7 +443,6 @@ subroutine progcld1 & & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & effrl,effri,effrr,effrs,effr_in, & - & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -527,7 +526,7 @@ subroutine progcld1 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1,iovr_lw,iovr_sw + integer, intent(in) :: IX, NLAY, NLP1 logical, intent(in) :: uni_cld, lmfshal, lmfdeep2, effr_in @@ -555,7 +554,7 @@ subroutine progcld1 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf,iovrw + integer :: i, k, id, nf ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -563,8 +562,6 @@ subroutine progcld1 & ! !===> ... begin here -!mz - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output ! do nf=1,nf_clds do k=1,nlay @@ -806,7 +803,7 @@ subroutine progcld1 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -820,7 +817,7 @@ subroutine progcld1 & call gethml & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & - & IX,NLAY, iovr_lw, iovr_sw, & + & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & & ) @@ -878,7 +875,6 @@ subroutine progcld2 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, & & IX, NLAY, NLP1, lmfshal, lmfdeep2, & - & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -967,7 +963,7 @@ subroutine progcld2 & ! --- constants ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1, iovr_lw,iovr_sw + integer, intent(in) :: IX, NLAY, NLP1 logical, intent(in) :: lmfshal, lmfdeep2 @@ -997,7 +993,7 @@ subroutine progcld2 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, iovrw + integer :: i, k, id ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -1007,10 +1003,6 @@ subroutine progcld2 & !===> ... begin here ! ! clouds(:,:,:) = 0.0 -!zm -!mz$ - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output$ - !> - Assign water/ice/rain/snow cloud properties for Ferrier scheme. do k = 1, NLAY @@ -1257,7 +1249,7 @@ subroutine progcld2 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -1274,7 +1266,6 @@ subroutine progcld2 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & - & iovr_lw,iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -1333,7 +1324,6 @@ subroutine progcld3 & & xlat,xlon,slmsk, dz, delp, & & ix, nlay, nlp1, & & deltaq,sup,kdt,me, & - & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -1416,7 +1406,7 @@ subroutine progcld3 & implicit none ! --- inputs - integer, intent(in) :: ix, nlay, nlp1,kdt,iovr_lw,iovr_sw + integer, intent(in) :: ix, nlay, nlp1,kdt real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, clw, dz, delp @@ -1448,14 +1438,11 @@ subroutine progcld3 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf, iovrw + integer :: i, k, id, nf ! !===> ... begin here ! -!mz - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output - do nf=1,nf_clds do k=1,nlay do i=1,ix @@ -1659,7 +1646,7 @@ subroutine progcld3 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -1677,7 +1664,6 @@ subroutine progcld3 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & ix,nlay, & - & iovr_lw,iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -1734,8 +1720,7 @@ end subroutine progcld3 subroutine progcld4 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: & xlat,xlon,slmsk,cldtot, dz, delp, & - & IX, NLAY, NLP1, & - & iovr_lw, iovr_sw, & + & IX, NLAY, NLP1, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -1816,7 +1801,7 @@ subroutine progcld4 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1,iovr_lw,iovr_sw + integer, intent(in) :: IX, NLAY, NLP1 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, clw, cldtot, cnvw, cnvc, & @@ -1842,14 +1827,11 @@ subroutine progcld4 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf,iovrw + integer :: i, k, id, nf ! !===> ... begin here ! -!mz - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output - do nf=1,nf_clds do k=1,nlay do i=1,ix @@ -2001,7 +1983,7 @@ subroutine progcld4 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -2017,7 +1999,6 @@ subroutine progcld4 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & - & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -2081,7 +2062,6 @@ subroutine progcld4o & & xlat,xlon,slmsk, dz, delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl,ntclamt, & & IX, NLAY, NLP1, & - & iovr_lw, iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -2161,7 +2141,7 @@ subroutine progcld4o & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1, iovr_lw, iovr_sw + integer, intent(in) :: IX, NLAY, NLP1 integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl, & & ntclamt @@ -2191,12 +2171,10 @@ subroutine progcld4o & & tem1, tem2, tem3 real (kind=kind_phys), dimension(IX,NLAY) :: cldtot - integer :: i, k, id, nf, iovrw + integer :: i, k, id, nf ! !===> ... begin here -!mz - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output ! do nf=1,nf_clds do k=1,nlay @@ -2333,7 +2311,7 @@ subroutine progcld4o & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -2349,7 +2327,6 @@ subroutine progcld4o & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & - & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -2373,7 +2350,6 @@ subroutine progcld5 & & IX, NLAY, NLP1,icloud, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & - & iovr_lw,iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -2457,16 +2433,15 @@ subroutine progcld5 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1,ICLOUD,iovr_lw,iovr_sw + integer, intent(in) :: IX, NLAY, NLP1, ICLOUD integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz -! & re_cloud, re_ice, re_snow -!mz: for diagnostics purpose +!mz: for diagnostics real (kind=kind_phys), dimension(:,:), intent(inout) :: & & re_cloud, re_ice, re_snow @@ -2492,7 +2467,7 @@ subroutine progcld5 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf, iovrw + integer :: i, k, id, nf ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -2500,8 +2475,6 @@ subroutine progcld5 & ! !===> ... begin here -!mz - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output ! do nf=1,nf_clds do k=1,nlay @@ -2672,19 +2645,9 @@ subroutine progcld5 & enddo endif !mz - if (icloud .ne.0) then + if (icloud .ne. 0) then ! assign/calculate efective radii for cloud water, ice, rain, snow -! if (effr_in) then -! do k = 1, NLAY -! do i = 1, IX -! rew(i,k) = effrl (i,k) -! rei(i,k) = max(10.0, min(150.0,effri (i,k))) -! rer(i,k) = effrr (i,k) -! res(i,k) = effrs (i,k) -! enddo -! enddo -! else do k = 1, NLAY do i = 1, IX rew(i,k) = reliq_def ! default liq radius to 10 micron @@ -2722,11 +2685,7 @@ subroutine progcld5 & else rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 endif -! if (icloud == 3 ) then rei(i,k) = max(25.,rei(i,k)) !mz* HWRF -! else !mz GFDL -! rei(i,k) = max(10.0, min(rei(i,k), 150.0)) -! endif endif rei(i,k) = min(rei(i,k), 135.72) !- 1.0315*rei<= 140 microns enddo @@ -2739,8 +2698,7 @@ subroutine progcld5 & res(i,k) = 10.0 enddo enddo -! endif -! + endif ! end icloud !mz end do k = 1, NLAY @@ -2756,8 +2714,8 @@ subroutine progcld5 & clouds(i,k,8) = 0. clouds(i,k,9) = 10. !mz for diagnostics? - re_cloud(i,k) =rew(i,k) - re_ice(i,k) =rei(i,k) + re_cloud(i,k) = rew(i,k) + re_ice(i,k) = rei(i,k) re_snow(i,k) = 10. enddo @@ -2766,7 +2724,7 @@ subroutine progcld5 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -2785,7 +2743,6 @@ subroutine progcld5 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & - & iovr_lw,iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -2806,7 +2763,6 @@ subroutine progcld6 & & IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & - & iovr_lw,iovr_sw, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -2891,7 +2847,7 @@ subroutine progcld6 & implicit none ! --- inputs - integer, intent(in) :: IX, NLAY, NLP1,iovr_lw,iovr_sw + integer, intent(in) :: IX, NLAY, NLP1 integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 @@ -2922,7 +2878,7 @@ subroutine progcld6 & real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id, nf, iovrw + integer :: i, k, id, nf ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -2930,8 +2886,6 @@ subroutine progcld6 & ! !===> ... begin here -!!mz$ - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output$ ! do nf=1,nf_clds @@ -3120,7 +3074,7 @@ subroutine progcld6 & ! --- ... estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -3139,7 +3093,6 @@ subroutine progcld6 & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & - & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -3197,7 +3150,6 @@ subroutine progclduni & & ( plyr,plvl,tlyr,tvly,ccnd,ncnd, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, IX, NLAY, NLP1, cldtot, & & effrl,effri,effrr,effrs,effr_in, & - & iovr_lw,iovr_sw, & !mz* $ & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) @@ -3292,9 +3244,6 @@ subroutine progclduni & real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk - !mz* for GFSv16 - integer, intent(in) :: iovr_lw, iovr_sw - ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds @@ -3305,7 +3254,6 @@ subroutine progclduni & integer, dimension(:,:), intent(out) :: mtop,mbot ! --- local variables: - integer :: iovrw real (kind=kind_phys), dimension(IX,NLAY) :: cldcnv, cwp, cip, & & crp, csp, rew, rei, res, rer real (kind=kind_phys), dimension(IX,NLAY,ncnd) :: cndf @@ -3327,9 +3275,6 @@ subroutine progclduni & ! enddo ! enddo ! -!mz* - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output - do k = 1, NLAY do i = 1, IX cldcnv(i,k) = 0.0 @@ -3499,7 +3444,7 @@ subroutine progclduni & !> -# Estimate clouds decorrelation length in km ! this is only a tentative test, need to consider change later - if ( iovrw == 3 ) then + if ( iovr == 3 ) then do i = 1, ix de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) enddo @@ -3518,7 +3463,6 @@ subroutine progclduni & ! --- inputs: & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & & IX,NLAY, & - & iovr_lw, iovr_sw, & ! --- outputs: & clds, mtop, mbot & & ) @@ -3554,7 +3498,7 @@ end subroutine progclduni !! @{ subroutine gethml & & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & ! --- inputs: - & IX, NLAY,iovr_lw,iovr_sw, & + & IX, NLAY, & & clds, mtop, mbot & ! --- outputs: & ) @@ -3610,7 +3554,7 @@ subroutine gethml & implicit none! ! --- inputs: - integer, intent(in) :: IX, NLAY,iovr_sw,iovr_lw + integer, intent(in) :: IX, NLAY real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & & cldtot, cldcnv, dz @@ -3626,14 +3570,11 @@ subroutine gethml & real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 - integer :: i, k, id, id1, kstr, kend, kinc,iovrw + integer :: i, k, id, id1, kstr, kend, kinc ! !===> ... begin here ! -!mz* - iovrw = max( iovr_sw, iovr_lw ) !cld ovlp used for diag HML cld output - clds(:,:) = 0.0 do i = 1, IX @@ -3657,7 +3598,7 @@ subroutine gethml & kinc = 1 endif ! end_if_ivflip - if ( iovrw == 0 ) then ! random overlap + if ( iovr == 0 ) then ! random overlap do k = kstr, kend, kinc do i = 1, IX @@ -3676,7 +3617,7 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) ! save total cloud enddo - elseif ( iovrw == 1 ) then ! max/ran overlap + elseif ( iovr == 1 ) then ! max/ran overlap do k = kstr, kend, kinc do i = 1, IX @@ -3700,7 +3641,7 @@ subroutine gethml & clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud enddo - elseif ( iovrw == 2 ) then ! maximum overlap all levels + elseif ( iovr == 2 ) then ! maximum overlap all levels cl1(:) = 0.0 @@ -3721,7 +3662,7 @@ subroutine gethml & clds(i,4) = cl1(i) ! save total cloud enddo - elseif ( iovrw == 3 ) then ! random if clear-layer divided, + elseif ( iovr == 3 ) then ! random if clear-layer divided, ! otherwise de-corrlength method do i = 1, ix dz1(i) = - dz(i,kstr) @@ -3807,7 +3748,7 @@ subroutine gethml & if (kth2(i) == 0) kbt2(i) = k kth2(i) = kth2(i) + 1 - if ( iovrw == 0 ) then + if ( iovr == 0 ) then cl2(i) = cl2(i) + ccur - cl2(i)*ccur else cl2(i) = max( cl2(i), ccur ) @@ -3889,7 +3830,7 @@ subroutine gethml & if (kth2(i) == 0) kbt2(i) = k kth2(i) = kth2(i) + 1 - if ( iovrw == 0 ) then + if ( iovr == 0 ) then cl2(i) = cl2(i) + ccur - cl2(i)*ccur else cl2(i) = max( cl2(i), ccur ) diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index 0596a987c..4ee7ca22b 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -243,14 +243,15 @@ module rrtmg_lw ! use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & - & icldflg, ivflip + & isubclw, icldflg, iovrlw, ivflip, & + & kind_phys use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 use mersenne_twister, only : random_setseed, random_number, & & random_stat !mz use machine, only : kind_phys, & - & im => kind_io4, rb => kind_phys + & im => kind_io4, rb => kind_phys use module_radlw_parameters ! @@ -391,13 +392,13 @@ subroutine rrtmg_lw_run & & gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & & gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, & & icseed,aeraod,aerssa,sfemis,sfgtmp, & - & dzlyr,delpin,de_lgth, iovrlw, isubclw, & + & dzlyr,delpin,de_lgth, & & npts, nlay, nlp1, lprnt, cld_cf, lslwr, & & hlwc,topflx,sfcflx,cldtau, & ! --- outputs & HLW0,HLWB,FLXPRF, & ! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, mpirank,mpiroot,errmsg, errflg & + & cld_od, errmsg, errflg & & ) ! ==================== defination of variables ==================== ! @@ -494,7 +495,7 @@ subroutine rrtmg_lw_run & ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (used for isubclw>0 only) ! ! =3: decorrelation-length overlap (for isubclw>0 only) ! -! =4: exponential overlap cloud +! =4: exponential overlapping cloud ! ! ivflip - control flag for vertical index direction ! ! =0: vertical index from toa to surface ! ! =1: vertical index from surface to toa ! @@ -574,9 +575,6 @@ subroutine rrtmg_lw_run & integer, intent(in) :: icseed(npts) logical, intent(in) :: lprnt - integer, intent(in) :: mpiroot - integer, intent(in) :: mpirank - integer, intent(in) :: iovrlw,isubclw real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: plvl, & & tlvl @@ -648,7 +646,7 @@ subroutine rrtmg_lw_run & ! mz* - Add height of each layer for exponential-random cloud overlap ! This will be derived below from the dzlyr in each layer real (kind=kind_phys), dimension( npts,nlay ) :: hgt - real (kind=kind_phys):: dzsum + real (kind=kind_phys) :: dzsum real (kind=kind_phys), dimension(0:nlp1) :: cldfrc @@ -678,8 +676,8 @@ subroutine rrtmg_lw_run & !mz rtrnmc_mcica real (kind=kind_phys), dimension(nlay,ngptlw) :: taut !mz* Atmosphere/clouds - cldprop - real(kind=kind_phys), dimension(ngptlw,nlay) :: cldfmc, & - & cldfmc_save ! cloud fraction [mcica] + real(kind=kind_phys), dimension(ngptlw,nlay) :: cldfmc, & + & cldfmc_save ! cloud fraction [mcica] ! Dimensions: (ngptlw,nlay) real(kind=kind_phys), dimension(ngptlw,nlay) :: ciwpmc ! in-cloud ice water path [mcica] ! Dimensions: (ngptlw,nlay) @@ -734,10 +732,9 @@ subroutine rrtmg_lw_run & !mz* ! For passing in cloud physical properties; cloud optics parameterized ! in RRTMG: - inflglw = 2 - iceflglw = 3 - liqflglw = 1 - + inflglw = 2 + iceflglw = 3 + liqflglw = 1 istart = 1 iend = 16 iout = 0 @@ -814,7 +811,7 @@ subroutine rrtmg_lw_run & stemp = sfgtmp(iplon) ! surface ground temp if (iovrlw == 3) delgth= de_lgth(iplon) ! clouds decorr-length -! mz*: HWRF practice +! mz*: HWRF if (iovrlw == 4 ) then !Add layer height needed for exponential (icld=4) and @@ -839,25 +836,6 @@ subroutine rrtmg_lw_run & enddo enddo - -! if(mpirank==mpiroot) then -! write(0,*) 'mcica_subcol_lw: max/min(cld_cf)=', & -! & maxval(cld_cf),minval(cld_cf) -! write(0,*) 'mcica_subcol_lw: max/min(cld_iwp)=', & -! & maxval(cld_iwp),minval(cld_iwp) -! write(0,*) 'mcica_subcol_lw: max/min(cld_lwp)=', & -! & maxval(cld_lwp),minval(cld_lwp) -! write(0,*) 'mcica_subcol_lw: max/min(cld_swp)=', & -! & maxval(cld_swp),minval(cld_swp) -! write(0,*) 'mcica_subcol_lw: max/min(cld_ref_ice)=', & -! & maxval(cld_ref_ice),minval(cld_ref_ice) -! write(0,*) 'mcica_subcol_lw: max/min(cld_ref_snow)=', & -! & maxval(cld_ref_snow),minval(cld_ref_snow) -! write(0,*) 'mcica_subcol_lw: max/min(cld_ref_liq)=', & -! & maxval(cld_ref_liq),minval(cld_ref_liq) - -! endif - call mcica_subcol_lw(1, iplon, nlay, iovrlw, permuteseed, & & irng, plyr, hgt, & & cld_cf, cld_iwp, cld_lwp,cld_swp, & @@ -867,26 +845,6 @@ subroutine rrtmg_lw_run & & ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, & & resnmcl, taucmcl) -!mz -! if(mpirank==mpiroot) then -! write(0,*) 'mcica_subcol_lw: max/min(cldfmcl)=', & -! & maxval(cldfmcl),minval(cldfmcl) -! write(0,*) 'mcica_subcol_lw: max/min(ciwpmcl)=', & -! & maxval(ciwpmcl),minval(ciwpmcl) -! write(0,*) 'mcica_subcol_lw: max/min(clwpmcl)=', & -! & maxval(clwpmcl),minval(clwpmcl) -! write(0,*) 'mcica_subcol_lw: max/min(cswpmcl)=', & -! & maxval(cswpmcl),minval(cswpmcl) -! write(0,*) 'mcica_subcol_lw: max/min(reicmcl)=', & -! & maxval(reicmcl),minval(reicmcl) -! write(0,*) 'mcica_subcol_lw: max/min(relqmcl)=', & -! & maxval(relqmcl),minval(relqmcl) -! write(0,*) 'mcica_subcol_lw: max/min(resnmcl)=', & -! & maxval(resnmcl),minval(resnmcl) -! write(0,*) 'mcica_subcol_lw: max/min(taucmcl)=', & -! & maxval(taucmcl),minval(taucmcl) - -! endif endif !mz* end @@ -977,7 +935,6 @@ subroutine rrtmg_lw_run & !> -# Read cloud optical properties. if (ilwcliq > 0) then ! use prognostic cloud method -!mz: GFS operational do k = 1, nlay k1 = nlp1 - k cldfrc(k)= cld_cf(iplon,k1) @@ -990,8 +947,8 @@ subroutine rrtmg_lw_run & cda3(k) = cld_swp(iplon,k1) cda4(k) = cld_ref_snow(iplon,k1) enddo - ! transfer - if (iovrlw .eq. 4) then !mz HWRF + ! HWRF RRMTG + if (iovrlw == 4) then !mz HWRF do k = 1, nlay k1 = nlp1 - k do ig = 1, ngptlw @@ -1102,8 +1059,6 @@ subroutine rrtmg_lw_run & enddo if (ilwcliq > 0) then ! use prognostic cloud method -!mz* - !mz calculate input for cldprop do k = 1, nlay cldfrc(k)= cld_cf(iplon,k) clwp(k) = cld_lwp(iplon,k) @@ -1115,7 +1070,7 @@ subroutine rrtmg_lw_run & cda3(k) = cld_swp(iplon,k) cda4(k) = cld_ref_snow(iplon,k) enddo - if (iovrlw .eq. 4) then + if (iovrlw == 4) then !mz* Move incoming GCM cloud arrays to RRTMG cloud arrays. !For GCM input, incoming reicmcl is defined based on selected !ice parameterization (inflglw) @@ -1209,7 +1164,7 @@ subroutine rrtmg_lw_run & if ( lcf1 ) then !mz* for HWRF, save cldfmc with mcica - if (iovrlw .eq.4) then + if (iovrlw == 4) then do k = 1, nlay do ig = 1, ngptlw cldfmc_save(ig,k)=cldfmc (ig,k) @@ -1220,12 +1175,12 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & nlay, nlp1, ipseed(iplon), dz, delgth,iovrlw, isubclw, & + & nlay, nlp1, ipseed(iplon), dz, delgth, & ! --- outputs: & cldfmc, taucld & & ) - if (iovrlw .eq.4) then + if (iovrlw == 4) then !mz for HWRF, still using mcica cldfmc do k = 1, nlay do ig = 1, ngptlw @@ -1253,30 +1208,13 @@ subroutine rrtmg_lw_run & taucld = f_zero endif -!!mz* HWRF practice, calculate taucmc with mcica - if (iovrlw .eq.4) then - !mz* HWRF practice, calculate taucmc -! if(mpirank==mpiroot) then -! write(0,*) 'bfe cldprmc: nlay,inflglw,iceflglw,liqflglw',& -! & nlay,inflglw,iceflglw,liqflglw -! write(0,*) 'bfe cldprmc: max/min(taucmc)=', & -! & maxval(taucmc),minval(taucmc) -! endif - - call cldprmc(nlay, inflglw, iceflglw, liqflglw, & - & cldfmc, ciwpmc, & - & clwpmc, cswpmc, reicmc, relqmc, resnmc, & - & ncbands, taucmc) - endif -! if(mpirank==mpiroot) then -! write(0,*) 'aft cldprmc: ncbands', ncbands -! write(0,*) 'aft cldprmc: max/min(taucmc)=', & -! & maxval(taucmc),minval(taucmc) -! endif - - -!mz* end - +!mz* HWRF: calculate taucmc with mcica + if (iovrlw == 4) then + call cldprmc(nlay, inflglw, iceflglw, liqflglw, & + & cldfmc, ciwpmc, & + & clwpmc, cswpmc, reicmc, relqmc, resnmc, & + & ncbands, taucmc) + endif ! if (lprnt) then ! print *,' after cldprop' @@ -1382,51 +1320,10 @@ subroutine rrtmg_lw_run & & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & & ) - endif ! end if_iovrlw_block - - else - -! if(iovrlw == 4) then + endif ! end if_iovrlw_block -!mz*HWRF practice -! -! pz(0)=plyr(iplon,1) -! do k= 1,nlay -! pz(k)=plvl(iplon,k+1) -! enddo - -! do k = 0, nlay -! do j = 1, nbands -! ! taut (k,j) = tautot(j,k) -! planklay(k,j) = pklay(j,k) -! planklev(k,j) = pklev(j,k) -! enddo -! enddo + else -! do k = 1, nlay -! do ig = 1, ngptlw -! fracs_r(k,ig) = fracs (ig,k) -! taut(k,ig)= tautot(ig,k) -! enddo -! enddo - -! call rtrnmc_mcica(nlay, istart, iend, iout, pz, & -! & semiss, ncbands, & -! & cldfmc, taucmc, planklay, planklev, & !plankbnd, & -! & pwvcm, fracs_r, taut, & -! & totuflux, totdflux, htr, & -! & totuclfl, totdclfl, htrcl ) - -! if(mpirank==mpiroot) then -! write(0,*) 'rtrnmc_mcica: max/min(htr)=', & -! & maxval(htr),minval(htr) -! endif - - -! else -!mz*end - -!mz*taucld(non-mcica) call rtrnmc & ! --- inputs: & ( semiss,delp,cldfmc,taucld,tautot,pklay,pklev, & @@ -1434,12 +1331,6 @@ subroutine rrtmg_lw_run & ! --- outputs: & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & & ) -! if(mpirank==mpiroot) then -! write(0,*) 'rtrnmc: max/min(htr)=', & -! & maxval(htr),minval(htr) -! endif - -! endif !end if_iovrlw block endif ! end if_isubclw_block @@ -1546,7 +1437,7 @@ end subroutine rrtmg_lw_finalize !!\section rlwinit_gen rlwinit General Algorithm !! @{ subroutine rlwinit & - & (iovrlw,isubclw, me ) ! --- inputs + & ( me ) ! --- inputs ! --- outputs: (none) ! =================== program usage description =================== ! @@ -1615,8 +1506,7 @@ subroutine rlwinit & ! ====================== end of description block ================= ! ! --- inputs: - integer, intent(in) :: me,isubclw - integer, intent(inout) :: iovrlw + integer, intent(in) :: me ! --- outputs: none @@ -1634,9 +1524,7 @@ subroutine rlwinit & print *,' *** Error in specification of cloud overlap flag', & & ' IOVRLW=',iovrlw,' in RLWINIT !!' stop -!mz -! elseif ( iovrlw>=2 .and. isubclw==0 ) then - elseif ( (iovrlw.eq.2 .or. iovrlw.eq.3).and. isubclw==0 ) then + elseif ( (iovrlw==2 .or. iovrlw==3) .and. isubclw==0 ) then if (me == 0) then print *,' *** IOVRLW=',iovrlw,' is not available for', & & ' ISUBCLW=0 setting!!' @@ -1780,7 +1668,7 @@ end subroutine rlwinit !> @{ subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & nlay, nlp1, ipseed, dz, de_lgth,iovrlw,isubclw, & + & nlay, nlp1, ipseed, dz, de_lgth, & & cldfmc, taucld & ! --- outputs & ) @@ -1880,7 +1768,7 @@ subroutine cldprop & use module_radlw_cldprlw ! --- inputs: - integer, intent(in) :: nlay, nlp1, ipseed,iovrlw,isubclw + integer, intent(in) :: nlay, nlp1, ipseed real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & @@ -2044,7 +1932,7 @@ subroutine cldprop & endif lab_if_ilwcliq -!> -# if isubclw > 0, call mcica_subcol() to distribute +!> -# if physparam::isubclw > 0, call mcica_subcol() to distribute !! cloud properties to each g-point. if ( isubclw > 0 ) then ! mcica sub-col clouds approx @@ -2060,7 +1948,7 @@ subroutine cldprop & call mcica_subcol & ! --- inputs: - & ( cldf, nlay, ipseed, dz, de_lgth, iovrlw, & + & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- output: & lcloudy & & ) @@ -2094,7 +1982,7 @@ end subroutine cldprop !!\section mcica_subcol_gen mcica_subcol General Algorithm !! @{ subroutine mcica_subcol & - & ( cldf, nlay, ipseed, dz, de_lgth, iovrlw, & ! --- inputs + & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs & lcloudy & ! --- outputs & ) @@ -2122,7 +2010,7 @@ subroutine mcica_subcol & implicit none ! --- inputs: - integer, intent(in) :: nlay, ipseed, iovrlw + integer, intent(in) :: nlay, ipseed real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz real (kind=kind_phys), intent(in) :: de_lgth @@ -2473,11 +2361,6 @@ subroutine setcoef & ! --- ... begin spectral band loop do i = 1, nbands -!mz* -! plankbnd(iband) = semiss(iband) * & -! (totplnk(indbound,iband) + tbndfrac * dbdtlev) -!mz - pklay(i,k) = delwave(i) * (totplnk(indlay,i) + tlyrfr & & * (totplnk(indlay+1,i) - totplnk(indlay,i)) ) pklev(i,k) = delwave(i) * (totplnk(indlev,i) + tlvlfr & diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 6fc58d635..da7496f87 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -207,22 +207,6 @@ kind = kind_phys intent = in optional = F -[iovrlw] - standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation - long_name = control flag for cloud overlapping method for LW - units = flag - dimensions = () - type = integer - intent = in - optional = F -[isubclw] - standard_name = flag_for_lw_clouds_sub_grid_approximation - long_name = flag for lw clouds sub-grid approximation - units = flag - dimensions = () - type = integer - intent = in - optional = F [npts] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -387,22 +371,6 @@ kind = kind_phys intent = in optional = T -[mpirank] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[mpiroot] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index cd7705d3f..51512835c 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -268,8 +268,8 @@ !! code from aer inc. module rrtmg_sw ! - use physparam, only : iswrate, iswrgas, iswcice, & !mz: iswcliq - & icldflg, ivflip, & + use physparam, only : iswrate, iswrgas, iswcliq, iswcice, & + & isubcsw, icldflg, iovrsw, ivflip, & & iswmode use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 @@ -369,7 +369,7 @@ module rrtmg_sw ! --- public accessable subprograms public rrtmg_sw_init, rrtmg_sw_run, rrtmg_sw_finalize, rswinit, & - & kissvec, generate_stochastic_clouds_sw,mcica_subcol_sw + & kissvec, generate_stochastic_clouds_sw, mcica_subcol_sw ! ================= @@ -470,7 +470,7 @@ subroutine rrtmg_sw_run & & icseed, aeraod, aerssa, aerasy, & & sfcalb_nir_dir, sfcalb_nir_dif, & & sfcalb_uvis_dir, sfcalb_uvis_dif, & - & dzlyr,delpin,de_lgth, iswcliq, iovrsw, isubcsw, & + & dzlyr,delpin,de_lgth, & & cosz,solcon,NDAY,idxday, & & npts, nlay, nlp1, lprnt, & & cld_cf, lsswr, & @@ -478,7 +478,8 @@ subroutine rrtmg_sw_run & & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy,mpirank,mpiroot, errmsg, errflg ) + & cld_od, cld_ssa, cld_asy, errmsg, errflg & + & ) ! ==================== defination of variables ==================== ! ! ! @@ -597,7 +598,7 @@ subroutine rrtmg_sw_run & ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! ! =3: decorrelation-length overlap clouds ! -! =4: exponential overlapping clouds +! =4: exponential overlapping clouds ! ! ivflip - control flg for direction of vertical index ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! @@ -657,7 +658,6 @@ subroutine rrtmg_sw_run & ! --- inputs: integer, intent(in) :: npts, nlay, nlp1, NDAY - integer, intent(in) :: iswcliq,iovrsw,isubcsw integer, dimension(:), intent(in) :: idxday, icseed @@ -696,7 +696,6 @@ subroutine rrtmg_sw_run & real (kind=kind_phys), intent(in) :: cosz(npts), solcon, & & de_lgth(npts) - integer, intent(in) :: mpirank,mpiroot ! --- outputs: real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hswc real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & @@ -822,7 +821,7 @@ subroutine rrtmg_sw_run & integer, dimension(npts) :: ipseed integer, dimension(nlay) :: indfor, indself, jp, jt, jt1 - integer :: i, ib, ipt, j1, k, kk, laytrop, mb,ig + integer :: i, ib, ipt, j1, k, kk, laytrop, mb, ig integer :: inflgsw, iceflgsw, liqflgsw integer :: irng, permuteseed ! @@ -834,13 +833,13 @@ subroutine rrtmg_sw_run & ! Select cloud liquid and ice optics parameterization options ! For passing in cloud optical properties directly: -! inflgsw = 0 -! iceflgsw = 0 -! liqflgsw = 0 +! inflgsw = 0 +! iceflgsw = 0 +! liqflgsw = 0 ! For passing in cloud physical properties; cloud optics parameterized in RRTMG: - inflgsw = 2 - iceflgsw = 3 - liqflgsw = 1 + inflgsw = 2 + iceflgsw = 3 + liqflgsw = 1 ! if (.not. lsswr) return if (nday <= 0) return @@ -942,7 +941,7 @@ subroutine rrtmg_sw_run & albdf(2) = sfcalb_uvis_dif(j1) -! mz*: HWRF practice +! mz*: HWRF if (iovrsw == 4 ) then @@ -973,25 +972,6 @@ subroutine rrtmg_sw_run & enddo enddo -!mz -! if(mpirank==mpiroot) then -! write(0,*) 'mcica_subcol_sw: max/min(cld_cf)=', & -! & maxval(cld_cf),minval(cld_cf) -! write(0,*) 'mcica_subcol_sw: max/min(cld_iwp)=', & -! & maxval(cld_iwp),minval(cld_iwp) -! write(0,*) 'mcica_subcol_sw: max/min(cld_lwp)=', & -! & maxval(cld_lwp),minval(cld_lwp) -! write(0,*) 'mcica_subcol_sw: max/min(cld_swp)=', & -! & maxval(cld_swp),minval(cld_swp) -! write(0,*) 'mcica_subcol_sw: max/min(cld_ref_ice)=', & -! & maxval(cld_ref_ice),minval(cld_ref_ice) -! write(0,*) 'mcica_subcol_sw: max/min(cld_ref_snow)=', & -! & maxval(cld_ref_snow),minval(cld_ref_snow) -! write(0,*) 'mcica_subcol_sw: max/min(cld_ref_liq)=', & -! & maxval(cld_ref_liq),minval(cld_ref_liq) -! endif - - call mcica_subcol_sw (1, j1, nlay, iovrsw, permuteseed, & & irng, plyr, hgt, & & cld_cf, cld_iwp, cld_lwp,cld_swp, & @@ -999,25 +979,7 @@ subroutine rrtmg_sw_run & & cld_ref_snow, taucld3,ssacld3,asmcld3,fsfcld3, & & cldfmcl, ciwpmcl, clwpmcl, cswpmcl, & !--output & reicmcl, relqmcl, resnmcl, & - & taucmcl, ssacmcl, asmcmcl, fsfcmcl) - -!mz -! if(mpirank==mpiroot) then -! write(0,*) 'mcica_subcol_sw: max/min(cldfmcl)=', & -! & maxval(cldfmcl),minval(cldfmcl) -! write(0,*) 'mcica_subcol_sw: max/min(ciwpmcl)=', & -! & maxval(ciwpmcl),minval(ciwpmcl) -! write(0,*) 'mcica_subcol_sw: max/min(clwpmcl)=', & -! & maxval(clwpmcl),minval(clwpmcl) -! write(0,*) 'mcica_subcol_sw: max/min(cswpmcl)=', & -! & maxval(cswpmcl),minval(cswpmcl) -! write(0,*) 'mcica_subcol_sw: max/min(reicmcl)=', & -! & maxval(reicmcl),minval(reicmcl) -! write(0,*) 'mcica_subcol_sw: max/min(relqmcl)=', & -! & maxval(relqmcl),minval(relqmcl) -! write(0,*) 'mcica_subcol_sw: max/min(resnmcl)=', & -! & maxval(resnmcl),minval(resnmcl) -! endif + & taucmcl, ssacmcl, asmcmcl, fsfcmcl) endif !mz* end @@ -1093,8 +1055,6 @@ subroutine rrtmg_sw_run & !> -# Read cloud optical properties from 'clouds'. if (iswcliq > 0) then ! use prognostic cloud method -!mz:GFS operational - !if (iovrsw .eq. 1) then do k = 1, nlay kk = nlp1 - k cfrac(k) = cld_cf(j1,kk) ! cloud fraction @@ -1107,7 +1067,7 @@ subroutine rrtmg_sw_run & cdat3(k) = cld_swp(j1,kk) ! cloud snow path cdat4(k) = cld_ref_snow(j1,kk) ! snow partical effctive radius enddo - if (iovrsw .eq. 4) then !mz* HWRF + if (iovrsw == 4) then !mz* HWRF do k = 1, nlay kk = nlp1 - k do ig = 1, ngptsw @@ -1128,7 +1088,7 @@ subroutine rrtmg_sw_run & resnmc(k) = resnmcl(j1,kk) endif enddo - endif + endif else ! use diagnostic cloud method do k = 1, nlay kk = nlp1 - k @@ -1210,7 +1170,6 @@ subroutine rrtmg_sw_run & enddo if (iswcliq > 0) then ! use prognostic cloud method - !if (iovrsw .eq. 1) then !mz* GFS operational do k = 1, nlay cfrac(k) = cld_cf(j1,k) ! cloud fraction cliqp(k) = cld_lwp(j1,k) ! cloud liq path @@ -1222,7 +1181,7 @@ subroutine rrtmg_sw_run & cdat3(k) = cld_swp(j1,k) ! cloud snow path cdat4(k) = cld_ref_snow(j1,k) ! snow partical effctive radius enddo - if (iovrsw .eq. 4) then !mz* HWRF + if (iovrsw == 4) then !mz* HWRF !mz* Move incoming GCM cloud arrays to RRTMG cloud arrays. !For GCM input, incoming reicmcl is defined based on selected !ice parameterization (inflglw) @@ -1269,8 +1228,7 @@ subroutine rrtmg_sw_run & do k = 1, nlay zcf0 = zcf0 * (f_one - cfrac(k)) enddo -!mz else if (iovrsw == 1) then ! max/ran overlapping - else if (iovrsw == 1.or. iovrsw == 4) then ! mz* also exponential overlapping + else if (iovrsw == 1 .or. iovrsw == 4) then ! max/ra/exp overlapping do k = 1, nlay if (cfrac(k) > ftiny) then ! cloudy layer zcf1 = min ( zcf1, f_one-cfrac(k) ) @@ -1280,7 +1238,7 @@ subroutine rrtmg_sw_run & endif enddo zcf0 = zcf0 * zcf1 - else if (iovrsw >= 2 .and. iovrsw .ne. 4) then + else if (iovrsw >= 2 .and. iovrsw /= 4) then do k = 1, nlay zcf0 = min ( zcf0, f_one-cfrac(k) ) ! used only as clear/cloudy indicator enddo @@ -1292,13 +1250,11 @@ subroutine rrtmg_sw_run & !> -# For cloudy sky column, call cldprop() to compute the cloud !! optical properties for each cloudy layer. - - !if (iovrsw .eq. 1 ) then if (zcf1 > f_zero) then ! cloudy sky column !mz* for HWRF, save cldfmc with mcica - if (iovrsw .eq.4) then + if (iovrsw == 4) then do k = 1, nlay do ig = 1, ngptsw cldfmc_save(k,ig)=cldfmc (k,ig) @@ -1306,16 +1262,15 @@ subroutine rrtmg_sw_run & enddo endif - call cldprop & ! --- inputs: & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & - & zcf1, nlay, ipseed(j1), dz, delgth,iswcliq,iovrsw,isubcsw, & + & zcf1, nlay, ipseed(j1), dz, delgth, & ! --- outputs: - & taucw, ssacw, asycw, cldfrc, cldfmc & !mz: cldfmc(k,ig) + & taucw, ssacw, asycw, cldfrc, cldfmc & & ) - if (iovrsw .eq.4) then + if (iovrsw == 4) then !mz for HWRF, still using mcica cldfmc do k = 1, nlay do ig = 1, ngptsw @@ -1350,20 +1305,6 @@ subroutine rrtmg_sw_run & enddo endif ! end if_zcf1_block -! if (iovrsw .eq. 4) then !mz* HWRF -!! For cloudy atmosphere, use cldprop to set cloud optical properties based on -!! input cloud physical properties. Select method based on choices described -!! in cldprop. Cloud fraction, water path, liquid droplet and ice particle -!! effective radius must be passed in cldprop. Cloud fraction and cloud -!! optical properties are transferred to rrtmg_sw arrays in cldprop. - -! call cldprmc_sw(nlayers, inflg, iceflg, liqflg, cldfmc, & -! ciwpmc, clwpmc, cswpmc, reicmc, relqmc, resnmc, & -! taormc, taucmc, ssacmc, asmcmc, fsfcmc) -! icpr = 1 - -! endif - !> -# Call setcoef() to compute various coefficients needed in !! radiative transfer calculations. call setcoef & @@ -1374,33 +1315,6 @@ subroutine rrtmg_sw_run & & selffac,selffrac,indself,forfac,forfrac,indfor & & ) -!mz* HWRF clouds -! if(iovrsw .eq.0) then -! zcldfmc(:,:) = 0._rb -! ztaucmc(:,:) = 0._rb -! ztaormc(:,:) = 0._rb -! zasycmc(:,:) = 0._rb -! zomgcmc(:,:) = 1._rb - -! elseif (iovrsw.eq.4) then -! do i=1,nlayers -! do ig=1,ngptsw -! zcldfmc(i,ig) = cldfmc(ig,i) -! ztaucmc(i,ig) = taucmc(ig,i) -! ztaormc(i,ig) = taormc(ig,i) -! zasycmc(i,ig) = asmcmc(ig,i) -! zomgcmc(i,ig) = ssacmc(ig,i) -! enddo -! enddo -!Aerosol -!mz* no aerosol at this moment (iaer .eq.0) -! ztaua(:,:) = 0._rb -! zasya(:,:) = 0._rb -! zomga(:,:) = 1._rb - -! endif -!mz* - !> -# Call taumol() to calculate optical depths for gaseous absorption !! and rayleigh scattering call taumol & @@ -1431,8 +1345,6 @@ subroutine rrtmg_sw_run & & ) else ! use mcica cloud scheme - -!mz if(iovrsw .eq. 1 ) then ! mz*:GFS operational call spcvrtm & ! --- inputs: @@ -1445,19 +1357,6 @@ subroutine rrtmg_sw_run & & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & & ) -!mz else if (iovrsw .eq.4 ) then -! call spcvmc_sw & -! (nlayers, istart, iend, icpr, iout, & -! pavel, tavel, pz, tz, tbound, albdif, albdir, & -! zcldfmc, ztaucmc, zasycmc, zomgcmc, ztaormc, & -! ztaua, zasya, zomga, cossza, coldry, wkl, adjflux, & -! laytrop, layswtch, laylow, jp, jt, jt1, & -! co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, & -! fac00, fac01, fac10, fac11, & -! selffac, selffrac, indself, forfac, forfrac, indfor, & -! zbbfd, zbbfu, zbbcd, zbbcu, zuvfd, zuvcd, znifd, znicd, & -! zbbfddir, zbbcddir, zuvfddir, zuvcddir, znifddir, znicddir) - endif !> -# Save outputs. @@ -1634,7 +1533,7 @@ end subroutine rrtmg_sw_finalize !! @{ !----------------------------------- subroutine rswinit & - & (iswcliq,iovrsw,isubcsw, me ) ! --- inputs: + & ( me ) ! --- inputs: ! --- outputs: (none) ! =================== program usage description =================== ! @@ -1690,8 +1589,7 @@ subroutine rswinit & ! ====================== end of description block ================= ! ! --- inputs: - integer, intent(in) :: me,isubcsw,iswcliq - integer, intent(inout) :: iovrsw + integer, intent(in) :: me ! --- outputs: none @@ -1838,7 +1736,7 @@ end subroutine rswinit !----------------------------------- subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & cf1, nlay, ipseed, dz, delgth,iswcliq,iovrsw, isubcsw, & + & cf1, nlay, ipseed, dz, delgth, & & taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output & ) @@ -1853,7 +1751,7 @@ subroutine cldprop & ! ! ! inputs: size ! ! cfrac - real, layer cloud fraction nlay ! -! ..... for iswcliq > 0 (prognostic cloud sckeme) - - - ! +! ..... for iswcliq > 0 (prognostic cloud scheme) - - - ! ! cliqp - real, layer in-cloud liq water path (g/m**2) nlay ! ! reliq - real, mean eff radius for liq cloud (micron) nlay ! ! cicep - real, layer in-cloud ice water path (g/m**2) nlay ! @@ -1862,7 +1760,7 @@ subroutine cldprop & ! cdat2 - real, effective radius for rain drop (micron) nlay ! ! cdat3 - real, layer snow flake water path(g/m**2) nlay ! ! cdat4 - real, mean eff radius for snow flake(micron) nlay ! -! ..... for iswcliq = 0 (diagnostic cloud sckeme) - - - ! +! ..... for iswcliq = 0 (diagnostic cloud scheme) - - - ! ! cdat1 - real, layer cloud optical depth nlay ! ! cdat2 - real, layer cloud single scattering albedo nlay ! ! cdat3 - real, layer cloud asymmetry factor nlay ! @@ -1924,7 +1822,7 @@ subroutine cldprop & use module_radsw_cldprtb ! --- inputs: - integer, intent(in) :: nlay, ipseed,iswcliq,iovrsw,isubcsw + integer, intent(in) :: nlay, ipseed real (kind=kind_phys), intent(in) :: cf1, delgth real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & @@ -2170,8 +2068,7 @@ subroutine cldprop & !> -# if physparam::isubcsw > 0, call mcica_subcol() to distribute !! cloud properties to each g-point. -!mz if ( isubcsw > 0 ) then ! mcica sub-col clouds approx - if ( isubcsw > 0 .and. iovrsw .ne. 4 ) then ! mcica sub-col clouds approx + if ( isubcsw > 0 .and. iovrsw /= 4 ) then ! mcica sub-col clouds approx cldf(:) = cfrac(:) where (cldf(:) < ftiny) @@ -2182,7 +2079,7 @@ subroutine cldprop & call mcica_subcol & ! --- inputs: - & ( cldf, nlay, ipseed, dz, delgth, iovrsw, & + & ( cldf, nlay, ipseed, dz, delgth, & ! --- outputs: & lcloudy & & ) @@ -2222,7 +2119,7 @@ end subroutine cldprop !> @{ ! ---------------------------------- subroutine mcica_subcol & - & ( cldf, nlay, ipseed, dz, de_lgth,iovrsw, & ! --- inputs + & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs & lcloudy & ! --- outputs & ) @@ -2253,7 +2150,7 @@ subroutine mcica_subcol & implicit none ! --- inputs: - integer, intent(in) :: nlay, ipseed, iovrsw + integer, intent(in) :: nlay, ipseed real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz real (kind=kind_phys), intent(in) :: de_lgth @@ -2268,7 +2165,7 @@ subroutine mcica_subcol & type (random_stat) :: stat ! for thread safe random generator - integer :: k, n, k1, ig + integer :: k, n, k1 ! !===> ... begin here ! diff --git a/physics/radsw_main.f b/physics/radsw_main.f deleted file mode 100644 index 30bc58bba..000000000 --- a/physics/radsw_main.f +++ /dev/null @@ -1,5472 +0,0 @@ -!> \file radsw_main.f -!! This file contains NCEP's modifications of the rrtmg-sw radiation -!! code from AER. - -! ============================================================== !!!!! -! sw-rrtm3 radiation package description !!!!! -! ============================================================== !!!!! -! ! -! this package includes ncep's modifications of the rrtm-sw radiation ! -! code from aer inc. ! -! ! -! the sw-rrtm3 package includes these parts: ! -! ! -! 'radsw_rrtm3_param.f' ! -! 'radsw_rrtm3_datatb.f' ! -! 'radsw_rrtm3_main.f' ! -! ! -! the 'radsw_rrtm3_param.f' contains: ! -! ! -! 'module_radsw_parameters' -- band parameters set up ! -! ! -! the 'radsw_rrtm3_datatb.f' contains: ! -! ! -! 'module_radsw_ref' -- reference temperature and pressure ! -! 'module_radsw_cldprtb' -- cloud property coefficients table ! -! 'module_radsw_sflux' -- spectral distribution of solar flux ! -! 'module_radsw_kgbnn' -- absorption coeffients for 14 ! -! bands, where nn = 16-29 ! -! ! -! the 'radsw_rrtm3_main.f' contains: ! -! ! -! 'rrtmg_sw' -- main sw radiation transfer ! -! ! -! in the main module 'rrtmg_sw' there are only two ! -! externally callable subroutines: ! -! ! -! 'swrad' -- main sw radiation routine ! -! inputs: ! -! (plyr,plvl,tlyr,tlvl,qlyr,olyr,gasvmr, ! -! clouds,icseed,aerosols,sfcalb, ! -! dzlyr,delpin,de_lgth, ! -! cosz,solcon,NDAY,idxday, ! -! npts, nlay, nlp1, lprnt, ! -! outputs: ! -! hswc,topflx,sfcflx,cldtau, ! -!! optional outputs: ! -! HSW0,HSWB,FLXPRF,FDNCMP) ! -! ) ! -! ! -! 'rswinit' -- initialization routine ! -! inputs: ! -! ( me ) ! -! outputs: ! -! (none) ! -! ! -! all the sw radiation subprograms become contained subprograms ! -! in module 'rrtmg_sw' and many of them are not directly ! -! accessable from places outside the module. ! -! ! -! derived data type constructs used: ! -! ! -! 1. radiation flux at toa: (from module 'module_radsw_parameters') ! -! topfsw_type - derived data type for toa rad fluxes ! -! upfxc total sky upward flux at toa ! -! dnfxc total sky downward flux at toa ! -! upfx0 clear sky upward flux at toa ! -! ! -! 2. radiation flux at sfc: (from module 'module_radsw_parameters') ! -! sfcfsw_type - derived data type for sfc rad fluxes ! -! upfxc total sky upward flux at sfc ! -! dnfxc total sky downward flux at sfc ! -! upfx0 clear sky upward flux at sfc ! -! dnfx0 clear sky downward flux at sfc ! -! ! -! 3. radiation flux profiles(from module 'module_radsw_parameters') ! -! profsw_type - derived data type for rad vertical prof ! -! upfxc level upward flux for total sky ! -! dnfxc level downward flux for total sky ! -! upfx0 level upward flux for clear sky ! -! dnfx0 level downward flux for clear sky ! -! ! -! 4. surface component fluxes(from module 'module_radsw_parameters' ! -! cmpfsw_type - derived data type for component sfc flux ! -! uvbfc total sky downward uv-b flux at sfc ! -! uvbf0 clear sky downward uv-b flux at sfc ! -! nirbm surface downward nir direct beam flux ! -! nirdf surface downward nir diffused flux ! -! visbm surface downward uv+vis direct beam flx ! -! visdf surface downward uv+vis diffused flux ! -! ! -! external modules referenced: ! -! ! -! 'module physparam' ! -! 'module physcons' ! -! 'mersenne_twister' ! -! ! -! compilation sequence is: ! -! ! -! 'radsw_rrtm3_param.f' ! -! 'radsw_rrtm3_datatb.f' ! -! 'radsw_rrtm3_main.f' ! -! ! -! and all should be put in front of routines that use sw modules ! -! ! -!==========================================================================! -! ! -! the original program declarations: ! -! ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! ! -! Copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). ! -! This software may be used, copied, or redistributed as long as it is ! -! not sold and this copyright notice is reproduced on each copy made. ! -! This model is provided as is without any express or implied warranties. ! -! (http://www.rtweb.aer.com/) ! -! ! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! ! -! ************************************************************************ ! -! ! -! rrtmg_sw ! -! ! -! ! -! a rapid radiative transfer model ! -! for the solar spectral region ! -! atmospheric and environmental research, inc. ! -! 131 hartwell avenue ! -! lexington, ma 02421 ! -! ! -! eli j. mlawer ! -! jennifer s. delamere ! -! michael j. iacono ! -! shepard a. clough ! -! ! -! ! -! email: miacono@aer.com ! -! email: emlawer@aer.com ! -! email: jdelamer@aer.com ! -! ! -! the authors wish to acknowledge the contributions of the ! -! following people: steven j. taubman, patrick d. brown, ! -! ronald e. farren, luke chen, robert bergstrom. ! -! ! -! ************************************************************************ ! -! ! -! references: ! -! (rrtm_sw/rrtmg_sw): ! -! clough, s.a., m.w. shephard, e.j. mlawer, j.s. delamere, ! -! m.j. iacono, k. cady-pereira, s. boukabara, and p.d. brown: ! -! atmospheric radiative transfer modeling: a summary of the aer ! -! codes, j. quant. spectrosc. radiat. transfer, 91, 233-244, 2005. ! -! ! -! (mcica): ! -! pincus, r., h. w. barker, and j.-j. morcrette: a fast, flexible, ! -! approximation technique for computing radiative transfer in ! -! inhomogeneous cloud fields, j. geophys. res., 108(d13), 4376, ! -! doi:10.1029/2002jd003322, 2003. ! -! ! -! ************************************************************************ ! -! ! -! aer's revision history: ! -! this version of rrtmg_sw has been modified from rrtm_sw to use a ! -! reduced set of g-point intervals and a two-stream model for ! -! application to gcms. ! -! ! -! -- original version (derived from rrtm_sw) ! -! 2002: aer. inc. ! -! -- conversion to f90 formatting; addition of 2-stream radiative transfer! -! feb 2003: j.-j. morcrette, ecmwf ! -! -- additional modifications for gcm application ! -! aug 2003: m. j. iacono, aer inc. ! -! -- total number of g-points reduced from 224 to 112. original ! -! set of 224 can be restored by exchanging code in module parrrsw.f90 ! -! and in file rrtmg_sw_init.f90. ! -! apr 2004: m. j. iacono, aer, inc. ! -! -- modifications to include output for direct and diffuse ! -! downward fluxes. there are output as "true" fluxes without ! -! any delta scaling applied. code can be commented to exclude ! -! this calculation in source file rrtmg_sw_spcvrt.f90. ! -! jan 2005: e. j. mlawer, m. j. iacono, aer, inc. ! -! -- revised to add mcica capability. ! -! nov 2005: m. j. iacono, aer, inc. ! -! -- reformatted for consistency with rrtmg_lw. ! -! feb 2007: m. j. iacono, aer, inc. ! -! -- modifications to formatting to use assumed-shape arrays. ! -! aug 2007: m. j. iacono, aer, inc. ! -! ! -! ************************************************************************ ! -! ! -! ncep modifications history log: ! -! ! -! sep 2003, yu-tai hou -- received aer's rrtm-sw gcm version ! -! code (v224) ! -! nov 2003, yu-tai hou -- corrected errors in direct/diffuse ! -! surface alabedo components. ! -! jan 2004, yu-tai hou -- modified code into standard modular! -! f9x code for ncep models. the original three cloud ! -! control flags are simplified into two: iflagliq and ! -! iflagice. combined the org subr sw_224 and setcoef ! -! into radsw (the main program); put all kgb##together ! -! and reformat into a separated data module; combine ! -! reftra and vrtqdr as swflux; optimized taumol and all ! -! taubgs to form a contained subroutines. ! -! jun 2004, yu-tai hou -- modified code based on aer's faster! -! version rrtmg_sw (v2.0) with 112 g-points. ! -! mar 2005, yu-tai hou -- modified to aer v2.3, correct cloud! -! scaling error, total sky properties are delta scaled ! -! after combining clear and cloudy parts. the testing ! -! criterion of ssa is saved before scaling. added cloud ! -! layer rain and snow contributions. all cloud water ! -! partical contents are treated the same way as other ! -! atmos particles. ! -! apr 2005, yu-tai hou -- modified on module structures (this! -! version of code was given back to aer in jun 2006) ! -! nov 2006, yu-tai hou -- modified code to include the ! -! generallized aerosol optical property scheme for gcms.! -! apr 2007, yu-tai hou -- added spectral band heating as an ! -! optional output to support the 500km model's upper ! -! stratospheric radiation calculations. restructure ! -! optional outputs for easy access by different models. ! -! oct 2008, yu-tai hou -- modified to include new features ! -! from aer's newer release v3.5-v3.61, including mcica ! -! sub-grid cloud option and true direct/diffuse fluxes ! -! without delta scaling. added rain/snow opt properties ! -! support to cloudy sky calculations. simplified and ! -! unified sw and lw sub-column cloud subroutines into ! -! one module by using optional parameters. ! -! mar 2009, yu-tai hou -- replaced the original random number! -! generator coming with the original code with ncep w3 ! -! library to simplify the program and moved sub-column ! -! cloud subroutines inside the main module. added ! -! option of user provided permutation seeds that could ! -! be randomly generated from forecast time stamp. ! -! mar 2009, yu-tai hou -- replaced random number generator ! -! programs coming from the original code with the ncep ! -! w3 library to simplify the program and moved sub-col ! -! cloud subroutines inside the main module. added ! -! option of user provided permutation seeds that could ! -! be randomly generated from forecast time stamp. ! -! nov 2009, yu-tai hou -- updated to aer v3.7-v3.8 version. ! -! notice the input cloud ice/liquid are assumed as ! -! in-cloud quantities, not grid average quantities. ! -! aug 2010, yu-tai hou -- uptimized code to improve efficiency -! splited subroutine spcvrt into two subs, spcvrc and ! -! spcvrm, to handling non-mcica and mcica type of calls.! -! apr 2012, b. ferrier and y. hou -- added conversion factor to fu's! -! cloud-snow optical property scheme. ! -! jul 2012, s. moorthi and Y. hou -- eliminated the pointer array ! -! in subr 'spcvrt' for multi-threading issue running ! -! under intel's fortran compiler. ! -! nov 2012, yu-tai hou -- modified control parameters thru ! -! module 'physparam'. ! -! jun 2013, yu-tai hou -- moving band 9 surface treatment ! -! back as in the rrtm2 version, spliting surface flux ! -! into two spectral regions (vis & nir), instead of ! -! designated it in nir region only. ! -! may 2016 yu-tai hou --reverting swflux name back to vrtqdr! -! jun 2018 yu-tai hou --updated cloud optical coeffs with ! -! aer's newer version v3.9-v4.0 for hu and stamnes ! -! scheme. (used if iswcliq=2); added new option of ! -! cloud overlap method 'de-correlation-length'. ! -! ! -!!!!! ============================================================== !!!!! -!!!!! end descriptions !!!!! -!!!!! ============================================================== !!!!! - -!> This module contains the CCPP-compliant NCEP's modifications of the rrtm-sw radiation -!! code from aer inc. - module rrtmg_sw -! - use physparam, only : iswrate, iswrgas, iswcice, & !mz: iswcliq-NML option - & isubcsw, icldflg, iovrsw, ivflip, & - & iswmode, kind_phys - use physcons, only : con_g, con_cp, con_avgd, con_amd, & - & con_amw, con_amo3 - - use module_radsw_parameters - use mersenne_twister, only : random_setseed, random_number, & - & random_stat - use module_radsw_ref, only : preflog, tref - use module_radsw_sflux -! - implicit none -! - private -! -! --- version tag and last revision date - character(40), parameter :: & - & VTAGSW='NCEP SW v5.1 Nov 2012 -RRTMG-SW v3.8 ' -! & VTAGSW='NCEP SW v5.0 Aug 2012 -RRTMG-SW v3.8 ' -! & VTAGSW='RRTMG-SW v3.8 Nov 2009' -! & VTAGSW='RRTMG-SW v3.7 Nov 2009' -! & VTAGSW='RRTMG-SW v3.61 Oct 2008' -! & VTAGSW='RRTMG-SW v3.5 Oct 2008' -! & VTAGSW='RRTM-SW 112v2.3 Apr 2007' -! & VTAGSW='RRTM-SW 112v2.3 Mar 2005' -! & VTAGSW='RRTM-SW 112v2.0 Jul 2004' - -! \name constant values - - real (kind=kind_phys), parameter :: eps = 1.0e-6 - real (kind=kind_phys), parameter :: oneminus= 1.0 - eps -! pade approx constant - real (kind=kind_phys), parameter :: bpade = 1.0/0.278 - real (kind=kind_phys), parameter :: stpfac = 296.0/1013.0 - real (kind=kind_phys), parameter :: ftiny = 1.0e-12 - real (kind=kind_phys), parameter :: flimit = 1.0e-20 -! internal solar constant - real (kind=kind_phys), parameter :: s0 = 1368.22 - - real (kind=kind_phys), parameter :: f_zero = 0.0 - real (kind=kind_phys), parameter :: f_one = 1.0 - -! \name atomic weights for conversion from mass to volume mixing ratios - real (kind=kind_phys), parameter :: amdw = con_amd/con_amw - real (kind=kind_phys), parameter :: amdo3 = con_amd/con_amo3 - -! \name band indices - integer, dimension(nblow:nbhgh) :: nspa, nspb -! band index for sfc flux - integer, dimension(nblow:nbhgh) :: idxsfc -! band index for cld prop - integer, dimension(nblow:nbhgh) :: idxebc - - data nspa(:) / 9, 9, 9, 9, 1, 9, 9, 1, 9, 1, 0, 1, 9, 1 / - data nspb(:) / 1, 5, 1, 1, 1, 5, 1, 0, 1, 0, 0, 1, 5, 1 / - -! data idxsfc(:) / 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 1 / ! band index for sfc flux - data idxsfc(:) / 1, 1, 1, 1, 1, 1, 1, 1, 0, 2, 2, 2, 2, 1 / ! band index for sfc flux - data idxebc(:) / 5, 5, 4, 4, 3, 3, 2, 2, 1, 1, 1, 1, 1, 5 / ! band index for cld prop - -! --- band wavenumber intervals -! real (kind=kind_phys), dimension(nblow:nbhgh):: wavenum1,wavenum2 -! data wavenum1(:) / & -! & 2600.0, 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, & -! & 8050.0,12850.0,16000.0,22650.0,29000.0,38000.0, 820.0 / -! data wavenum2(:) / & -! 3250.0, 4000.0, 4650.0, 5150.0, 6150.0, 7700.0, 8050.0, & -! & 12850.0,16000.0,22650.0,29000.0,38000.0,50000.0, 2600.0 / -! real (kind=kind_phys), dimension(nblow:nbhgh) :: delwave -! data delwave(:) / & -! & 650.0, 750.0, 650.0, 500.0, 1000.0, 1550.0, 350.0, & -! & 4800.0, 3150.0, 6650.0, 6350.0, 9000.0,12000.0, 1780.0 / - -! uv-b band index - integer, parameter :: nuvb = 27 - -!\name logical flags for optional output fields - logical :: lhswb = .false. - logical :: lhsw0 = .false. - logical :: lflxprf= .false. - logical :: lfdncmp= .false. - - -! those data will be set up only once by "rswinit" - real (kind=kind_phys) :: exp_tbl(0:NTBMX) - - -! the factor for heating rates (in k/day, or k/sec set by subroutine -!! 'rswinit') - real (kind=kind_phys) :: heatfac - - -! initial permutation seed used for sub-column cloud scheme - integer, parameter :: ipsdsw0 = 1 - -! --- public accessable subprograms - - public rrtmg_sw_init, rrtmg_sw_run, rrtmg_sw_finalize, rswinit - - -! ================= - contains -! ================= - - subroutine rrtmg_sw_init () - end subroutine rrtmg_sw_init - -!> \defgroup module_radsw_main GFS RRTMG Shortwave Module -!! This module includes NCEP's modifications of the RRTMG-SW radiation -!! code from AER. -!! -!! The SW radiation model in the current NOAA Environmental Modeling -!! System (NEMS) was adapted from the RRTM radiation model developed by -!! AER Inc. (\cite clough_et_al_2005; \cite mlawer_et_al_1997). It contains 14 -!! spectral bands spanning a spectral wavenumber range of -!! \f$50000-820 cm^{-1}\f$ (corresponding to a wavelength range -!! \f$0.2-12.2\mu m\f$), each spectral band focuses on a specific set of -!! atmospheric absorbing species as shown in Table 1. To achieve great -!! computation efficiency while at the same time to maintain a high -!! degree of accuracy, the RRTM radiation model employs a corrected-k -!! distribution method (i.e. mapping the highly spectral changing -!! absorption coefficient, k, into a monotonic and smooth varying -!! cumulative probability function, g). In the RRTM-SW, there are 16 -!! unevenly distributed g points for each of the 14 bands for a total -!! of 224 g points. The GCM version of the code (RRTMG-SW) uses a reduced -!! number (various between 2 to 16) of g points for each of the bands -!! that totals to 112 instead of the full set of 224. To get high -!! quality for the scheme, many advanced techniques are used in RRTM -!! such as carefully selecting the band structure to handle various -!! major (key-species) and minor absorbers; deriving a binary parameter -!! for a paired key molecular species in the same domain; and using two -!! pressure regions (dividing level is at about 96mb) for optimal -!! treatment of various species, etc. -!!\tableofcontents -!! Table 1. RRTMG-SW spectral bands and the corresponding absorbing species -!! |Band #| Wavenumber Range | Lower Atm (Key)| Lower Atm (Minor)| Mid/Up Atm (Key)| Mid/Up Atm (Minor)| -!! |------|------------------|----------------|------------------|-----------------|-------------------| -!! | 16 | 2600-3250 |H2O,CH4 | |CH4 | | -!! | 17 | 3250-4000 |H2O,CO2 | |H2O,CO2 | | -!! | 18 | 4000-4650 |H2O,CH4 | |CH4 | | -!! | 19 | 4650-5150 |H2O,CO2 | |CO2 | | -!! | 20 | 5150-6150 |H2O |CH4 |H2O |CH4 | -!! | 21 | 6150-7700 |H2O,CO2 | |H2O,CO2 | | -!! | 22 | 7700-8050 |H2O,O2 | |O2 | | -!! | 23 | 8050-12850 |H2O | |--- | | -!! | 24 | 12850-16000 |H2O,O2 |O3 |O2 |O3 | -!! | 25 | 16000-22650 |H2O |O3 |--- |O3 | -!! | 26 | 22650-29000 |--- | |--- | | -!! | 27 | 29000-38000 |O3 | |O3 | | -!! | 28 | 38000-50000 |O3,O2 | |O3,O2 | | -!! | 29 | 820-2600 |H2O |CO2 |CO2 |H2O | -!!\tableofcontents -!! -!! The RRTM-SW package includes three files: -!! - radsw_param.f, which contains: -!! - module_radsw_parameters: specifies major parameters of the spectral -!! bands and defines the construct structures of derived-type variables -!! for holding the output results. -!! - radsw_datatb.f, which contains: -!! - module_radsw_ref: reference temperature and pressure -!! - module_radsw_cldprtb: cloud property coefficients table -!! - module_radsw_sflux: indexes and coefficients for spectral -!! distribution of solar flux -!! - module_radsw_kgbnn: absorption coefficents for 14 bands, where -!! nn = 16-29 -!! - radsw_main.f, which contains: -!! - rrtmg_sw_run(): the main SW radiation routine -!! - rswinit(): the initialization routine -!! -!!\author Eli J. Mlawer, emlawer@aer.com -!!\author Jennifer S. Delamere, jdelamer@aer.com -!!\author Michael J. Iacono, miacono@aer.com -!!\author Shepard A. Clough -!!\version NCEP SW v5.1 Nov 2012 -RRTMG-SW v3.8 -!! -!! The authors wish to acknowledge the contributions of the -!! following people: Steven J. Taubman, Karen Cady-Pereira, -!! Patrick D. Brown, Ronald E. Farren, Luke Chen, Robert Bergstrom. -!! -!!\copyright 2002-2007, Atmospheric & Environmental Research, Inc. (AER). -!! This software may be used, copied, or redistributed as long as it is -!! not sold and this copyright notice is reproduced on each copy made. -!! This model is provided as is without any express or implied warranties. -!! (http://www.rtweb.aer.com/) -!! -!> \section arg_table_rrtmg_sw_run Argument Table -!! \htmlinclude rrtmg_sw_run.html -!! -!> \section gen_swrad RRTMG Shortwave Radiation Scheme General Algorithm -!> @{ -!----------------------------------- - subroutine rrtmg_sw_run & - & ( plyr,plvl,tlyr,tlvl,qlyr,olyr, & - & gasvmr_co2,gasvmr_n2o,gasvmr_ch4,gasvmr_o2,gasvmr_co, & - & gasvmr_cfc11,gasvmr_cfc12,gasvmr_cfc22,gasvmr_ccl4, & ! --- inputs - & icseed, aeraod, aerssa, aerasy, & - & sfcalb_nir_dir, sfcalb_nir_dif, & - & sfcalb_uvis_dir, sfcalb_uvis_dif, & - & dzlyr,delpin,de_lgth, & - & cosz,solcon,NDAY,idxday, & - & npts, nlay, nlp1, lprnt, & - & cld_cf, lsswr, & - & hswc,topflx,sfcflx,cldtau, & ! --- outputs - & HSW0,HSWB,FLXPRF,FDNCMP, & ! --- optional - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy, errmsg, errflg - & ) - -! ==================== defination of variables ==================== ! -! ! -! input variables: ! -! plyr (npts,nlay) : model layer mean pressure in mb ! -! plvl (npts,nlp1) : model level pressure in mb ! -! tlyr (npts,nlay) : model layer mean temperature in k ! -! tlvl (npts,nlp1) : model level temperature in k (not in use) ! -! qlyr (npts,nlay) : layer specific humidity in gm/gm *see inside ! -! olyr (npts,nlay) : layer ozone concentration in gm/gm ! -! gasvmr(npts,nlay,:): atmospheric constent gases: ! -! (check module_radiation_gases for definition) ! -! gasvmr(:,:,1) - co2 volume mixing ratio ! -! gasvmr(:,:,2) - n2o volume mixing ratio ! -! gasvmr(:,:,3) - ch4 volume mixing ratio ! -! gasvmr(:,:,4) - o2 volume mixing ratio ! -! gasvmr(:,:,5) - co volume mixing ratio (not used) ! -! gasvmr(:,:,6) - cfc11 volume mixing ratio (not used) ! -! gasvmr(:,:,7) - cfc12 volume mixing ratio (not used) ! -! gasvmr(:,:,8) - cfc22 volume mixing ratio (not used) ! -! gasvmr(:,:,9) - ccl4 volume mixing ratio (not used) ! -! clouds(npts,nlay,:): cloud profile ! -! (check module_radiation_clouds for definition) ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer in-cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer in-cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path (g/m**2) ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! clouds(:,:,8) - layer snow flake water path (g/m**2) ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! icseed(npts) : auxiliary special cloud related array ! -! when module variable isubcsw=2, it provides ! -! permutation seed for each column profile that ! -! are used for generating random numbers. ! -! when isubcsw /=2, it will not be used. ! -! aerosols(npts,nlay,nbdsw,:) : aerosol optical properties ! -! (check module_radiation_aerosols for definition) ! -! (:,:,:,1) - optical depth ! -! (:,:,:,2) - single scattering albedo ! -! (:,:,:,3) - asymmetry parameter ! -! sfcalb(npts, : ) : surface albedo in fraction ! -! (check module_radiation_surface for definition) ! -! ( :, 1 ) - near ir direct beam albedo ! -! ( :, 2 ) - near ir diffused albedo ! -! ( :, 3 ) - uv+vis direct beam albedo ! -! ( :, 4 ) - uv+vis diffused albedo ! -! dzlyr(npts,nlay) : layer thickness in km ! -! delpin(npts,nlay): layer pressure thickness (mb) ! -! de_lgth(npts) : clouds decorrelation length (km) ! -! cosz (npts) : cosine of solar zenith angle ! -! solcon : solar constant (w/m**2) ! -! NDAY : num of daytime points ! -! idxday(npts) : index array for daytime points ! -! npts : number of horizontal points ! -! nlay,nlp1 : vertical layer/lavel numbers ! -! lprnt : logical check print flag ! -! ! -! output variables: ! -! hswc (npts,nlay): total sky heating rates (k/sec or k/day) ! -! topflx(npts) : radiation fluxes at toa (w/m**2), components: ! -! (check module_radsw_parameters for definition) ! -! upfxc - total sky upward flux at toa ! -! dnflx - total sky downward flux at toa ! -! upfx0 - clear sky upward flux at toa ! -! sfcflx(npts) : radiation fluxes at sfc (w/m**2), components: ! -! (check module_radsw_parameters for definition) ! -! upfxc - total sky upward flux at sfc ! -! dnfxc - total sky downward flux at sfc ! -! upfx0 - clear sky upward flux at sfc ! -! dnfx0 - clear sky downward flux at sfc ! -! cldtau(npts,nlay): spectral band layer cloud optical depth (~0.55 mu) -! ! -!!optional outputs variables: ! -! hswb(npts,nlay,nbdsw): spectral band total sky heating rates ! -! hsw0 (npts,nlay): clear sky heating rates (k/sec or k/day) ! -! flxprf(npts,nlp1): level radiation fluxes (w/m**2), components: ! -! (check module_radsw_parameters for definition) ! -! dnfxc - total sky downward flux at interface ! -! upfxc - total sky upward flux at interface ! -! dnfx0 - clear sky downward flux at interface ! -! upfx0 - clear sky upward flux at interface ! -! fdncmp(npts) : component surface downward fluxes (w/m**2): ! -! (check module_radsw_parameters for definition) ! -! uvbfc - total sky downward uv-b flux at sfc ! -! uvbf0 - clear sky downward uv-b flux at sfc ! -! nirbm - downward surface nir direct beam flux ! -! nirdf - downward surface nir diffused flux ! -! visbm - downward surface uv+vis direct beam flux ! -! visdf - downward surface uv+vis diffused flux ! -! ! -! external module variables: (in physparam) ! -! iswrgas - control flag for rare gases (ch4,n2o,o2, etc.) ! -! =0: do not include rare gases ! -! >0: include all rare gases ! -! iswcliq - control flag for liq-cloud optical properties ! -! =0: input cloud optical depth, fixed ssa, asy ! -! =1: use hu and stamnes(1993) method for liq cld ! -! =2: use updated coeffs for hu and stamnes scheme ! -! iswcice - control flag for ice-cloud optical properties ! -! *** if iswcliq==0, iswcice is ignored ! -! =1: use ebert and curry (1992) scheme for ice clouds ! -! =2: use streamer v3.0 (2001) method for ice clouds ! -! =3: use fu's method (1996) for ice clouds ! -! iswmode - control flag for 2-stream transfer scheme ! -! =1; delta-eddington (joseph et al., 1976) ! -! =2: pifm (zdunkowski et al., 1980) ! -! =3: discrete ordinates (liou, 1973) ! -! isubcsw - sub-column cloud approximation control flag ! -! =0: no sub-col cld treatment, use grid-mean cld quantities ! -! =1: mcica sub-col, prescribed seeds to get random numbers ! -! =2: mcica sub-col, providing array icseed for random numbers! -! iovrsw - cloud overlapping control flag ! -! =0: random overlapping clouds ! -! =1: maximum/random overlapping clouds ! -! =2: maximum overlap cloud ! -! =3: decorrelation-length overlap clouds ! -! ivflip - control flg for direction of vertical index ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! ! -! module parameters, control variables: ! -! nblow,nbhgh - lower and upper limits of spectral bands ! -! maxgas - maximum number of absorbing gaseous ! -! ngptsw - total number of g-point subintervals ! -! ng## - number of g-points in band (##=16-29) ! -! ngb(ngptsw) - band indices for each g-point ! -! bpade - pade approximation constant (1/0.278) ! -! nspa,nspb(nblow:nbhgh) ! -! - number of lower/upper ref atm's per band ! -! ipsdsw0 - permutation seed for mcica sub-col clds ! -! ! -! major local variables: ! -! pavel (nlay) - layer pressures (mb) ! -! delp (nlay) - layer pressure thickness (mb) ! -! tavel (nlay) - layer temperatures (k) ! -! coldry (nlay) - dry air column amount ! -! (1.e-20*molecules/cm**2) ! -! cldfrc (nlay) - layer cloud fraction (norm by tot cld) ! -! cldfmc (nlay,ngptsw) - layer cloud fraction for g-point ! -! taucw (nlay,nbdsw) - cloud optical depth ! -! ssacw (nlay,nbdsw) - cloud single scattering albedo (weighted) ! -! asycw (nlay,nbdsw) - cloud asymmetry factor (weighted) ! -! tauaer (nlay,nbdsw) - aerosol optical depths ! -! ssaaer (nlay,nbdsw) - aerosol single scattering albedo ! -! asyaer (nlay,nbdsw) - aerosol asymmetry factor ! -! colamt (nlay,maxgas) - column amounts of absorbing gases ! -! 1 to maxgas are for h2o, co2, o3, n2o, ! -! ch4, o2, co, respectively (mol/cm**2) ! -! facij (nlay) - indicator of interpolation factors ! -! =0/1: indicate lower/higher temp & height ! -! selffac(nlay) - scale factor for self-continuum, equals ! -! (w.v. density)/(atm density at 296K,1013 mb) ! -! selffrac(nlay) - factor for temp interpolation of ref ! -! self-continuum data ! -! indself(nlay) - index of the lower two appropriate ref ! -! temp for the self-continuum interpolation ! -! forfac (nlay) - scale factor for w.v. foreign-continuum ! -! forfrac(nlay) - factor for temp interpolation of ref ! -! w.v. foreign-continuum data ! -! indfor (nlay) - index of the lower two appropriate ref ! -! temp for the foreign-continuum interp ! -! laytrop - layer at which switch is made from one ! -! combination of key species to another ! -! jp(nlay),jt(nlay),jt1(nlay) ! -! - lookup table indexes ! -! flxucb(nlp1,nbdsw) - spectral bnd total-sky upward flx (w/m2) ! -! flxdcb(nlp1,nbdsw) - spectral bnd total-sky downward flx (w/m2)! -! flxu0b(nlp1,nbdsw) - spectral bnd clear-sky upward flx (w/m2) ! -! flxd0b(nlp1,nbdsw) - spectral b d clear-sky downward flx (w/m2)! -! ! -! ! -! ===================== end of definitions ==================== ! - -! --- inputs: - integer, intent(in) :: npts, nlay, nlp1, NDAY - - integer, dimension(:), intent(in) :: idxday, icseed - - logical, intent(in) :: lprnt, lsswr - - real (kind=kind_phys), dimension(npts,nlp1), intent(in) :: & - & plvl, tlvl - real (kind=kind_phys), dimension(npts,nlay), intent(in) :: & - & plyr, tlyr, qlyr, olyr, dzlyr, delpin - - real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dir - real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_nir_dif - real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dir - real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dif - - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2 - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_n2o - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc11 - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc12 - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc22 - real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ccl4 - - real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf - real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & - & cld_od, cld_ssa, cld_asy - - real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aeraod - real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aerssa - real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aerasy - - real (kind=kind_phys), intent(in) :: cosz(npts), solcon, & - & de_lgth(npts) - -! --- outputs: - real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: hswc - real (kind=kind_phys), dimension(npts,nlay), intent(inout) :: & - & cldtau - - type (topfsw_type), dimension(npts), intent(inout) :: topflx - type (sfcfsw_type), dimension(npts), intent(inout) :: sfcflx - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -!! --- optional outputs: - real (kind=kind_phys), dimension(npts,nlay,nbdsw), optional, & - & intent(inout) :: hswb - - real (kind=kind_phys), dimension(npts,nlay), optional, & - & intent(inout) :: hsw0 - type (profsw_type), dimension(npts,nlp1), optional, & - & intent(inout) :: flxprf - type (cmpfsw_type), dimension(npts), optional, & - & intent(inout) :: fdncmp - -! --- locals: - real (kind=kind_phys), dimension(nlay,ngptsw) :: cldfmc, & - & taug, taur - real (kind=kind_phys), dimension(nlp1,nbdsw):: fxupc, fxdnc, & - & fxup0, fxdn0 - - real (kind=kind_phys), dimension(nlay,nbdsw) :: & - & tauae, ssaae, asyae, taucw, ssacw, asycw - - real (kind=kind_phys), dimension(ngptsw) :: sfluxzen - - real (kind=kind_phys), dimension(nlay) :: cldfrc, delp, & - & pavel, tavel, coldry, colmol, h2ovmr, o3vmr, temcol, & - & cliqp, reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, & - & cfrac, fac00, fac01, fac10, fac11, forfac, forfrac, & - & selffac, selffrac, rfdelp, dz - - real (kind=kind_phys), dimension(nlp1) :: fnet, flxdc, flxuc, & - & flxd0, flxu0 - - real (kind=kind_phys), dimension(2) :: albbm, albdf, sfbmc, & - & sfbm0, sfdfc, sfdf0 - - real (kind=kind_phys) :: cosz1, sntz1, tem0, tem1, tem2, s0fac, & - & ssolar, zcf0, zcf1, ftoau0, ftoauc, ftoadc, & - & fsfcu0, fsfcuc, fsfcd0, fsfcdc, suvbfc, suvbf0, delgth - -! --- column amount of absorbing gases: -! (:,m) m = 1-h2o, 2-co2, 3-o3, 4-n2o, 5-ch4, 6-o2, 7-co - real (kind=kind_phys) :: colamt(nlay,maxgas) - - integer, dimension(npts) :: ipseed - integer, dimension(nlay) :: indfor, indself, jp, jt, jt1 - - integer :: i, ib, ipt, j1, k, kk, laytrop, mb -! -!===> ... begin here -! - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 -! - if (.not. lsswr) return - if (nday <= 0) return - - lhswb = present ( hswb ) - lhsw0 = present ( hsw0 ) - lflxprf= present ( flxprf ) - lfdncmp= present ( fdncmp ) - -!> -# Compute solar constant adjustment factor (s0fac) according to solcon. -! *** s0, the solar constant at toa in w/m**2, is hard-coded with -! each spectra band, the total flux is about 1368.22 w/m**2. - - s0fac = solcon / s0 - -!> -# Initial output arrays (and optional) as zero. - - hswc(:,:) = f_zero - cldtau(:,:) = f_zero - topflx = topfsw_type ( f_zero, f_zero, f_zero ) - sfcflx = sfcfsw_type ( f_zero, f_zero, f_zero, f_zero ) - -!! --- ... initial optional outputs - if ( lflxprf ) then - flxprf = profsw_type ( f_zero, f_zero, f_zero, f_zero ) - endif - - if ( lfdncmp ) then - fdncmp = cmpfsw_type (f_zero,f_zero,f_zero,f_zero,f_zero,f_zero) - endif - - if ( lhsw0 ) then - hsw0(:,:) = f_zero - endif - - if ( lhswb ) then - hswb(:,:,:) = f_zero - endif - -!! --- check for optional input arguments, depending on cloud method - if (iswcliq > 0) then ! use prognostic cloud method - if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & - & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & - & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & - & .not.present(cld_swp) .or. .not.present(cld_ref_snow) )then - write(errmsg,'(*(a))') & - & 'Logic error: iswcliq>0 requires the following', & - & ' optional arguments to be present:', & - & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & - & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' - errflg = 1 - return - end if - else ! use diagnostic cloud method - if ( .not.present(cld_od) .or. .not.present(cld_ssa) .or. & - & .not.present(cld_asy)) then - write(errmsg,'(*(a))') & - & 'Logic error: iswcliq<=0 requires the following', & - & ' optional arguments to be present:', & - & ' cld_od, cld_ssa, cld_asy' - errflg = 1 - return - end if - endif ! end if_iswcliq - -!> -# Change random number seed value for each radiation invocation -!! (isubcsw =1 or 2). - - if ( isubcsw == 1 ) then ! advance prescribed permutation seed - do i = 1, npts - ipseed(i) = ipsdsw0 + i - enddo - elseif ( isubcsw == 2 ) then ! use input array of permutaion seeds - do i = 1, npts - ipseed(i) = icseed(i) - enddo - endif - - if ( lprnt ) then - write(0,*)' In radsw, isubcsw, ipsdsw0,ipseed =', & - & isubcsw, ipsdsw0, ipseed - endif - -! --- ... loop over each daytime grid point - - lab_do_ipt : do ipt = 1, NDAY - - j1 = idxday(ipt) - - cosz1 = cosz(j1) - sntz1 = f_one / cosz(j1) - ssolar = s0fac * cosz(j1) - if (iovrsw == 3) delgth = de_lgth(j1) ! clouds decorr-length - -!> -# Prepare surface albedo: bm,df - dir,dif; 1,2 - nir,uvv. - albbm(1) = sfcalb_nir_dir(j1) - albdf(1) = sfcalb_nir_dif(j1) - albbm(2) = sfcalb_uvis_dir(j1) - albdf(2) = sfcalb_uvis_dif(j1) - -!> -# Prepare atmospheric profile for use in rrtm. -! the vertical index of internal array is from surface to top - - if (ivflip == 0) then ! input from toa to sfc - - tem1 = 100.0 * con_g - tem2 = 1.0e-20 * 1.0e3 * con_avgd - - do k = 1, nlay - kk = nlp1 - k - pavel(k) = plyr(j1,kk) - tavel(k) = tlyr(j1,kk) - delp (k) = delpin(j1,kk) - dz (k) = dzlyr (j1,kk) -!> -# Set absorber and gas column amount, convert from volume mixing -!! ratio to molec/cm2 based on coldry (scaled to 1.0e-20) -!! - colamt(nlay,maxgas):column amounts of absorbing gases 1 to -!! maxgas are for h2o,co2,o3,n2o,ch4,o2,co, respectively -!! (\f$ mol/cm^2 \f$) - -!test use -! h2ovmr(k)= max(f_zero,qlyr(j1,kk)*amdw) ! input mass mixing ratio -! h2ovmr(k)= max(f_zero,qlyr(j1,kk)) ! input vol mixing ratio -! o3vmr (k)= max(f_zero,olyr(j1,kk)) ! input vol mixing ratio -!ncep model use - h2ovmr(k)= max(f_zero,qlyr(j1,kk)*amdw/(f_one-qlyr(j1,kk))) ! input specific humidity - o3vmr (k)= max(f_zero,olyr(j1,kk)*amdo3) ! input mass mixing ratio - - tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw - coldry(k) = tem2 * delp(k) / (tem1*tem0*(f_one + h2ovmr(k))) - temcol(k) = 1.0e-12 * coldry(k) - - colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(j1,kk)) ! co2 - colamt(k,3) = max(f_zero, coldry(k)*o3vmr(k)) ! o3 - colmol(k) = coldry(k) + colamt(k,1) - enddo - -! --- ... set up gas column amount, convert from volume mixing ratio -! to molec/cm2 based on coldry (scaled to 1.0e-20) - - if (iswrgas > 0) then - do k = 1, nlay - kk = nlp1 - k - colamt(k,4) = max(temcol(k), coldry(k)*gasvmr_n2o(j1,kk)) ! n2o - colamt(k,5) = max(temcol(k), coldry(k)*gasvmr_ch4(j1,kk)) ! ch4 - colamt(k,6) = max(temcol(k), coldry(k)*gasvmr_o2(j1,kk)) ! o2 -! colamt(k,7) = max(temcol(k), coldry(k)*gasvmr(j1,kk,5)) ! co - notused - enddo - else - do k = 1, nlay - colamt(k,4) = temcol(k) ! n2o - colamt(k,5) = temcol(k) ! ch4 - colamt(k,6) = temcol(k) ! o2 -! colamt(k,7) = temcol(k) ! co - notused - enddo - endif - -!> -# Read aerosol optical properties from 'aerosols'. - - do k = 1, nlay - kk = nlp1 - k - do ib = 1, nbdsw - tauae(k,ib) = aeraod(j1,kk,ib) - ssaae(k,ib) = aerssa(j1,kk,ib) - asyae(k,ib) = aerasy(j1,kk,ib) - enddo - enddo - -!> -# Read cloud optical properties from 'clouds'. - if (iswcliq > 0) then ! use prognostic cloud method - do k = 1, nlay - kk = nlp1 - k - cfrac(k) = cld_cf(j1,kk) ! cloud fraction - cliqp(k) = cld_lwp(j1,kk) ! cloud liq path - reliq(k) = cld_ref_liq(j1,kk) ! liq partical effctive radius - cicep(k) = cld_iwp(j1,kk) ! cloud ice path - reice(k) = cld_ref_ice(j1,kk) ! ice partical effctive radius - cdat1(k) = cld_rwp(j1,kk) ! cloud rain drop path - cdat2(k) = cld_ref_rain(j1,kk) ! rain partical effctive radius - cdat3(k) = cld_swp(j1,kk) ! cloud snow path - cdat4(k) = cld_ref_snow(j1,kk) ! snow partical effctive radius - enddo - else ! use diagnostic cloud method - do k = 1, nlay - kk = nlp1 - k - cfrac(k) = cld_cf(j1,kk) ! cloud fraction - cdat1(k) = cld_od(j1,kk) ! cloud optical depth - cdat2(k) = cld_ssa(j1,kk) ! cloud single scattering albedo - cdat3(k) = cld_asy(j1,kk) ! cloud asymmetry factor - enddo - endif ! end if_iswcliq - - else ! input from sfc to toa - - tem1 = 100.0 * con_g - tem2 = 1.0e-20 * 1.0e3 * con_avgd - - do k = 1, nlay - pavel(k) = plyr(j1,k) - tavel(k) = tlyr(j1,k) - delp (k) = delpin(j1,k) - dz (k) = dzlyr (j1,k) - -! --- ... set absorber amount -!test use -! h2ovmr(k)= max(f_zero,qlyr(j1,k)*amdw) ! input mass mixing ratio -! h2ovmr(k)= max(f_zero,qlyr(j1,k)) ! input vol mixing ratio -! o3vmr (k)= max(f_zero,olyr(j1,k)) ! input vol mixing ratio -!ncep model use - h2ovmr(k)= max(f_zero,qlyr(j1,k)*amdw/(f_one-qlyr(j1,k))) ! input specific humidity - o3vmr (k)= max(f_zero,olyr(j1,k)*amdo3) ! input mass mixing ratio - - tem0 = (f_one - h2ovmr(k))*con_amd + h2ovmr(k)*con_amw - coldry(k) = tem2 * delp(k) / (tem1*tem0*(f_one + h2ovmr(k))) - temcol(k) = 1.0e-12 * coldry(k) - - colamt(k,1) = max(f_zero, coldry(k)*h2ovmr(k)) ! h2o - colamt(k,2) = max(temcol(k), coldry(k)*gasvmr_co2(j1,k)) ! co2 - colamt(k,3) = max(f_zero, coldry(k)*o3vmr(k)) ! o3 - colmol(k) = coldry(k) + colamt(k,1) - enddo - - - if (lprnt) then - if (ipt == 1) then - write(0,*)' pavel=',pavel - write(0,*)' tavel=',tavel - write(0,*)' delp=',delp - write(0,*)' h2ovmr=',h2ovmr*1000 - write(0,*)' o3vmr=',o3vmr*1000000 - endif - endif - -! --- ... set up gas column amount, convert from volume mixing ratio -! to molec/cm2 based on coldry (scaled to 1.0e-20) - - if (iswrgas > 0) then - do k = 1, nlay - colamt(k,4) = max(temcol(k), coldry(k)*gasvmr_n2o(j1,k)) ! n2o - colamt(k,5) = max(temcol(k), coldry(k)*gasvmr_ch4(j1,k)) ! ch4 - colamt(k,6) = max(temcol(k), coldry(k)*gasvmr_o2(j1,k)) ! o2 -! colamt(k,7) = max(temcol(k), coldry(k)*gasvmr(j1,k,5)) ! co - notused - enddo - else - do k = 1, nlay - colamt(k,4) = temcol(k) ! n2o - colamt(k,5) = temcol(k) ! ch4 - colamt(k,6) = temcol(k) ! o2 -! colamt(k,7) = temcol(k) ! co - notused - enddo - endif - -! --- ... set aerosol optical properties - - do ib = 1, nbdsw - do k = 1, nlay - tauae(k,ib) = aeraod(j1,k,ib) - ssaae(k,ib) = aerssa(j1,k,ib) - asyae(k,ib) = aerasy(j1,k,ib) - enddo - enddo - - if (iswcliq > 0) then ! use prognostic cloud method - do k = 1, nlay - cfrac(k) = cld_cf(j1,k) ! cloud fraction - cliqp(k) = cld_lwp(j1,k) ! cloud liq path - reliq(k) = cld_ref_liq(j1,k) ! liq partical effctive radius - cicep(k) = cld_iwp(j1,k) ! cloud ice path - reice(k) = cld_ref_ice(j1,k) ! ice partical effctive radius - cdat1(k) = cld_rwp(j1,k) ! cloud rain drop path - cdat2(k) = cld_ref_rain(j1,k) ! rain partical effctive radius - cdat3(k) = cld_swp(j1,k) ! cloud snow path - cdat4(k) = cld_ref_snow(j1,k) ! snow partical effctive radius - enddo - else ! use diagnostic cloud method - do k = 1, nlay - cfrac(k) = cld_cf(j1,k) ! cloud fraction - cdat1(k) = cld_od(j1,k) ! cloud optical depth - cdat2(k) = cld_ssa(j1,k) ! cloud single scattering albedo - cdat3(k) = cld_asy(j1,k) ! cloud asymmetry factor - enddo - endif ! end if_iswcliq - - endif ! if_ivflip - -!> -# Compute fractions of clear sky view: -!! - random overlapping -!! - max/ran overlapping -!! - maximum overlapping - - zcf0 = f_one - zcf1 = f_one - if (iovrsw == 0) then ! random overlapping - do k = 1, nlay - zcf0 = zcf0 * (f_one - cfrac(k)) - enddo - else if (iovrsw == 1) then ! max/ran overlapping - do k = 1, nlay - if (cfrac(k) > ftiny) then ! cloudy layer - zcf1 = min ( zcf1, f_one-cfrac(k) ) - elseif (zcf1 < f_one) then ! clear layer - zcf0 = zcf0 * zcf1 - zcf1 = f_one - endif - enddo - zcf0 = zcf0 * zcf1 - else if (iovrsw >= 2) then - do k = 1, nlay - zcf0 = min ( zcf0, f_one-cfrac(k) ) ! used only as clear/cloudy indicator - enddo - endif - - if (zcf0 <= ftiny) zcf0 = f_zero - if (zcf0 > oneminus) zcf0 = f_one - zcf1 = f_one - zcf0 - -!> -# For cloudy sky column, call cldprop() to compute the cloud -!! optical properties for each cloudy layer. - - if (zcf1 > f_zero) then ! cloudy sky column - - call cldprop & -! --- inputs: - & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & - & zcf1, nlay, ipseed(j1), dz, delgth, & -! --- outputs: - & taucw, ssacw, asycw, cldfrc, cldfmc & - & ) - -! --- ... save computed layer cloud optical depth for output -! rrtm band 10 is approx to the 0.55 mu spectrum - - if (ivflip == 0) then ! input from toa to sfc - do k = 1, nlay - kk = nlp1 - k - cldtau(j1,kk) = taucw(k,10) - enddo - else ! input from sfc to toa - do k = 1, nlay - cldtau(j1,k) = taucw(k,10) - enddo - endif ! end if_ivflip_block - - else ! clear sky column - cldfrc(:) = f_zero - cldfmc(:,:)= f_zero - do i = 1, nbdsw - do k = 1, nlay - taucw(k,i) = f_zero - ssacw(k,i) = f_zero - asycw(k,i) = f_zero - enddo - enddo - endif ! end if_zcf1_block - -!> -# Call setcoef() to compute various coefficients needed in -!! radiative transfer calculations. - call setcoef & -! --- inputs: - & ( pavel,tavel,h2ovmr, nlay,nlp1, & -! --- outputs: - & laytrop,jp,jt,jt1,fac00,fac01,fac10,fac11, & - & selffac,selffrac,indself,forfac,forfrac,indfor & - & ) - -!> -# Call taumol() to calculate optical depths for gaseous absorption -!! and rayleigh scattering - call taumol & -! --- inputs: - & ( colamt,colmol,fac00,fac01,fac10,fac11,jp,jt,jt1,laytrop, & - & forfac,forfrac,indfor,selffac,selffrac,indself, NLAY, & -! --- outputs: - & sfluxzen, taug, taur & - & ) - -!> -# Call the 2-stream radiation transfer model: -!! - if physparam::isubcsw .le.0, using standard cloud scheme, -!! call spcvrtc(). -!! - if physparam::isubcsw .gt.0, using mcica cloud scheme, -!! call spcvrtm(). - - if ( isubcsw <= 0 ) then ! use standard cloud scheme - - call spcvrtc & -! --- inputs: - & ( ssolar,cosz1,sntz1,albbm,albdf,sfluxzen,cldfrc, & - & zcf1,zcf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & - & nlay, nlp1, & -! --- outputs: - & fxupc,fxdnc,fxup0,fxdn0, & - & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & - & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & - & ) - - else ! use mcica cloud scheme - - call spcvrtm & -! --- inputs: - & ( ssolar,cosz1,sntz1,albbm,albdf,sfluxzen,cldfmc, & - & zcf1,zcf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & - & nlay, nlp1, & -! --- outputs: - & fxupc,fxdnc,fxup0,fxdn0, & - & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & - & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & - & ) - - endif - -!> -# Save outputs. -! --- ... sum up total spectral fluxes for total-sky - - do k = 1, nlp1 - flxuc(k) = f_zero - flxdc(k) = f_zero - - do ib = 1, nbdsw - flxuc(k) = flxuc(k) + fxupc(k,ib) - flxdc(k) = flxdc(k) + fxdnc(k,ib) - enddo - enddo - -!! --- ... optional clear sky fluxes - - if ( lhsw0 .or. lflxprf ) then - do k = 1, nlp1 - flxu0(k) = f_zero - flxd0(k) = f_zero - - do ib = 1, nbdsw - flxu0(k) = flxu0(k) + fxup0(k,ib) - flxd0(k) = flxd0(k) + fxdn0(k,ib) - enddo - enddo - endif - -! --- ... prepare for final outputs - - do k = 1, nlay - rfdelp(k) = heatfac / delp(k) - enddo - - if ( lfdncmp ) then -!! --- ... optional uv-b surface downward flux - fdncmp(j1)%uvbf0 = suvbf0 - fdncmp(j1)%uvbfc = suvbfc - -!! --- ... optional beam and diffuse sfc fluxes - fdncmp(j1)%nirbm = sfbmc(1) - fdncmp(j1)%nirdf = sfdfc(1) - fdncmp(j1)%visbm = sfbmc(2) - fdncmp(j1)%visdf = sfdfc(2) - endif ! end if_lfdncmp - -! --- ... toa and sfc fluxes - - topflx(j1)%upfxc = ftoauc - topflx(j1)%dnfxc = ftoadc - topflx(j1)%upfx0 = ftoau0 - - sfcflx(j1)%upfxc = fsfcuc - sfcflx(j1)%dnfxc = fsfcdc - sfcflx(j1)%upfx0 = fsfcu0 - sfcflx(j1)%dnfx0 = fsfcd0 - - if (ivflip == 0) then ! output from toa to sfc - -! --- ... compute heating rates - - fnet(1) = flxdc(1) - flxuc(1) - - do k = 2, nlp1 - kk = nlp1 - k + 1 - fnet(k) = flxdc(k) - flxuc(k) - hswc(j1,kk) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) - enddo - -!! --- ... optional flux profiles - - if ( lflxprf ) then - do k = 1, nlp1 - kk = nlp1 - k + 1 - flxprf(j1,kk)%upfxc = flxuc(k) - flxprf(j1,kk)%dnfxc = flxdc(k) - flxprf(j1,kk)%upfx0 = flxu0(k) - flxprf(j1,kk)%dnfx0 = flxd0(k) - enddo - endif - -!! --- ... optional clear sky heating rates - - if ( lhsw0 ) then - fnet(1) = flxd0(1) - flxu0(1) - - do k = 2, nlp1 - kk = nlp1 - k + 1 - fnet(k) = flxd0(k) - flxu0(k) - hsw0(j1,kk) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) - enddo - endif - -!! --- ... optional spectral band heating rates - - if ( lhswb ) then - do mb = 1, nbdsw - fnet(1) = fxdnc(1,mb) - fxupc(1,mb) - - do k = 2, nlp1 - kk = nlp1 - k + 1 - fnet(k) = fxdnc(k,mb) - fxupc(k,mb) - hswb(j1,kk,mb) = (fnet(k) - fnet(k-1)) * rfdelp(k-1) - enddo - enddo - endif - - else ! output from sfc to toa - -! --- ... compute heating rates - - fnet(1) = flxdc(1) - flxuc(1) - - do k = 2, nlp1 - fnet(k) = flxdc(k) - flxuc(k) - hswc(j1,k-1) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) - enddo - -!! --- ... optional flux profiles - - if ( lflxprf ) then - do k = 1, nlp1 - flxprf(j1,k)%upfxc = flxuc(k) - flxprf(j1,k)%dnfxc = flxdc(k) - flxprf(j1,k)%upfx0 = flxu0(k) - flxprf(j1,k)%dnfx0 = flxd0(k) - enddo - endif - -!! --- ... optional clear sky heating rates - - if ( lhsw0 ) then - fnet(1) = flxd0(1) - flxu0(1) - - do k = 2, nlp1 - fnet(k) = flxd0(k) - flxu0(k) - hsw0(j1,k-1) = (fnet(k)-fnet(k-1)) * rfdelp(k-1) - enddo - endif - -!! --- ... optional spectral band heating rates - - if ( lhswb ) then - do mb = 1, nbdsw - fnet(1) = fxdnc(1,mb) - fxupc(1,mb) - - do k = 1, nlay - fnet(k+1) = fxdnc(k+1,mb) - fxupc(k+1,mb) - hswb(j1,k,mb) = (fnet(k+1) - fnet(k)) * rfdelp(k) - enddo - enddo - endif - - endif ! if_ivflip - - enddo lab_do_ipt - - return -!................................... - end subroutine rrtmg_sw_run -!----------------------------------- -!> @} - - subroutine rrtmg_sw_finalize () - end subroutine rrtmg_sw_finalize - - -!>\ingroup module_radsw_main -!> This subroutine initializes non-varying module variables, conversion -!! factors, and look-up tables. -!!\param me print control for parallel process -!>\section rswinit_gen rswinit General Algorithm -!! @{ -!----------------------------------- - subroutine rswinit & - & ( me ) ! --- inputs: -! --- outputs: (none) - -! =================== program usage description =================== ! -! ! -! purpose: initialize non-varying module variables, conversion factors,! -! and look-up tables. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: ! -! me - print control for parallel process ! -! ! -! outputs: (none) ! -! ! -! external module variables: (in physparam) ! -! iswrate - heating rate unit selections ! -! =1: output in k/day ! -! =2: output in k/second ! -! iswrgas - control flag for rare gases (ch4,n2o,o2, etc.) ! -! =0: do not include rare gases ! -! >0: include all rare gases ! -! iswcliq - liquid cloud optical properties contrl flag ! -! =0: input cloud opt depth from diagnostic scheme ! -! >0: input cwp,rew, and other cloud content parameters ! -! isubcsw - sub-column cloud approximation control flag ! -! =0: no sub-col cld treatment, use grid-mean cld quantities ! -! =1: mcica sub-col, prescribed seeds to get random numbers ! -! =2: mcica sub-col, providing array icseed for random numbers! -! icldflg - cloud scheme control flag ! -! =0: diagnostic scheme gives cloud tau, omiga, and g. ! -! =1: prognostic scheme gives cloud liq/ice path, etc. ! -! iovrsw - clouds vertical overlapping control flag ! -! =0: random overlapping clouds ! -! =1: maximum/random overlapping clouds ! -! =2: maximum overlap cloud ! -! =3: decorrelation-length overlap clouds ! -! iswmode - control flag for 2-stream transfer scheme ! -! =1; delta-eddington (joseph et al., 1976) ! -! =2: pifm (zdunkowski et al., 1980) ! -! =3: discrete ordinates (liou, 1973) ! -! ! -! ******************************************************************* ! -! ! -! definitions: ! -! arrays for 10000-point look-up tables: ! -! tau_tbl clear-sky optical depth ! -! exp_tbl exponential lookup table for transmittance ! -! ! -! ******************************************************************* ! -! ! -! ====================== end of description block ================= ! - -! --- inputs: - integer, intent(in) :: me - -! --- outputs: none - -! --- locals: - real (kind=kind_phys), parameter :: expeps = 1.e-20 - - integer :: i - - real (kind=kind_phys) :: tfn, tau - -! -!===> ... begin here -! - if ( iovrsw<0 .or. iovrsw>3 ) then - print *,' *** Error in specification of cloud overlap flag', & - & ' IOVRSW=',iovrsw,' in RSWINIT !!' - stop - endif - - if (me == 0) then - print *,' - Using AER Shortwave Radiation, Version: ',VTAGSW - - if (iswmode == 1) then - print *,' --- Delta-eddington 2-stream transfer scheme' - else if (iswmode == 2) then - print *,' --- PIFM 2-stream transfer scheme' - else if (iswmode == 3) then - print *,' --- Discrete ordinates 2-stream transfer scheme' - endif - - if (iswrgas <= 0) then - print *,' --- Rare gases absorption is NOT included in SW' - else - print *,' --- Include rare gases N2O, CH4, O2, absorptions',& - & ' in SW' - endif - - if ( isubcsw == 0 ) then - print *,' --- Using standard grid average clouds, no ', & - & 'sub-column clouds approximation applied' - elseif ( isubcsw == 1 ) then - print *,' --- Using MCICA sub-colum clouds approximation ', & - & 'with a prescribed sequence of permutation seeds' - elseif ( isubcsw == 2 ) then - print *,' --- Using MCICA sub-colum clouds approximation ', & - & 'with provided input array of permutation seeds' - else - print *,' *** Error in specification of sub-column cloud ', & - & ' control flag isubcsw =',isubcsw,' !!' - stop - endif - endif - -!> -# Check cloud flags for consistency. - - if ((icldflg == 0 .and. iswcliq /= 0) .or. & - & (icldflg == 1 .and. iswcliq == 0)) then - print *,' *** Model cloud scheme inconsistent with SW', & - & ' radiation cloud radiative property setup !!' - stop - endif - - if ( isubcsw==0 .and. iovrsw>2 ) then - if (me == 0) then - print *,' *** IOVRSW=',iovrsw,' is not available for', & - & ' ISUBCSW=0 setting!!' - print *,' The program will use maximum/random overlap', & - & ' instead.' - endif - - iovrsw = 1 - endif - -!> -# Setup constant factors for heating rate -!! the 1.0e-2 is to convert pressure from mb to \f$N/m^2\f$ . - - if (iswrate == 1) then -! heatfac = 8.4391 -! heatfac = con_g * 86400. * 1.0e-2 / con_cp ! (in k/day) - heatfac = con_g * 864.0 / con_cp ! (in k/day) - else - heatfac = con_g * 1.0e-2 / con_cp ! (in k/second) - endif - -!> -# Define exponential lookup tables for transmittance. -! tau is computed as a function of the \a tau transition function, and -! transmittance is calculated as a function of tau. all tables -! are computed at intervals of 0.0001. the inverse of the -! constant used in the Pade approximation to the tau transition -! function is set to bpade. - - exp_tbl(0) = 1.0 - exp_tbl(NTBMX) = expeps - - do i = 1, NTBMX-1 - tfn = float(i) / float(NTBMX-i) - tau = bpade * tfn - exp_tbl(i) = exp( -tau ) - enddo - - return -!................................... - end subroutine rswinit -!! @} -!----------------------------------- - -!>\ingroup module_radsw_main -!> This subroutine computes the cloud optical properties for each -!! cloudy layer and g-point interval. -!!\param cfrac layer cloud fraction -!!\n for physparam::iswcliq > 0 (prognostic cloud scheme) - - - -!!\param cliqp layer in-cloud liq water path (\f$g/m^2\f$) -!!\param reliq mean eff radius for liq cloud (micron) -!!\param cicep layer in-cloud ice water path (\f$g/m^2\f$) -!!\param reice mean eff radius for ice cloud (micron) -!!\param cdat1 layer rain drop water path (\f$g/m^2\f$) -!!\param cdat2 effective radius for rain drop (micron) -!!\param cdat3 layer snow flake water path(\f$g/m^2\f$) -!!\param cdat4 mean eff radius for snow flake(micron) -!!\n for physparam::iswcliq = 0 (diagnostic cloud scheme) - - - -!!\param cliqp not used -!!\param cicep not used -!!\param reliq not used -!!\param reice not used -!!\param cdat1 layer cloud optical depth -!!\param cdat2 layer cloud single scattering albedo -!!\param cdat3 layer cloud asymmetry factor -!!\param cdat4 optional use -!!\param cf1 effective total cloud cover at surface -!!\param nlay vertical layer number -!!\param ipseed permutation seed for generating random numbers -!! (isubcsw>0) -!!\param dz layer thickness (km) -!!\param delgth layer cloud decorrelation length (km) -!!\param taucw cloud optical depth, w/o delta scaled -!!\param ssacw weighted cloud single scattering albedo -!! (ssa = ssacw / taucw) -!!\param asycw weighted cloud asymmetry factor -!! (asy = asycw / ssacw) -!!\param cldfrc cloud fraction of grid mean value -!!\param cldfmc cloud fraction for each sub-column -!!\section General_cldprop cldprop General Algorithm -!> @{ -!----------------------------------- - subroutine cldprop & - & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & cf1, nlay, ipseed, dz, delgth, iswcliq, & - & taucw, ssacw, asycw, cldfrc, cldfmc & ! --- output - & ) - -! =================== program usage description =================== ! -! ! -! Purpose: Compute the cloud optical properties for each cloudy layer ! -! and g-point interval. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: size ! -! cfrac - real, layer cloud fraction nlay ! -! ..... for iswcliq > 0 (prognostic cloud scheme) - - - ! -! cliqp - real, layer in-cloud liq water path (g/m**2) nlay ! -! reliq - real, mean eff radius for liq cloud (micron) nlay ! -! cicep - real, layer in-cloud ice water path (g/m**2) nlay ! -! reice - real, mean eff radius for ice cloud (micron) nlay ! -! cdat1 - real, layer rain drop water path (g/m**2) nlay ! -! cdat2 - real, effective radius for rain drop (micron) nlay ! -! cdat3 - real, layer snow flake water path(g/m**2) nlay ! -! cdat4 - real, mean eff radius for snow flake(micron) nlay ! -! ..... for iswcliq = 0 (diagnostic cloud scheme) - - - ! -! cdat1 - real, layer cloud optical depth nlay ! -! cdat2 - real, layer cloud single scattering albedo nlay ! -! cdat3 - real, layer cloud asymmetry factor nlay ! -! cdat4 - real, optional use nlay ! -! cliqp - real, not used nlay ! -! cicep - real, not used nlay ! -! reliq - real, not used nlay ! -! reice - real, not used nlay ! -! ! -! cf1 - real, effective total cloud cover at surface 1 ! -! nlay - integer, vertical layer number 1 ! -! ipseed- permutation seed for generating random numbers (isubcsw>0) ! -! dz - real, layer thickness (km) nlay ! -! delgth- real, layer cloud decorrelation length (km) 1 ! -! ! -! outputs: ! -! taucw - real, cloud optical depth, w/o delta scaled nlay*nbdsw ! -! ssacw - real, weighted cloud single scattering albedo nlay*nbdsw ! -! (ssa = ssacw / taucw) ! -! asycw - real, weighted cloud asymmetry factor nlay*nbdsw ! -! (asy = asycw / ssacw) ! -! cldfrc - real, cloud fraction of grid mean value nlay ! -! cldfmc - real, cloud fraction for each sub-column nlay*ngptsw! -! ! -! ! -! explanation of the method for each value of iswcliq, and iswcice. ! -! set up in module "physparam" ! -! ! -! iswcliq=0 : input cloud optical property (tau, ssa, asy). ! -! (used for diagnostic cloud method) ! -! iswcliq>0 : input cloud liq/ice path and effective radius, also ! -! require the user of 'iswcice' to specify the method ! -! used to compute aborption due to water/ice parts. ! -! ................................................................... ! -! ! -! iswcliq=1 : liquid water cloud optical properties are computed ! -! as in hu and stamnes (1993), j. clim., 6, 728-742. ! -! iswcliq=2 : updated coeffs for hu and stamnes (1993) by aer ! -! w v3.9-v4.0. ! -! ! -! iswcice used only when iswcliq > 0 ! -! the cloud ice path (g/m2) and ice effective radius ! -! (microns) are inputs. ! -! iswcice=1 : ice cloud optical properties are computed as in ! -! ebert and curry (1992), jgr, 97, 3831-3836. ! -! iswcice=2 : ice cloud optical properties are computed as in ! -! streamer v3.0 (2001), key, streamer user's guide, ! -! cooperative institude for meteorological studies,95pp! -! iswcice=3 : ice cloud optical properties are computed as in ! -! fu (1996), j. clim., 9. ! -! ! -! other cloud control module variables: ! -! isubcsw =0: standard cloud scheme, no sub-col cloud approximation ! -! >0: mcica sub-col cloud scheme using ipseed as permutation! -! seed for generating rundom numbers ! -! ! -! ====================== end of description block ================= ! -! - use module_radsw_cldprtb - -! --- inputs: - integer, intent(in) :: nlay, ipseed, iswcliq - real (kind=kind_phys), intent(in) :: cf1, delgth - - real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & - & reliq, cicep, reice, cdat1, cdat2, cdat3, cdat4, cfrac, dz - -! --- outputs: - real (kind=kind_phys), dimension(nlay,ngptsw), intent(out) :: & - & cldfmc - real (kind=kind_phys), dimension(nlay,nbdsw), intent(out) :: & - & taucw, ssacw, asycw - real (kind=kind_phys), dimension(nlay), intent(out) :: cldfrc - -! --- locals: - real (kind=kind_phys), dimension(nblow:nbhgh) :: tauliq, tauice, & - & ssaliq, ssaice, ssaran, ssasnw, asyliq, asyice, & - & asyran, asysnw - real (kind=kind_phys), dimension(nlay) :: cldf - - real (kind=kind_phys) :: dgeice, factor, fint, tauran, tausnw, & - & cldliq, refliq, cldice, refice, cldran, cldsnw, refsnw, & - & extcoliq, ssacoliq, asycoliq, extcoice, ssacoice, asycoice,& - & dgesnw - - logical :: lcloudy(nlay,ngptsw) - integer :: ia, ib, ig, jb, k, index - -! -!===> ... begin here -! - do ib = 1, nbdsw - do k = 1, nlay - taucw (k,ib) = f_zero - ssacw (k,ib) = f_one - asycw (k,ib) = f_zero - enddo - enddo - -!> -# Compute cloud radiative properties for a cloudy column. - - lab_if_iswcliq : if (iswcliq > 0) then - - lab_do_k : do k = 1, nlay - lab_if_cld : if (cfrac(k) > ftiny) then - -!> - Compute optical properties for rain and snow. -!!\n For rain: tauran/ssaran/asyran -!!\n For snow: tausnw/ssasnw/asysnw -!> - Calculation of absorption coefficients due to water clouds -!!\n For water clouds: tauliq/ssaliq/asyliq -!> - Calculation of absorption coefficients due to ice clouds -!!\n For ice clouds: tauice/ssaice/asyice -!> - For Prognostic cloud scheme: sum up the cloud optical property: -!!\n \f$ taucw=tauliq+tauice+tauran+tausnw \f$ -!!\n \f$ ssacw=ssaliq+ssaice+ssaran+ssasnw \f$ -!!\n \f$ asycw=asyliq+asyice+asyran+asysnw \f$ - - cldran = cdat1(k) -! refran = cdat2(k) - cldsnw = cdat3(k) - refsnw = cdat4(k) - dgesnw = 1.0315 * refsnw ! for fu's snow formula - - tauran = cldran * a0r - -!> - If use fu's formula it needs to be normalized by snow/ice density. -!! not use snow density = 0.1 g/cm**3 = 0.1 g/(mu * m**2) -!!\n use ice density = 0.9167 g/cm**3 = 0.9167 g/(mu * m**2) -!!\n 1/0.9167 = 1.09087 -!!\n factor 1.5396=8/(3*sqrt(3)) converts reff to generalized ice particle size -!! use newer factor value 1.0315 - if (cldsnw>f_zero .and. refsnw>10.0_kind_phys) then -! tausnw = cldsnw * (a0s + a1s/refsnw) - tausnw = cldsnw*1.09087*(a0s + a1s/dgesnw) ! fu's formula - else - tausnw = f_zero - endif - - do ib = nblow, nbhgh - ssaran(ib) = tauran * (f_one - b0r(ib)) - ssasnw(ib) = tausnw * (f_one - (b0s(ib)+b1s(ib)*dgesnw)) - asyran(ib) = ssaran(ib) * c0r(ib) - asysnw(ib) = ssasnw(ib) * c0s(ib) - enddo - - cldliq = cliqp(k) - cldice = cicep(k) - refliq = reliq(k) - refice = reice(k) - -!> - Calculation of absorption coefficients due to water clouds. - - if ( cldliq <= f_zero ) then - do ib = nblow, nbhgh - tauliq(ib) = f_zero - ssaliq(ib) = f_zero - asyliq(ib) = f_zero - enddo - else - factor = refliq - 1.5 - index = max( 1, min( 57, int( factor ) )) - fint = factor - float(index) - - if ( iswcliq == 1 ) then - do ib = nblow, nbhgh - extcoliq = max(f_zero, extliq1(index,ib) & - & + fint*(extliq1(index+1,ib)-extliq1(index,ib)) ) - ssacoliq = max(f_zero, min(f_one, ssaliq1(index,ib) & - & + fint*(ssaliq1(index+1,ib)-ssaliq1(index,ib)) )) - - asycoliq = max(f_zero, min(f_one, asyliq1(index,ib) & - & + fint*(asyliq1(index+1,ib)-asyliq1(index,ib)) )) -! forcoliq = asycoliq * asycoliq - - tauliq(ib) = cldliq * extcoliq - ssaliq(ib) = tauliq(ib) * ssacoliq - asyliq(ib) = ssaliq(ib) * asycoliq - enddo - elseif ( iswcliq == 2 ) then ! use updated coeffs - do ib = nblow, nbhgh - extcoliq = max(f_zero, extliq2(index,ib) & - & + fint*(extliq2(index+1,ib)-extliq2(index,ib)) ) - ssacoliq = max(f_zero, min(f_one, ssaliq2(index,ib) & - & + fint*(ssaliq2(index+1,ib)-ssaliq2(index,ib)) )) - - asycoliq = max(f_zero, min(f_one, asyliq2(index,ib) & - & + fint*(asyliq2(index+1,ib)-asyliq2(index,ib)) )) -! forcoliq = asycoliq * asycoliq - - tauliq(ib) = cldliq * extcoliq - ssaliq(ib) = tauliq(ib) * ssacoliq - asyliq(ib) = ssaliq(ib) * asycoliq - enddo - endif ! end if_iswcliq_block - endif ! end if_cldliq_block - -!> - Calculation of absorption coefficients due to ice clouds. - - if ( cldice <= f_zero ) then - do ib = nblow, nbhgh - tauice(ib) = f_zero - ssaice(ib) = f_zero - asyice(ib) = f_zero - enddo - else - -!> - ebert and curry approach for all particle sizes though somewhat -!! unjustified for large ice particles. - - if ( iswcice == 1 ) then - refice = min(130.0_kind_phys,max(13.0_kind_phys,refice)) - - do ib = nblow, nbhgh - ia = idxebc(ib) ! eb_&_c band index for ice cloud coeff - - extcoice = max(f_zero, abari(ia)+bbari(ia)/refice ) - ssacoice = max(f_zero, min(f_one, & - & f_one-cbari(ia)-dbari(ia)*refice )) - asycoice = max(f_zero, min(f_one, & - & ebari(ia)+fbari(ia)*refice )) -! forcoice = asycoice * asycoice - - tauice(ib) = cldice * extcoice - ssaice(ib) = tauice(ib) * ssacoice - asyice(ib) = ssaice(ib) * asycoice - enddo - -!> - streamer approach for ice effective radius between 5.0 and 131.0 microns. - - elseif ( iswcice == 2 ) then - refice = min(131.0_kind_phys,max(5.0_kind_phys,refice)) - - factor = (refice - 2.0) / 3.0 - index = max( 1, min( 42, int( factor ) )) - fint = factor - float(index) - - do ib = nblow, nbhgh - extcoice = max(f_zero, extice2(index,ib) & - & + fint*(extice2(index+1,ib)-extice2(index,ib)) ) - ssacoice = max(f_zero, min(f_one, ssaice2(index,ib) & - & + fint*(ssaice2(index+1,ib)-ssaice2(index,ib)) )) - asycoice = max(f_zero, min(f_one, asyice2(index,ib) & - & + fint*(asyice2(index+1,ib)-asyice2(index,ib)) )) -! forcoice = asycoice * asycoice - - tauice(ib) = cldice * extcoice - ssaice(ib) = tauice(ib) * ssacoice - asyice(ib) = ssaice(ib) * asycoice - enddo - -!> - fu's approach for ice effective radius between 4.8 and 135 microns -!! (generalized effective size from 5 to 140 microns). - - elseif ( iswcice == 3 ) then - dgeice = max( 5.0, min( 140.0, 1.0315*refice )) - - factor = (dgeice - 2.0) / 3.0 - index = max( 1, min( 45, int( factor ) )) - fint = factor - float(index) - - do ib = nblow, nbhgh - extcoice = max(f_zero, extice3(index,ib) & - & + fint*(extice3(index+1,ib)-extice3(index,ib)) ) - ssacoice = max(f_zero, min(f_one, ssaice3(index,ib) & - & + fint*(ssaice3(index+1,ib)-ssaice3(index,ib)) )) - asycoice = max(f_zero, min(f_one, asyice3(index,ib) & - & + fint*(asyice3(index+1,ib)-asyice3(index,ib)) )) -! fdelta = max(f_zero, min(f_one, fdlice3(index,ib) & -! & + fint*(fdlice3(index+1,ib)-fdlice3(index,ib)) )) -! forcoice = min( asycoice, fdelta+0.5/ssacoice ) ! see fu 1996 p. 2067 - - tauice(ib) = cldice * extcoice - ssaice(ib) = tauice(ib) * ssacoice - asyice(ib) = ssaice(ib) * asycoice - enddo - - endif ! end if_iswcice_block - endif ! end if_cldice_block - - do ib = 1, nbdsw - jb = nblow + ib - 1 - taucw(k,ib) = tauliq(jb)+tauice(jb)+tauran+tausnw - ssacw(k,ib) = ssaliq(jb)+ssaice(jb)+ssaran(jb)+ssasnw(jb) - asycw(k,ib) = asyliq(jb)+asyice(jb)+asyran(jb)+asysnw(jb) - enddo - - endif lab_if_cld - enddo lab_do_k - - else lab_if_iswcliq - - do k = 1, nlay - if (cfrac(k) > ftiny) then - do ib = 1, nbdsw - taucw(k,ib) = cdat1(k) - ssacw(k,ib) = cdat1(k) * cdat2(k) - asycw(k,ib) = ssacw(k,ib) * cdat3(k) - enddo - endif - enddo - - endif lab_if_iswcliq - -!> -# if physparam::isubcsw > 0, call mcica_subcol() to distribute -!! cloud properties to each g-point. - - if ( isubcsw > 0 ) then ! mcica sub-col clouds approx - - cldf(:) = cfrac(:) - where (cldf(:) < ftiny) - cldf(:) = f_zero - end where - -! --- ... call sub-column cloud generator - - call mcica_subcol & -! --- inputs: - & ( cldf, nlay, ipseed, dz, delgth, & -! --- outputs: - & lcloudy & - & ) - - do ig = 1, ngptsw - do k = 1, nlay - if ( lcloudy(k,ig) ) then - cldfmc(k,ig) = f_one - else - cldfmc(k,ig) = f_zero - endif - enddo - enddo - - else ! non-mcica, normalize cloud - - do k = 1, nlay - cldfrc(k) = cfrac(k) / cf1 - enddo - endif ! end if_isubcsw_block - - return -!................................... - end subroutine cldprop -!----------------------------------- -!> @} - -!>\ingroup module_radsw_main -!> This subroutine computes the sub-colum cloud profile flag array. -!!\param cldf layer cloud fraction -!!\param nlay number of model vertical layers -!!\param ipseed permute seed for random num generator -!!\param dz layer thickness (km) -!!\param de_lgth layer cloud decorrelation length (km) -!!\param lcloudy sub-colum cloud profile flag array -!!\section mcica_sw_gen mcica_subcol General Algorithm -!> @{ -! ---------------------------------- - subroutine mcica_subcol & - & ( cldf, nlay, ipseed, dz, de_lgth, & ! --- inputs - & lcloudy & ! --- outputs - & ) - -! ==================== defination of variables ==================== ! -! ! -! input variables: size ! -! cldf - real, layer cloud fraction nlay ! -! nlay - integer, number of model vertical layers 1 ! -! ipseed - integer, permute seed for random num generator 1 ! -! ** note : if the cloud generator is called multiple times, need ! -! to permute the seed between each call; if between calls ! -! for lw and sw, use values differ by the number of g-pts. ! -! dz - real, layer thickness (km) nlay ! -! de_lgth-real, layer cloud decorrelation length (km) 1 ! -! ! -! output variables: ! -! lcloudy - logical, sub-colum cloud profile flag array nlay*ngptsw! -! ! -! other control flags from module variables: ! -! iovrsw : control flag for cloud overlapping method ! -! =0: random ! -! =1: maximum/random overlapping clouds ! -! =2: maximum overlap cloud ! -! =3: cloud decorrelation-length overlap method ! -! ! -! ===================== end of definitions ==================== ! - - implicit none - -! --- inputs: - integer, intent(in) :: nlay, ipseed - - real (kind=kind_phys), dimension(nlay), intent(in) :: cldf, dz - real (kind=kind_phys), intent(in) :: de_lgth - -! --- outputs: - logical, dimension(nlay,ngptsw), intent(out):: lcloudy - -! --- locals: - real (kind=kind_phys) :: cdfunc(nlay,ngptsw), tem1, & - & rand2d(nlay*ngptsw), rand1d(ngptsw), fac_lcf(nlay), & - & cdfun2(nlay,ngptsw) - - type (random_stat) :: stat ! for thread safe random generator - - integer :: k, n, k1 -! -!===> ... begin here -! -!> -# Advance randum number generator by ipseed values. - - call random_setseed & -! --- inputs: - & ( ipseed, & -! --- outputs: - & stat & - & ) - -!> -# Sub-column set up according to overlapping assumption. - - select case ( iovrsw ) - - case( 0 ) ! random overlap, pick a random value at every level - - call random_number & -! --- inputs: ( none ) -! --- outputs: - & ( rand2d, stat ) - - k1 = 0 - do n = 1, ngptsw - do k = 1, nlay - k1 = k1 + 1 - cdfunc(k,n) = rand2d(k1) - enddo - enddo - - case( 1 ) ! max-ran overlap - - call random_number & -! --- inputs: ( none ) -! --- outputs: - & ( rand2d, stat ) - - k1 = 0 - do n = 1, ngptsw - do k = 1, nlay - k1 = k1 + 1 - cdfunc(k,n) = rand2d(k1) - enddo - enddo - -! --- first pick a random number for bottom/top layer. -! then walk up the column: (aer's code) -! if layer below is cloudy, use the same rand num in the layer below -! if layer below is clear, use a new random number - -! --- from bottom up - do k = 2, nlay - k1 = k - 1 - tem1 = f_one - cldf(k1) - - do n = 1, ngptsw - if ( cdfunc(k1,n) > tem1 ) then - cdfunc(k,n) = cdfunc(k1,n) - else - cdfunc(k,n) = cdfunc(k,n) * tem1 - endif - enddo - enddo - -! --- then walk down the column: (if use original author's method) -! if layer above is cloudy, use the same rand num in the layer above -! if layer above is clear, use a new random number - -! --- from top down -! do k = nlay-1, 1, -1 -! k1 = k + 1 -! tem1 = f_one - cldf(k1) - -! do n = 1, ngptsw -! if ( cdfunc(k1,n) > tem1 ) then -! cdfunc(k,n) = cdfunc(k1,n) -! else -! cdfunc(k,n) = cdfunc(k,n) * tem1 -! endif -! enddo -! enddo - - case( 2 ) ! maximum overlap, pick same random numebr at every level - - call random_number & -! --- inputs: ( none ) -! --- outputs: - & ( rand1d, stat ) - - do n = 1, ngptsw - tem1 = rand1d(n) - - do k = 1, nlay - cdfunc(k,n) = tem1 - enddo - enddo - - case( 3 ) ! decorrelation length overlap - -! --- compute overlapping factors based on layer midpoint distances -! and decorrelation depths - - do k = nlay, 2, -1 - fac_lcf(k) = exp( -0.5 * (dz(k)+dz(k-1)) / de_lgth ) - enddo - -! --- setup 2 sets of random numbers - - call random_number ( rand2d, stat ) - - k1 = 0 - do n = 1, ngptsw - do k = 1, nlay - k1 = k1 + 1 - cdfunc(k,n) = rand2d(k1) - enddo - enddo - - call random_number ( rand2d, stat ) - - k1 = 0 - do n = 1, ngptsw - do k = 1, nlay - k1 = k1 + 1 - cdfun2(k,n) = rand2d(k1) - enddo - enddo - -! --- then working from the top down: -! if a random number (from an independent set -cdfun2) is smaller then the -! scale factor: use the upper layer's number, otherwise use a new random -! number (keep the original assigned one). - - do n = 1, ngptsw - do k = nlay-1, 1, -1 - k1 = k + 1 - if ( cdfun2(k,n) <= fac_lcf(k1) ) then - cdfunc(k,n) = cdfunc(k1,n) - endif - enddo - enddo - - end select - -!> -# Generate subcolumns for homogeneous clouds. - - do k = 1, nlay - tem1 = f_one - cldf(k) - - do n = 1, ngptsw - lcloudy(k,n) = cdfunc(k,n) >= tem1 - enddo - enddo - - return -! .................................. - end subroutine mcica_subcol -!> @} -! ---------------------------------- - -!>\ingroup module_radsw_main -!> This subroutine computes various coefficients needed in radiative -!! transfer calculation. -!!\param pavel layer pressure (mb) -!!\param tavel layer temperature (k) -!!\param h2ovmr layer w.v. volumn mixing ratio (kg/kg) -!!\param nlay total number of vertical layers -!!\param nlp1 total number of vertical levels -!!\param laytrop tropopause layer index (unitless) -!!\param jp indices of lower reference pressure -!!\param jt,jt1 indices of lower reference temperatures at -!! levels of jp and jp+1 -!!\param fac00,fac01,fac10,fac11 factors mltiply the reference ks,i,j=0/1 for -!! lower/higher of the 2 appropriate temperature -!! and altitudes. -!!\param selffac scale factor for w. v. self-continuum equals -!! (w.v. density)/(atmospheric density at 296k -!! and 1013 mb) -!!\param selffrac factor for temperature interpolation of -!! reference w.v. self-continuum data -!!\param indself index of lower ref temp for selffac -!!\param forfac scale factor for w. v. foreign-continuum -!!\param forfrac factor for temperature interpolation of -!! reference w.v. foreign-continuum data -!!\param indfor index of lower ref temp for forfac -!>\section setcoef_gen_rw setcoef General Algorithm -!! @{ -! ---------------------------------- - subroutine setcoef & - & ( pavel,tavel,h2ovmr, nlay,nlp1, & ! --- inputs - & laytrop,jp,jt,jt1,fac00,fac01,fac10,fac11, & ! --- outputs - & selffac,selffrac,indself,forfac,forfrac,indfor & - & ) - -! =================== program usage description =================== ! -! ! -! purpose: compute various coefficients needed in radiative transfer ! -! calculations. ! -! ! -! subprograms called: none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: -size- ! -! pavel - real, layer pressures (mb) nlay ! -! tavel - real, layer temperatures (k) nlay ! -! h2ovmr - real, layer w.v. volum mixing ratio (kg/kg) nlay ! -! nlay/nlp1 - integer, total number of vertical layers, levels 1 ! -! ! -! outputs: ! -! laytrop - integer, tropopause layer index (unitless) 1 ! -! jp - real, indices of lower reference pressure nlay ! -! jt, jt1 - real, indices of lower reference temperatures nlay ! -! at levels of jp and jp+1 ! -! facij - real, factors multiply the reference ks, nlay ! -! i,j=0/1 for lower/higher of the 2 appropriate ! -! temperatures and altitudes. ! -! selffac - real, scale factor for w. v. self-continuum nlay ! -! equals (w. v. density)/(atmospheric density ! -! at 296k and 1013 mb) ! -! selffrac - real, factor for temperature interpolation of nlay ! -! reference w. v. self-continuum data ! -! indself - integer, index of lower ref temp for selffac nlay ! -! forfac - real, scale factor for w. v. foreign-continuum nlay ! -! forfrac - real, factor for temperature interpolation of nlay ! -! reference w.v. foreign-continuum data ! -! indfor - integer, index of lower ref temp for forfac nlay ! -! ! -! ====================== end of definitions =================== ! - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(:), intent(in) :: pavel, tavel, & - & h2ovmr - -! --- outputs: - integer, dimension(nlay), intent(out) :: indself, indfor, & - & jp, jt, jt1 - integer, intent(out) :: laytrop - - real (kind=kind_phys), dimension(nlay), intent(out) :: fac00, & - & fac01, fac10, fac11, selffac, selffrac, forfac, forfrac - -! --- locals: - real (kind=kind_phys) :: plog, fp, fp1, ft, ft1, tem1, tem2 - - integer :: i, k, jp1 -! -!===> ... begin here -! - laytrop= nlay - - do k = 1, nlay - - forfac(k) = pavel(k)*stpfac / (tavel(k)*(f_one + h2ovmr(k))) - -!> -# Find the two reference pressures on either side of the -!! layer pressure. store them in jp and jp1. store in fp the -!! fraction of the difference (in ln(pressure)) between these -!! two values that the layer pressure lies. - - plog = log(pavel(k)) - jp(k) = max(1, min(58, int(36.0 - 5.0*(plog+0.04)) )) - jp1 = jp(k) + 1 - fp = 5.0 * (preflog(jp(k)) - plog) - -!> -# Determine, for each reference pressure (jp and jp1), which -!! reference temperature (these are different for each reference -!! pressure) is nearest the layer temperature but does not exceed it. -!! store these indices in jt and jt1, resp. store in ft (resp. ft1) -!! the fraction of the way between jt (jt1) and the next highest -!! reference temperature that the layer temperature falls. - - tem1 = (tavel(k) - tref(jp(k))) / 15.0 - tem2 = (tavel(k) - tref(jp1 )) / 15.0 - jt (k) = max(1, min(4, int(3.0 + tem1) )) - jt1(k) = max(1, min(4, int(3.0 + tem2) )) - ft = tem1 - float(jt (k) - 3) - ft1 = tem2 - float(jt1(k) - 3) - -!> -# We have now isolated the layer ln pressure and temperature, -!! between two reference pressures and two reference temperatures -!! (for each reference pressure). we multiply the pressure -!! fraction fp with the appropriate temperature fractions to get -!! the factors that will be needed for the interpolation that yields -!! the optical depths (performed in routines taugbn for band n). - - fp1 = f_one - fp - fac10(k) = fp1 * ft - fac00(k) = fp1 * (f_one - ft) - fac11(k) = fp * ft1 - fac01(k) = fp * (f_one - ft1) - -!> -# If the pressure is less than ~100mb, perform a different -!! set of species interpolations. - - if ( plog > 4.56 ) then - - laytrop = k - -!> -# Set up factors needed to separately include the water vapor -!! foreign-continuum in the calculation of absorption coefficient. - - tem1 = (332.0 - tavel(k)) / 36.0 - indfor (k) = min(2, max(1, int(tem1))) - forfrac(k) = tem1 - float(indfor(k)) - -!> -# Set up factors needed to separately include the water vapor -!! self-continuum in the calculation of absorption coefficient. - - tem2 = (tavel(k) - 188.0) / 7.2 - indself (k) = min(9, max(1, int(tem2)-7)) - selffrac(k) = tem2 - float(indself(k) + 7) - selffac (k) = h2ovmr(k) * forfac(k) - - else - -! --- ... set up factors needed to separately include the water vapor -! foreign-continuum in the calculation of absorption coefficient. - - tem1 = (tavel(k) - 188.0) / 36.0 - indfor (k) = 3 - forfrac(k) = tem1 - f_one - - indself (k) = 0 - selffrac(k) = f_zero - selffac (k) = f_zero - - endif - - enddo ! end_do_k_loop - - return -! .................................. - end subroutine setcoef -!! @} -! ---------------------------------- - -!>\ingroup module_radsw_main -!> This subroutine computes the shortwave radiative fluxes using -!! two-stream method. -!!\param ssolar incoming solar flux at top -!!\param cosz cosine solar zenith angle -!!\param sntz secant solar zenith angle -!!\param albbm surface albedo for direct beam radiation -!!\param albdf surface albedo for diffused radiation -!!\param sfluxzen spectral distribution of incoming solar flux -!!\param cldfrc layer cloud fraction -!!\param cf1 >0: cloudy sky, otherwise: clear sky -!!\param cf0 =1-cf1 -!!\param taug spectral optical depth for gases -!!\param taur optical depth for rayleigh scattering -!!\param tauae aerosols optical depth -!!\param ssaae aerosols single scattering albedo -!!\param asyae aerosols asymmetry factor -!!\param taucw weighted cloud optical depth -!!\param ssacw weighted cloud single scat albedo -!!\param asycw weighted cloud asymmetry factor -!!\param nlay,nlp1 number of layers/levels -!!\param fxupc tot sky upward flux -!!\param fxdnc tot sky downward flux -!!\param fxup0 clr sky upward flux -!!\param fxdn0 clr sky downward flux -!!\param ftoauc tot sky toa upwd flux -!!\param ftoau0 clr sky toa upwd flux -!!\param ftoadc toa downward (incoming) solar flux -!!\param fsfcuc tot sky sfc upwd flux -!!\param fsfcu0 clr sky sfc upwd flux -!!\param fsfcdc tot sky sfc dnwd flux -!!\param fsfcd0 clr sky sfc dnwd flux -!!\param sfbmc tot sky sfc dnwd beam flux (nir/uv+vis) -!!\param sfdfc tot sky sfc dnwd diff flux (nir/uv+vis) -!!\param sfbm0 clr sky sfc dnwd beam flux (nir/uv+vis) -!!\param sfdf0 clr sky sfc dnwd diff flux (nir/uv+vis) -!!\param suvbfc tot sky sfc dnwd uv-b flux -!!\param suvbf0 clr sky sfc dnwd uv-b flux -!>\section General_spcvrtc spcvrtc General Algorithm -!! @{ -!----------------------------------- - subroutine spcvrtc & - & ( ssolar,cosz,sntz,albbm,albdf,sfluxzen,cldfrc, & ! --- inputs - & cf1,cf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & - & nlay, nlp1, & - & fxupc,fxdnc,fxup0,fxdn0, & ! --- outputs - & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & - & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & - & ) - -! =================== program usage description =================== ! -! ! -! purpose: computes the shortwave radiative fluxes using two-stream ! -! method ! -! ! -! subprograms called: vrtqdr ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: size ! -! ssolar - real, incoming solar flux at top 1 ! -! cosz - real, cosine solar zenith angle 1 ! -! sntz - real, secant solar zenith angle 1 ! -! albbm - real, surface albedo for direct beam radiation 2 ! -! albdf - real, surface albedo for diffused radiation 2 ! -! sfluxzen- real, spectral distribution of incoming solar flux ngptsw! -! cldfrc - real, layer cloud fraction nlay ! -! cf1 - real, >0: cloudy sky, otherwise: clear sky 1 ! -! cf0 - real, =1-cf1 1 ! -! taug - real, spectral optical depth for gases nlay*ngptsw! -! taur - real, optical depth for rayleigh scattering nlay*ngptsw! -! tauae - real, aerosols optical depth nlay*nbdsw ! -! ssaae - real, aerosols single scattering albedo nlay*nbdsw ! -! asyae - real, aerosols asymmetry factor nlay*nbdsw ! -! taucw - real, weighted cloud optical depth nlay*nbdsw ! -! ssacw - real, weighted cloud single scat albedo nlay*nbdsw ! -! asycw - real, weighted cloud asymmetry factor nlay*nbdsw ! -! nlay,nlp1 - integer, number of layers/levels 1 ! -! ! -! output variables: ! -! fxupc - real, tot sky upward flux nlp1*nbdsw ! -! fxdnc - real, tot sky downward flux nlp1*nbdsw ! -! fxup0 - real, clr sky upward flux nlp1*nbdsw ! -! fxdn0 - real, clr sky downward flux nlp1*nbdsw ! -! ftoauc - real, tot sky toa upwd flux 1 ! -! ftoau0 - real, clr sky toa upwd flux 1 ! -! ftoadc - real, toa downward (incoming) solar flux 1 ! -! fsfcuc - real, tot sky sfc upwd flux 1 ! -! fsfcu0 - real, clr sky sfc upwd flux 1 ! -! fsfcdc - real, tot sky sfc dnwd flux 1 ! -! fsfcd0 - real, clr sky sfc dnwd flux 1 ! -! sfbmc - real, tot sky sfc dnwd beam flux (nir/uv+vis) 2 ! -! sfdfc - real, tot sky sfc dnwd diff flux (nir/uv+vis) 2 ! -! sfbm0 - real, clr sky sfc dnwd beam flux (nir/uv+vis) 2 ! -! sfdf0 - real, clr sky sfc dnwd diff flux (nir/uv+vis) 2 ! -! suvbfc - real, tot sky sfc dnwd uv-b flux 1 ! -! suvbf0 - real, clr sky sfc dnwd uv-b flux 1 ! -! ! -! internal variables: ! -! zrefb - real, direct beam reflectivity for clear/cloudy nlp1 ! -! zrefd - real, diffuse reflectivity for clear/cloudy nlp1 ! -! ztrab - real, direct beam transmissivity for clear/cloudy nlp1 ! -! ztrad - real, diffuse transmissivity for clear/cloudy nlp1 ! -! zldbt - real, layer beam transmittance for clear/cloudy nlp1 ! -! ztdbt - real, lev total beam transmittance for clr/cld nlp1 ! -! ! -! control parameters in module "physparam" ! -! iswmode - control flag for 2-stream transfer schemes ! -! = 1 delta-eddington (joseph et al., 1976) ! -! = 2 pifm (zdunkowski et al., 1980) ! -! = 3 discrete ordinates (liou, 1973) ! -! ! -! ******************************************************************* ! -! original code description ! -! ! -! method: ! -! ------- ! -! standard delta-eddington, p.i.f.m., or d.o.m. layer calculations. ! -! kmodts = 1 eddington (joseph et al., 1976) ! -! = 2 pifm (zdunkowski et al., 1980) ! -! = 3 discrete ordinates (liou, 1973) ! -! ! -! modifications: ! -! -------------- ! -! original: h. barker ! -! revision: merge with rrtmg_sw: j.-j.morcrette, ecmwf, feb 2003 ! -! revision: add adjustment for earth/sun distance:mjiacono,aer,oct2003! -! revision: bug fix for use of palbp and palbd: mjiacono, aer, nov2003! -! revision: bug fix to apply delta scaling to clear sky: aer, dec2004 ! -! revision: code modified so that delta scaling is not done in cloudy ! -! profiles if routine cldprop is used; delta scaling can be ! -! applied by swithcing code below if cldprop is not used to ! -! get cloud properties. aer, jan 2005 ! -! revision: uniform formatting for rrtmg: mjiacono, aer, jul 2006 ! -! revision: use exponential lookup table for transmittance: mjiacono, ! -! aer, aug 2007 ! -! ! -! ******************************************************************* ! -! ====================== end of description block ================= ! - -! --- constant parameters: - real (kind=kind_phys), parameter :: zcrit = 0.9999995 ! thresold for conservative scattering - real (kind=kind_phys), parameter :: zsr3 = sqrt(3.0) - real (kind=kind_phys), parameter :: od_lo = 0.06 - real (kind=kind_phys), parameter :: eps1 = 1.0e-8 - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(nlay,ngptsw), intent(in) :: & - & taug, taur - real (kind=kind_phys), dimension(nlay,nbdsw), intent(in) :: & - & taucw, ssacw, asycw, tauae, ssaae, asyae - - real (kind=kind_phys), dimension(ngptsw), intent(in) :: sfluxzen - real (kind=kind_phys), dimension(nlay), intent(in) :: cldfrc - - real (kind=kind_phys), dimension(2), intent(in) :: albbm, albdf - - real (kind=kind_phys), intent(in) :: cosz, sntz, cf1, cf0, ssolar - -! --- outputs: - real (kind=kind_phys), dimension(nlp1,nbdsw), intent(out) :: & - & fxupc, fxdnc, fxup0, fxdn0 - - real (kind=kind_phys), dimension(2), intent(out) :: sfbmc, sfdfc, & - & sfbm0, sfdf0 - - real (kind=kind_phys), intent(out) :: suvbfc, suvbf0, ftoadc, & - & ftoauc, ftoau0, fsfcuc, fsfcu0, fsfcdc, fsfcd0 - -! --- locals: - real (kind=kind_phys), dimension(nlay) :: ztaus, zssas, zasys, & - & zldbt0 - - real (kind=kind_phys), dimension(nlp1) :: zrefb, zrefd, ztrab, & - & ztrad, ztdbt, zldbt, zfu, zfd - - real (kind=kind_phys) :: ztau1, zssa1, zasy1, ztau0, zssa0, & - & zasy0, zasy3, zssaw, zasyw, zgam1, zgam2, zgam3, zgam4, & - & zc0, zc1, za1, za2, zb1, zb2, zrk, zrk2, zrp, zrp1, zrm1, & - & zrpp, zrkg1, zrkg3, zrkg4, zexp1, zexm1, zexp2, zexm2, & - & zexp3, zexp4, zden1, ze1r45, ftind, zsolar, zrefb1, & - & zrefd1, ztrab1, ztrad1, ztdbt0, zr1, zr2, zr3, zr4, zr5, & - & zt1, zt2, zt3, zf1, zf2, zrpp1 - - integer :: ib, ibd, jb, jg, k, kp, itind -! -!===> ... begin here - -!> -# Initialize output fluxes. - do ib = 1, nbdsw - do k = 1, nlp1 - fxdnc(k,ib) = f_zero - fxupc(k,ib) = f_zero - fxdn0(k,ib) = f_zero - fxup0(k,ib) = f_zero - enddo - enddo - - ftoadc = f_zero - ftoauc = f_zero - ftoau0 = f_zero - fsfcuc = f_zero - fsfcu0 = f_zero - fsfcdc = f_zero - fsfcd0 = f_zero - -!! --- ... uv-b surface downward fluxes - suvbfc = f_zero - suvbf0 = f_zero - -!! --- ... output surface flux components - sfbmc(1) = f_zero - sfbmc(2) = f_zero - sfdfc(1) = f_zero - sfdfc(2) = f_zero - sfbm0(1) = f_zero - sfbm0(2) = f_zero - sfdf0(1) = f_zero - sfdf0(2) = f_zero - -!> -# Loop over all g-points in each band. - - lab_do_jg : do jg = 1, ngptsw - - jb = NGB(jg) - ib = jb + 1 - nblow - ibd = idxsfc(jb) - - zsolar = ssolar * sfluxzen(jg) - -!> -# Set up toa direct beam and surface values (beam and diff). - - ztdbt(nlp1) = f_one - ztdbt0 = f_one - - zldbt(1) = f_zero - if (ibd /= 0) then - zrefb(1) = albbm(ibd) - zrefd(1) = albdf(ibd) - else - zrefb(1) = 0.5 * (albbm(1) + albbm(2)) - zrefd(1) = 0.5 * (albdf(1) + albdf(2)) - endif - ztrab(1) = f_zero - ztrad(1) = f_zero - -!> -# Compute clear-sky optical parameters, layer reflectance and -!! transmittance. -! - Set up toa direct beam and surface values (beam and diff). -! - Delta scaling for clear-sky condition. -! - General two-stream expressions for physparam::iswmode . -! - Compute homogeneous reflectance and transmittance for both -! conservative and non-conservative scattering. -! - Pre-delta-scaling clear and cloudy direct beam transmittance. -! - Call swflux() to compute the upward and downward radiation -! fluxes. - - do k = nlay, 1, -1 - kp = k + 1 - - ztau0 = max( ftiny, taur(k,jg)+taug(k,jg)+tauae(k,ib) ) - zssa0 = taur(k,jg) + tauae(k,ib)*ssaae(k,ib) - zasy0 = asyae(k,ib)*ssaae(k,ib)*tauae(k,ib) - zssaw = min( oneminus, zssa0 / ztau0 ) - zasyw = zasy0 / max( ftiny, zssa0 ) - -!> - Saving clear-sky quantities for later total-sky usage. - ztaus(k) = ztau0 - zssas(k) = zssa0 - zasys(k) = zasy0 - -!> - Delta scaling for clear-sky condition. - za1 = zasyw * zasyw - za2 = zssaw * za1 - - ztau1 = (f_one - za2) * ztau0 - zssa1 = (zssaw - za2) / (f_one - za2) -!org zasy1 = (zasyw - za1) / (f_one - za1) ! this line is replaced by the next - zasy1 = zasyw / (f_one + zasyw) ! to reduce truncation error - zasy3 = 0.75 * zasy1 - -!> - Perform general two-stream expressions: -!!\n control parameters in module "physparam" -!!\n iswmode - control flag for 2-stream transfer schemes -!!\n = 1 delta-eddington (joseph et al., 1976) -!!\n = 2 pifm (zdunkowski et al., 1980) -!!\n = 3 discrete ordinates (liou, 1973) - if ( iswmode == 1 ) then - zgam1 = 1.75 - zssa1 * (f_one + zasy3) - zgam2 =-0.25 + zssa1 * (f_one - zasy3) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 2 ) then ! pifm - zgam1 = 2.0 - zssa1 * (1.25 + zasy3) - zgam2 = 0.75* zssa1 * (f_one- zasy1) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 3 ) then ! discrete ordinates - zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 - zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 - zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 - endif - zgam4 = f_one - zgam3 - -!> - Compute homogeneous reflectance and transmittance for both conservative -!! scattering and non-conservative scattering. - - if ( zssaw >= zcrit ) then ! for conservative scattering - za1 = zgam1 * cosz - zgam3 - za2 = zgam1 * ztau1 - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( ztau1*sntz , 500.0 ) - if ( zb1 <= od_lo ) then - zb2 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zb2 = exp_tbl(itind) - endif - -! ... collimated beam - zrefb(kp) = max(f_zero, min(f_one, & - & (za2 - za1*(f_one - zb2))/(f_one + za2) )) - ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp) )) - -! ... isotropic incidence - zrefd(kp) = max(f_zero, min(f_one, za2/(f_one + za2) )) - ztrad(kp) = max(f_zero, min(f_one, f_one-zrefd(kp) )) - - else ! for non-conservative scattering - za1 = zgam1*zgam4 + zgam2*zgam3 - za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk - - zrp = zrk * cosz - zrp1 = f_one + zrp - zrm1 = f_one - zrp - zrpp1= f_one - zrp*zrp - zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity - zrkg1= zrk + zgam1 - zrkg3= zrk * zgam3 - zrkg4= zrk * zgam4 - - zr1 = zrm1 * (za2 + zrkg3) - zr2 = zrp1 * (za2 - zrkg3) - zr3 = zrk2 * (zgam3 - za2*cosz) - zr4 = zrpp * zrkg1 - zr5 = zrpp * (zrk - zgam1) - - zt1 = zrp1 * (za1 + zrkg4) - zt2 = zrm1 * (za1 - zrkg4) - zt3 = zrk2 * (zgam4 + za1*cosz) - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( zrk*ztau1, 500.0 ) - if ( zb1 <= od_lo ) then - zexm1 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zexm1 = exp_tbl(itind) - endif - zexp1 = f_one / zexm1 - - zb2 = min ( sntz*ztau1, 500.0 ) - if ( zb2 <= od_lo ) then - zexm2 = f_one - zb2 + 0.5*zb2*zb2 - else - ftind = zb2 / (bpade + zb2) - itind = ftind*NTBMX + 0.5 - zexm2 = exp_tbl(itind) - endif - zexp2 = f_one / zexm2 - ze1r45 = zr4*zexp1 + zr5*zexm1 - -! ... collimated beam - if (ze1r45>=-eps1 .and. ze1r45<=eps1) then - zrefb(kp) = eps1 - ztrab(kp) = zexm2 - else - zden1 = zssa1 / ze1r45 - zrefb(kp) = max(f_zero, min(f_one, & - & (zr1*zexp1 - zr2*zexm1 - zr3*zexm2)*zden1 )) - ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one & - & - (zt1*zexp1 - zt2*zexm1 - zt3*zexp2)*zden1) )) - endif - -! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) - zrefd(kp) = max(f_zero, min(f_one, & - & zgam2*(zexp1 - zexm1)*zden1 )) - ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) - endif ! end if_zssaw_block - -!> - Calculate direct beam transmittance. use exponential lookup table -!! for transmittance, or expansion of exponential for low optical depth. - - zr1 = ztau1 * sntz - if ( zr1 <= od_lo ) then - zexp3 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp3 = exp_tbl(itind) - endif - - ztdbt(k) = zexp3 * ztdbt(kp) - zldbt(kp) = zexp3 - -!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. -! (must use 'orig', unscaled cloud optical depth) - - zr1 = ztau0 * sntz - if ( zr1 <= od_lo ) then - zexp4 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp4 = exp_tbl(itind) - endif - - zldbt0(k) = zexp4 - ztdbt0 = zexp4 * ztdbt0 - enddo ! end do_k_loop - -!> -# Call vrtqdr(), to compute the upward and downward radiation fluxes. - call vrtqdr & -! --- inputs: - & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & - & nlay, nlp1, & -! --- outputs: - & zfu, zfd & - & ) - -!> -# Compute upward and downward fluxes at levels. - do k = 1, nlp1 - fxup0(k,ib) = fxup0(k,ib) + zsolar*zfu(k) - fxdn0(k,ib) = fxdn0(k,ib) + zsolar*zfd(k) - enddo - -!> -# Compute surface downward beam/diffused flux components. - zb1 = zsolar*ztdbt0 - zb2 = zsolar*(zfd(1) - ztdbt0) - - if (ibd /= 0) then - sfbm0(ibd) = sfbm0(ibd) + zb1 - sfdf0(ibd) = sfdf0(ibd) + zb2 - else - zf1 = 0.5 * zb1 - zf2 = 0.5 * zb2 - sfbm0(1) = sfbm0(1) + zf1 - sfdf0(1) = sfdf0(1) + zf2 - sfbm0(2) = sfbm0(2) + zf1 - sfdf0(2) = sfdf0(2) + zf2 - endif -! sfbm0(ibd) = sfbm0(ibd) + zsolar*ztdbt0 -! sfdf0(ibd) = sfdf0(ibd) + zsolar*(zfd(1) - ztdbt0) - -!> -# Compute total sky optical parameters, layer reflectance and -!! transmittance. -! - Set up toa direct beam and surface values (beam and diff) -! - Delta scaling for total-sky condition -! - General two-stream expressions for physparam::iswmode -! - Compute homogeneous reflectance and transmittance for -! conservative scattering and non-conservative scattering -! - Pre-delta-scaling clear and cloudy direct beam transmittance -! - Call swflux() to compute the upward and downward radiation fluxes - - if ( cf1 > eps ) then - -!> - Set up toa direct beam and surface values (beam and diff). - ztdbt0 = f_one - zldbt(1) = f_zero - - do k = nlay, 1, -1 - kp = k + 1 - zc0 = f_one - cldfrc(k) - zc1 = cldfrc(k) - if ( zc1 > ftiny ) then ! it is a cloudy-layer - - ztau0 = ztaus(k) + taucw(k,ib) - zssa0 = zssas(k) + ssacw(k,ib) - zasy0 = zasys(k) + asycw(k,ib) - zssaw = min(oneminus, zssa0 / ztau0) - zasyw = zasy0 / max(ftiny, zssa0) - -!> - Perform delta scaling for total-sky condition. - za1 = zasyw * zasyw - za2 = zssaw * za1 - - ztau1 = (f_one - za2) * ztau0 - zssa1 = (zssaw - za2) / (f_one - za2) -!org zasy1 = (zasyw - za1) / (f_one - za1) - zasy1 = zasyw / (f_one + zasyw) - zasy3 = 0.75 * zasy1 - -!> - Perform general two-stream expressions: -!!\n control parameters in module "physparam" -!!\n iswmode - control flag for 2-stream transfer schemes -!!\n = 1 delta-eddington (joseph et al., 1976) -!!\n = 2 pifm (zdunkowski et al., 1980) -!!\n = 3 discrete ordinates (liou, 1973) - - if ( iswmode == 1 ) then - zgam1 = 1.75 - zssa1 * (f_one + zasy3) - zgam2 =-0.25 + zssa1 * (f_one - zasy3) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 2 ) then ! pifm - zgam1 = 2.0 - zssa1 * (1.25 + zasy3) - zgam2 = 0.75* zssa1 * (f_one- zasy1) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 3 ) then ! discrete ordinates - zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 - zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 - zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 - endif - zgam4 = f_one - zgam3 - - zrefb1 = zrefb(kp) - zrefd1 = zrefd(kp) - ztrab1 = ztrab(kp) - ztrad1 = ztrad(kp) - -!> - Compute homogeneous reflectance and transmittance for both conservative -!! and non-conservative scattering. - - if ( zssaw >= zcrit ) then ! for conservative scattering - za1 = zgam1 * cosz - zgam3 - za2 = zgam1 * ztau1 - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( ztau1*sntz , 500.0 ) - if ( zb1 <= od_lo ) then - zb2 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zb2 = exp_tbl(itind) - endif - -! ... collimated beam - zrefb(kp) = max(f_zero, min(f_one, & - & (za2 - za1*(f_one - zb2))/(f_one + za2) )) - ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp))) - -! ... isotropic incidence - zrefd(kp) = max(f_zero, min(f_one, za2 / (f_one+za2) )) - ztrad(kp) = max(f_zero, min(f_one, f_one - zrefd(kp) )) - - else ! for non-conservative scattering - za1 = zgam1*zgam4 + zgam2*zgam3 - za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk - - zrp = zrk * cosz - zrp1 = f_one + zrp - zrm1 = f_one - zrp - zrpp1= f_one - zrp*zrp - zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity - zrkg1= zrk + zgam1 - zrkg3= zrk * zgam3 - zrkg4= zrk * zgam4 - - zr1 = zrm1 * (za2 + zrkg3) - zr2 = zrp1 * (za2 - zrkg3) - zr3 = zrk2 * (zgam3 - za2*cosz) - zr4 = zrpp * zrkg1 - zr5 = zrpp * (zrk - zgam1) - - zt1 = zrp1 * (za1 + zrkg4) - zt2 = zrm1 * (za1 - zrkg4) - zt3 = zrk2 * (zgam4 + za1*cosz) - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( zrk*ztau1, 500.0 ) - if ( zb1 <= od_lo ) then - zexm1 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zexm1 = exp_tbl(itind) - endif - zexp1 = f_one / zexm1 - - zb2 = min ( ztau1*sntz, 500.0 ) - if ( zb2 <= od_lo ) then - zexm2 = f_one - zb2 + 0.5*zb2*zb2 - else - ftind = zb2 / (bpade + zb2) - itind = ftind*NTBMX + 0.5 - zexm2 = exp_tbl(itind) - endif - zexp2 = f_one / zexm2 - ze1r45 = zr4*zexp1 + zr5*zexm1 - -! ... collimated beam - if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then - zrefb(kp) = eps1 - ztrab(kp) = zexm2 - else - zden1 = zssa1 / ze1r45 - zrefb(kp) = max(f_zero, min(f_one, & - & (zr1*zexp1-zr2*zexm1-zr3*zexm2)*zden1 )) - ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one - & - & (zt1*zexp1-zt2*zexm1-zt3*zexp2)*zden1) )) - endif - -! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) - zrefd(kp) = max(f_zero, min(f_one, & - & zgam2*(zexp1 - zexm1)*zden1 )) - ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) - endif ! end if_zssaw_block - -! --- ... combine clear and cloudy contributions for total sky -! and calculate direct beam transmittances - - zrefb(kp) = zc0*zrefb1 + zc1*zrefb(kp) - zrefd(kp) = zc0*zrefd1 + zc1*zrefd(kp) - ztrab(kp) = zc0*ztrab1 + zc1*ztrab(kp) - ztrad(kp) = zc0*ztrad1 + zc1*ztrad(kp) - -! --- ... direct beam transmittance. use exponential lookup table -! for transmittance, or expansion of exponential for low -! optical depth - - zr1 = ztau1 * sntz - if ( zr1 <= od_lo ) then - zexp3 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp3 = exp_tbl(itind) - endif - - zldbt(kp) = zc0*zldbt(kp) + zc1*zexp3 - ztdbt(k) = zldbt(kp) * ztdbt(kp) - -!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. -! (must use 'orig', unscaled cloud optical depth) - - zr1 = ztau0 * sntz - if ( zr1 <= od_lo ) then - zexp4 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp4 = exp_tbl(itind) - endif - - ztdbt0 = (zc0*zldbt0(k) + zc1*zexp4) * ztdbt0 - - else ! if_zc1_block --- it is a clear layer - -! --- ... direct beam transmittance - ztdbt(k) = zldbt(kp) * ztdbt(kp) - -! --- ... pre-delta-scaling clear and cloudy direct beam transmittance - ztdbt0 = zldbt0(k) * ztdbt0 - - endif ! end if_zc1_block - enddo ! end do_k_loop - -!> -# Call vrtqdr(), to compute the upward and downward radiation fluxes. - - call vrtqdr & -! --- inputs: - & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & - & nlay, nlp1, & -! --- outputs: - & zfu, zfd & - & ) - -!> -# Compute upward and downward fluxes at levels. - do k = 1, nlp1 - fxupc(k,ib) = fxupc(k,ib) + zsolar*zfu(k) - fxdnc(k,ib) = fxdnc(k,ib) + zsolar*zfd(k) - enddo - -!> -# Process and save outputs. -!! - surface downward beam/diffused flux components - zb1 = zsolar*ztdbt0 - zb2 = zsolar*(zfd(1) - ztdbt0) - - if (ibd /= 0) then - sfbmc(ibd) = sfbmc(ibd) + zb1 - sfdfc(ibd) = sfdfc(ibd) + zb2 - else - zf1 = 0.5 * zb1 - zf2 = 0.5 * zb2 - sfbmc(1) = sfbmc(1) + zf1 - sfdfc(1) = sfdfc(1) + zf2 - sfbmc(2) = sfbmc(2) + zf1 - sfdfc(2) = sfdfc(2) + zf2 - endif -! sfbmc(ibd) = sfbmc(ibd) + zsolar*ztdbt0 -! sfdfc(ibd) = sfdfc(ibd) + zsolar*(zfd(1) - ztdbt0) - - endif ! end if_cf1_block - - enddo lab_do_jg - -! --- ... end of g-point loop - - do ib = 1, nbdsw - ftoadc = ftoadc + fxdn0(nlp1,ib) - ftoau0 = ftoau0 + fxup0(nlp1,ib) - fsfcu0 = fsfcu0 + fxup0(1,ib) - fsfcd0 = fsfcd0 + fxdn0(1,ib) - enddo - -!> - uv-b surface downward flux - ibd = nuvb - nblow + 1 - suvbf0 = fxdn0(1,ibd) - - if ( cf1 <= eps ) then ! clear column, set total-sky=clear-sky fluxes - do ib = 1, nbdsw - do k = 1, nlp1 - fxupc(k,ib) = fxup0(k,ib) - fxdnc(k,ib) = fxdn0(k,ib) - enddo - enddo - - ftoauc = ftoau0 - fsfcuc = fsfcu0 - fsfcdc = fsfcd0 - -!> - surface downward beam/diffused flux components - sfbmc(1) = sfbm0(1) - sfdfc(1) = sfdf0(1) - sfbmc(2) = sfbm0(2) - sfdfc(2) = sfdf0(2) - -!> - uv-b surface downward flux - suvbfc = suvbf0 - else ! cloudy column, compute total-sky fluxes - do ib = 1, nbdsw - do k = 1, nlp1 - fxupc(k,ib) = cf1*fxupc(k,ib) + cf0*fxup0(k,ib) - fxdnc(k,ib) = cf1*fxdnc(k,ib) + cf0*fxdn0(k,ib) - enddo - enddo - - do ib = 1, nbdsw - ftoauc = ftoauc + fxupc(nlp1,ib) - fsfcuc = fsfcuc + fxupc(1,ib) - fsfcdc = fsfcdc + fxdnc(1,ib) - enddo - -!> - uv-b surface downward flux - suvbfc = fxdnc(1,ibd) - -!> - surface downward beam/diffused flux components - sfbmc(1) = cf1*sfbmc(1) + cf0*sfbm0(1) - sfbmc(2) = cf1*sfbmc(2) + cf0*sfbm0(2) - sfdfc(1) = cf1*sfdfc(1) + cf0*sfdf0(1) - sfdfc(2) = cf1*sfdfc(2) + cf0*sfdf0(2) - endif ! end if_cf1_block - - return -!................................... - end subroutine spcvrtc -!----------------------------------- -!> @} - -!>\ingroup module_radsw_main -!> This subroutine computes the shortwave radiative fluxes using -!! two-stream method of h. barder and mcica,the monte-carlo independent -!! column approximation, for the representation of sub-grid cloud -!! variability (i.e. cloud overlap). -!!\param ssolar incoming solar flux at top -!!\param cosz cosine solar zenith angle -!!\param sntz secant solar zenith angle -!!\param albbm surface albedo for direct beam radiation -!!\param albdf surface albedo for diffused radiation -!!\param sfluxzen spectral distribution of incoming solar flux -!!\param cldfmc layer cloud fraction for g-point -!!\param cf1 >0: cloudy sky, otherwise: clear sky -!!\param cf0 =1-cf1 -!!\param taug spectral optical depth for gases -!!\param taur optical depth for rayleigh scattering -!!\param tauae aerosols optical depth -!!\param ssaae aerosols single scattering albedo -!!\param asyae aerosols asymmetry factor -!!\param taucw weighted cloud optical depth -!!\param ssacw weighted cloud single scat albedo -!!\param asycw weighted cloud asymmetry factor -!!\param nlay,nlp1 number of layers/levels -!!\param fxupc tot sky upward flux -!!\param fxdnc tot sky downward flux -!!\param fxup0 clr sky upward flux -!!\param fxdn0 clr sky downward flux -!!\param ftoauc tot sky toa upwd flux -!!\param ftoau0 clr sky toa upwd flux -!!\param ftoadc toa downward (incoming) solar flux -!!\param fsfcuc tot sky sfc upwd flux -!!\param fsfcu0 clr sky sfc upwd flux -!!\param fsfcdc tot sky sfc dnwd flux -!!\param fsfcd0 clr sky sfc dnwd flux -!!\param sfbmc tot sky sfc dnwd beam flux (nir/uv+vis) -!!\param sfdfc tot sky sfc dnwd diff flux (nir/uv+vis) -!!\param sfbm0 clr sky sfc dnwd beam flux (nir/uv+vis) -!!\param sfdf0 clr sky sfc dnwd diff flux (nir/uv+vis) -!!\param suvbfc tot sky sfc dnwd uv-b flux -!!\param suvbf0 clr sky sfc dnwd uv-b flux -!>\section spcvrtm_gen spcvrtm General Algorithm -!! @{ -!----------------------------------- - subroutine spcvrtm & - & ( ssolar,cosz,sntz,albbm,albdf,sfluxzen,cldfmc, & ! --- inputs - & cf1,cf0,taug,taur,tauae,ssaae,asyae,taucw,ssacw,asycw, & - & nlay, nlp1, & - & fxupc,fxdnc,fxup0,fxdn0, & ! --- outputs - & ftoauc,ftoau0,ftoadc,fsfcuc,fsfcu0,fsfcdc,fsfcd0, & - & sfbmc,sfdfc,sfbm0,sfdf0,suvbfc,suvbf0 & - & ) - -! =================== program usage description =================== ! -! ! -! purpose: computes the shortwave radiative fluxes using two-stream ! -! method of h. barker and mcica, the monte-carlo independent! -! column approximation, for the representation of sub-grid ! -! cloud variability (i.e. cloud overlap). ! -! ! -! subprograms called: vrtqdr ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: size ! -! ssolar - real, incoming solar flux at top 1 ! -! cosz - real, cosine solar zenith angle 1 ! -! sntz - real, secant solar zenith angle 1 ! -! albbm - real, surface albedo for direct beam radiation 2 ! -! albdf - real, surface albedo for diffused radiation 2 ! -! sfluxzen- real, spectral distribution of incoming solar flux ngptsw! -! cldfmc - real, layer cloud fraction for g-point nlay*ngptsw! -! cf1 - real, >0: cloudy sky, otherwise: clear sky 1 ! -! cf0 - real, =1-cf1 1 ! -! taug - real, spectral optical depth for gases nlay*ngptsw! -! taur - real, optical depth for rayleigh scattering nlay*ngptsw! -! tauae - real, aerosols optical depth nlay*nbdsw ! -! ssaae - real, aerosols single scattering albedo nlay*nbdsw ! -! asyae - real, aerosols asymmetry factor nlay*nbdsw ! -! taucw - real, weighted cloud optical depth nlay*nbdsw ! -! ssacw - real, weighted cloud single scat albedo nlay*nbdsw ! -! asycw - real, weighted cloud asymmetry factor nlay*nbdsw ! -! nlay,nlp1 - integer, number of layers/levels 1 ! -! ! -! output variables: ! -! fxupc - real, tot sky upward flux nlp1*nbdsw ! -! fxdnc - real, tot sky downward flux nlp1*nbdsw ! -! fxup0 - real, clr sky upward flux nlp1*nbdsw ! -! fxdn0 - real, clr sky downward flux nlp1*nbdsw ! -! ftoauc - real, tot sky toa upwd flux 1 ! -! ftoau0 - real, clr sky toa upwd flux 1 ! -! ftoadc - real, toa downward (incoming) solar flux 1 ! -! fsfcuc - real, tot sky sfc upwd flux 1 ! -! fsfcu0 - real, clr sky sfc upwd flux 1 ! -! fsfcdc - real, tot sky sfc dnwd flux 1 ! -! fsfcd0 - real, clr sky sfc dnwd flux 1 ! -! sfbmc - real, tot sky sfc dnwd beam flux (nir/uv+vis) 2 ! -! sfdfc - real, tot sky sfc dnwd diff flux (nir/uv+vis) 2 ! -! sfbm0 - real, clr sky sfc dnwd beam flux (nir/uv+vis) 2 ! -! sfdf0 - real, clr sky sfc dnwd diff flux (nir/uv+vis) 2 ! -! suvbfc - real, tot sky sfc dnwd uv-b flux 1 ! -! suvbf0 - real, clr sky sfc dnwd uv-b flux 1 ! -! ! -! internal variables: ! -! zrefb - real, direct beam reflectivity for clear/cloudy nlp1 ! -! zrefd - real, diffuse reflectivity for clear/cloudy nlp1 ! -! ztrab - real, direct beam transmissivity for clear/cloudy nlp1 ! -! ztrad - real, diffuse transmissivity for clear/cloudy nlp1 ! -! zldbt - real, layer beam transmittance for clear/cloudy nlp1 ! -! ztdbt - real, lev total beam transmittance for clr/cld nlp1 ! -! ! -! control parameters in module "physparam" ! -! iswmode - control flag for 2-stream transfer schemes ! -! = 1 delta-eddington (joseph et al., 1976) ! -! = 2 pifm (zdunkowski et al., 1980) ! -! = 3 discrete ordinates (liou, 1973) ! -! ! -! ******************************************************************* ! -! original code description ! -! ! -! method: ! -! ------- ! -! standard delta-eddington, p.i.f.m., or d.o.m. layer calculations. ! -! kmodts = 1 eddington (joseph et al., 1976) ! -! = 2 pifm (zdunkowski et al., 1980) ! -! = 3 discrete ordinates (liou, 1973) ! -! ! -! modifications: ! -! -------------- ! -! original: h. barker ! -! revision: merge with rrtmg_sw: j.-j.morcrette, ecmwf, feb 2003 ! -! revision: add adjustment for earth/sun distance:mjiacono,aer,oct2003! -! revision: bug fix for use of palbp and palbd: mjiacono, aer, nov2003! -! revision: bug fix to apply delta scaling to clear sky: aer, dec2004 ! -! revision: code modified so that delta scaling is not done in cloudy ! -! profiles if routine cldprop is used; delta scaling can be ! -! applied by swithcing code below if cldprop is not used to ! -! get cloud properties. aer, jan 2005 ! -! revision: uniform formatting for rrtmg: mjiacono, aer, jul 2006 ! -! revision: use exponential lookup table for transmittance: mjiacono, ! -! aer, aug 2007 ! -! ! -! ******************************************************************* ! -! ====================== end of description block ================= ! - -! --- constant parameters: - real (kind=kind_phys), parameter :: zcrit = 0.9999995 ! thresold for conservative scattering - real (kind=kind_phys), parameter :: zsr3 = sqrt(3.0) - real (kind=kind_phys), parameter :: od_lo = 0.06 - real (kind=kind_phys), parameter :: eps1 = 1.0e-8 - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(nlay,ngptsw), intent(in) :: & - & taug, taur, cldfmc - real (kind=kind_phys), dimension(nlay,nbdsw), intent(in) :: & - & taucw, ssacw, asycw, tauae, ssaae, asyae - - real (kind=kind_phys), dimension(ngptsw), intent(in) :: sfluxzen - - real (kind=kind_phys), dimension(2), intent(in) :: albbm, albdf - - real (kind=kind_phys), intent(in) :: cosz, sntz, cf1, cf0, ssolar - -! --- outputs: - real (kind=kind_phys), dimension(nlp1,nbdsw), intent(out) :: & - & fxupc, fxdnc, fxup0, fxdn0 - - real (kind=kind_phys), dimension(2), intent(out) :: sfbmc, sfdfc, & - & sfbm0, sfdf0 - - real (kind=kind_phys), intent(out) :: suvbfc, suvbf0, ftoadc, & - & ftoauc, ftoau0, fsfcuc, fsfcu0, fsfcdc, fsfcd0 - -! --- locals: - real (kind=kind_phys), dimension(nlay) :: ztaus, zssas, zasys, & - & zldbt0 - - real (kind=kind_phys), dimension(nlp1) :: zrefb, zrefd, ztrab, & - & ztrad, ztdbt, zldbt, zfu, zfd - - real (kind=kind_phys) :: ztau1, zssa1, zasy1, ztau0, zssa0, & - & zasy0, zasy3, zssaw, zasyw, zgam1, zgam2, zgam3, zgam4, & - & za1, za2, zb1, zb2, zrk, zrk2, zrp, zrp1, zrm1, zrpp, & - & zrkg1, zrkg3, zrkg4, zexp1, zexm1, zexp2, zexm2, zden1, & - & zexp3, zexp4, ze1r45, ftind, zsolar, ztdbt0, zr1, zr2, & - & zr3, zr4, zr5, zt1, zt2, zt3, zf1, zf2, zrpp1 - - integer :: ib, ibd, jb, jg, k, kp, itind -! -!===> ... begin here -! -!> -# Initialize output fluxes. - - do ib = 1, nbdsw - do k = 1, nlp1 - fxdnc(k,ib) = f_zero - fxupc(k,ib) = f_zero - fxdn0(k,ib) = f_zero - fxup0(k,ib) = f_zero - enddo - enddo - - ftoadc = f_zero - ftoauc = f_zero - ftoau0 = f_zero - fsfcuc = f_zero - fsfcu0 = f_zero - fsfcdc = f_zero - fsfcd0 = f_zero - -!! --- ... uv-b surface downward fluxes - suvbfc = f_zero - suvbf0 = f_zero - -!! --- ... output surface flux components - sfbmc(1) = f_zero - sfbmc(2) = f_zero - sfdfc(1) = f_zero - sfdfc(2) = f_zero - sfbm0(1) = f_zero - sfbm0(2) = f_zero - sfdf0(1) = f_zero - sfdf0(2) = f_zero - -!> -# Loop over all g-points in each band. - - lab_do_jg : do jg = 1, ngptsw - - jb = NGB(jg) - ib = jb + 1 - nblow - ibd = idxsfc(jb) ! spectral band index - - zsolar = ssolar * sfluxzen(jg) - -!> -# Set up toa direct beam and surface values (beam and diff). - - ztdbt(nlp1) = f_one - ztdbt0 = f_one - - zldbt(1) = f_zero - if (ibd /= 0) then - zrefb(1) = albbm(ibd) - zrefd(1) = albdf(ibd) - else - zrefb(1) = 0.5 * (albbm(1) + albbm(2)) - zrefd(1) = 0.5 * (albdf(1) + albdf(2)) - endif - ztrab(1) = f_zero - ztrad(1) = f_zero - -!> -# Compute clear-sky optical parameters, layer reflectance and -!! transmittance. -! - Set up toa direct beam and surface values (beam and diff) -! - Delta scaling for clear-sky condition -! - General two-stream expressions for physparam::iswmode -! - Compute homogeneous reflectance and transmittance for both -! conservative and non-conservative scattering -! - Pre-delta-scaling clear and cloudy direct beam transmittance -! - Call swflux() to compute the upward and downward radiation fluxes - - do k = nlay, 1, -1 - kp = k + 1 - - ztau0 = max( ftiny, taur(k,jg)+taug(k,jg)+tauae(k,ib) ) - zssa0 = taur(k,jg) + tauae(k,ib)*ssaae(k,ib) - zasy0 = asyae(k,ib)*ssaae(k,ib)*tauae(k,ib) - zssaw = min( oneminus, zssa0 / ztau0 ) - zasyw = zasy0 / max( ftiny, zssa0 ) - -!> - Saving clear-sky quantities for later total-sky usage. - ztaus(k) = ztau0 - zssas(k) = zssa0 - zasys(k) = zasy0 - -!> - Delta scaling for clear-sky condition. - za1 = zasyw * zasyw - za2 = zssaw * za1 - - ztau1 = (f_one - za2) * ztau0 - zssa1 = (zssaw - za2) / (f_one - za2) -!org zasy1 = (zasyw - za1) / (f_one - za1) ! this line is replaced by the next - zasy1 = zasyw / (f_one + zasyw) ! to reduce truncation error - zasy3 = 0.75 * zasy1 - -!> - Perform general two-stream expressions: -!!\n control parameters in module "physparam" -!!\n iswmode - control flag for 2-stream transfer schemes -!!\n = 1 delta-eddington (joseph et al., 1976) -!!\n = 2 pifm (zdunkowski et al., 1980) -!!\n = 3 discrete ordinates (liou, 1973) - if ( iswmode == 1 ) then - zgam1 = 1.75 - zssa1 * (f_one + zasy3) - zgam2 =-0.25 + zssa1 * (f_one - zasy3) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 2 ) then ! pifm - zgam1 = 2.0 - zssa1 * (1.25 + zasy3) - zgam2 = 0.75* zssa1 * (f_one- zasy1) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 3 ) then ! discrete ordinates - zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 - zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 - zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 - endif - zgam4 = f_one - zgam3 - -!> - Compute homogeneous reflectance and transmittance. - - if ( zssaw >= zcrit ) then ! for conservative scattering - za1 = zgam1 * cosz - zgam3 - za2 = zgam1 * ztau1 - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( ztau1*sntz , 500.0 ) - if ( zb1 <= od_lo ) then - zb2 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zb2 = exp_tbl(itind) - endif - -! ... collimated beam - zrefb(kp) = max(f_zero, min(f_one, & - & (za2 - za1*(f_one - zb2))/(f_one + za2) )) - ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp) )) - -! ... isotropic incidence - zrefd(kp) = max(f_zero, min(f_one, za2/(f_one + za2) )) - ztrad(kp) = max(f_zero, min(f_one, f_one-zrefd(kp) )) - - else ! for non-conservative scattering - za1 = zgam1*zgam4 + zgam2*zgam3 - za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk - - zrp = zrk * cosz - zrp1 = f_one + zrp - zrm1 = f_one - zrp - zrpp1= f_one - zrp*zrp - zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity - zrkg1= zrk + zgam1 - zrkg3= zrk * zgam3 - zrkg4= zrk * zgam4 - - zr1 = zrm1 * (za2 + zrkg3) - zr2 = zrp1 * (za2 - zrkg3) - zr3 = zrk2 * (zgam3 - za2*cosz) - zr4 = zrpp * zrkg1 - zr5 = zrpp * (zrk - zgam1) - - zt1 = zrp1 * (za1 + zrkg4) - zt2 = zrm1 * (za1 - zrkg4) - zt3 = zrk2 * (zgam4 + za1*cosz) - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( zrk*ztau1, 500.0 ) - if ( zb1 <= od_lo ) then - zexm1 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zexm1 = exp_tbl(itind) - endif - zexp1 = f_one / zexm1 - - zb2 = min ( sntz*ztau1, 500.0 ) - if ( zb2 <= od_lo ) then - zexm2 = f_one - zb2 + 0.5*zb2*zb2 - else - ftind = zb2 / (bpade + zb2) - itind = ftind*NTBMX + 0.5 - zexm2 = exp_tbl(itind) - endif - zexp2 = f_one / zexm2 - ze1r45 = zr4*zexp1 + zr5*zexm1 - -! ... collimated beam - if (ze1r45>=-eps1 .and. ze1r45<=eps1) then - zrefb(kp) = eps1 - ztrab(kp) = zexm2 - else - zden1 = zssa1 / ze1r45 - zrefb(kp) = max(f_zero, min(f_one, & - & (zr1*zexp1 - zr2*zexm1 - zr3*zexm2)*zden1 )) - ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one & - & - (zt1*zexp1 - zt2*zexm1 - zt3*zexp2)*zden1) )) - endif - -! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) - zrefd(kp) = max(f_zero, min(f_one, & - & zgam2*(zexp1 - zexm1)*zden1 )) - ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) - endif ! end if_zssaw_block - -!> - Calculate direct beam transmittance. use exponential lookup table -!! for transmittance, or expansion of exponential for low optical depth. - - zr1 = ztau1 * sntz - if ( zr1 <= od_lo ) then - zexp3 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp3 = exp_tbl(itind) - endif - - ztdbt(k) = zexp3 * ztdbt(kp) - zldbt(kp) = zexp3 - -!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. -! (must use 'orig', unscaled cloud optical depth) - - zr1 = ztau0 * sntz - if ( zr1 <= od_lo ) then - zexp4 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp4 = exp_tbl(itind) - endif - - zldbt0(k) = zexp4 - ztdbt0 = zexp4 * ztdbt0 - enddo ! end do_k_loop - -!> -# Call vrtqdr(), to compute the upward and downward radiation fluxes. - call vrtqdr & -! --- inputs: - & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & - & nlay, nlp1, & -! --- outputs: - & zfu, zfd & - & ) - -!> -# Compute upward and downward fluxes at levels. - do k = 1, nlp1 - fxup0(k,ib) = fxup0(k,ib) + zsolar*zfu(k) - fxdn0(k,ib) = fxdn0(k,ib) + zsolar*zfd(k) - enddo - -!> -# Compute surface downward beam/diffuse flux components. - zb1 = zsolar*ztdbt0 - zb2 = zsolar*(zfd(1) - ztdbt0) - - if (ibd /= 0) then - sfbm0(ibd) = sfbm0(ibd) + zb1 - sfdf0(ibd) = sfdf0(ibd) + zb2 - else - zf1 = 0.5 * zb1 - zf2 = 0.5 * zb2 - sfbm0(1) = sfbm0(1) + zf1 - sfdf0(1) = sfdf0(1) + zf2 - sfbm0(2) = sfbm0(2) + zf1 - sfdf0(2) = sfdf0(2) + zf2 - endif -! sfbm0(ibd) = sfbm0(ibd) + zsolar*ztdbt0 -! sfdf0(ibd) = sfdf0(ibd) + zsolar*(zfd(1) - ztdbt0) - -!> -# Compute total sky optical parameters, layer reflectance and -!! transmittance. -! - Set up toa direct beam and surface values (beam and diff) -! - Delta scaling for total-sky condition -! - General two-stream expressions for physparam::iswmode -! - Compute homogeneous reflectance and transmittance for -! conservative scattering and non-conservative scattering -! - Pre-delta-scaling clear and cloudy direct beam transmittance -! - Call swflux() to compute the upward and downward radiation fluxes - - if ( cf1 > eps ) then - -!> - Set up toa direct beam and surface values (beam and diff). - ztdbt0 = f_one - zldbt(1) = f_zero - - do k = nlay, 1, -1 - kp = k + 1 - if ( cldfmc(k,jg) > ftiny ) then ! it is a cloudy-layer - - ztau0 = ztaus(k) + taucw(k,ib) - zssa0 = zssas(k) + ssacw(k,ib) - zasy0 = zasys(k) + asycw(k,ib) - zssaw = min(oneminus, zssa0 / ztau0) - zasyw = zasy0 / max(ftiny, zssa0) - -!> - Perform delta scaling for total-sky condition. - za1 = zasyw * zasyw - za2 = zssaw * za1 - - ztau1 = (f_one - za2) * ztau0 - zssa1 = (zssaw - za2) / (f_one - za2) -!org zasy1 = (zasyw - za1) / (f_one - za1) - zasy1 = zasyw / (f_one + zasyw) - zasy3 = 0.75 * zasy1 - -!> - Perform general two-stream expressions. - if ( iswmode == 1 ) then - zgam1 = 1.75 - zssa1 * (f_one + zasy3) - zgam2 =-0.25 + zssa1 * (f_one - zasy3) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 2 ) then ! pifm - zgam1 = 2.0 - zssa1 * (1.25 + zasy3) - zgam2 = 0.75* zssa1 * (f_one- zasy1) - zgam3 = 0.5 - zasy3 * cosz - elseif ( iswmode == 3 ) then ! discrete ordinates - zgam1 = zsr3 * (2.0 - zssa1 * (1.0 + zasy1)) * 0.5 - zgam2 = zsr3 * zssa1 * (1.0 - zasy1) * 0.5 - zgam3 = (1.0 - zsr3 * zasy1 * cosz) * 0.5 - endif - zgam4 = f_one - zgam3 - -!> - Compute homogeneous reflectance and transmittance for both convertive -!! and non-convertive scattering. - - if ( zssaw >= zcrit ) then ! for conservative scattering - za1 = zgam1 * cosz - zgam3 - za2 = zgam1 * ztau1 - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( ztau1*sntz , 500.0 ) - if ( zb1 <= od_lo ) then - zb2 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zb2 = exp_tbl(itind) - endif - -! ... collimated beam - zrefb(kp) = max(f_zero, min(f_one, & - & (za2 - za1*(f_one - zb2))/(f_one + za2) )) - ztrab(kp) = max(f_zero, min(f_one, f_one-zrefb(kp))) - -! ... isotropic incidence - zrefd(kp) = max(f_zero, min(f_one, za2 / (f_one+za2) )) - ztrad(kp) = max(f_zero, min(f_one, f_one - zrefd(kp) )) - - else ! for non-conservative scattering - za1 = zgam1*zgam4 + zgam2*zgam3 - za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk - - zrp = zrk * cosz - zrp1 = f_one + zrp - zrm1 = f_one - zrp - zrpp1= f_one - zrp*zrp - zrpp = sign( max(flimit, abs(zrpp1)), zrpp1 ) ! avoid numerical singularity - zrkg1= zrk + zgam1 - zrkg3= zrk * zgam3 - zrkg4= zrk * zgam4 - - zr1 = zrm1 * (za2 + zrkg3) - zr2 = zrp1 * (za2 - zrkg3) - zr3 = zrk2 * (zgam3 - za2*cosz) - zr4 = zrpp * zrkg1 - zr5 = zrpp * (zrk - zgam1) - - zt1 = zrp1 * (za1 + zrkg4) - zt2 = zrm1 * (za1 - zrkg4) - zt3 = zrk2 * (zgam4 + za1*cosz) - -! --- ... use exponential lookup table for transmittance, or expansion -! of exponential for low optical depth - - zb1 = min ( zrk*ztau1, 500.0 ) - if ( zb1 <= od_lo ) then - zexm1 = f_one - zb1 + 0.5*zb1*zb1 - else - ftind = zb1 / (bpade + zb1) - itind = ftind*NTBMX + 0.5 - zexm1 = exp_tbl(itind) - endif - zexp1 = f_one / zexm1 - - zb2 = min ( ztau1*sntz, 500.0 ) - if ( zb2 <= od_lo ) then - zexm2 = f_one - zb2 + 0.5*zb2*zb2 - else - ftind = zb2 / (bpade + zb2) - itind = ftind*NTBMX + 0.5 - zexm2 = exp_tbl(itind) - endif - zexp2 = f_one / zexm2 - ze1r45 = zr4*zexp1 + zr5*zexm1 - -! ... collimated beam - if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then - zrefb(kp) = eps1 - ztrab(kp) = zexm2 - else - zden1 = zssa1 / ze1r45 - zrefb(kp) = max(f_zero, min(f_one, & - & (zr1*zexp1-zr2*zexm1-zr3*zexm2)*zden1 )) - ztrab(kp) = max(f_zero, min(f_one, zexm2*(f_one - & - & (zt1*zexp1-zt2*zexm1-zt3*zexp2)*zden1) )) - endif - -! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) - zrefd(kp) = max(f_zero, min(f_one, & - & zgam2*(zexp1 - zexm1)*zden1 )) - ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) - endif ! end if_zssaw_block - -! --- ... direct beam transmittance. use exponential lookup table -! for transmittance, or expansion of exponential for low -! optical depth - - zr1 = ztau1 * sntz - if ( zr1 <= od_lo ) then - zexp3 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp3 = exp_tbl(itind) - endif - - zldbt(kp) = zexp3 - ztdbt(k) = zexp3 * ztdbt(kp) - -! --- ... pre-delta-scaling clear and cloudy direct beam transmittance -! (must use 'orig', unscaled cloud optical depth) - - zr1 = ztau0 * sntz - if ( zr1 <= od_lo ) then - zexp4 = f_one - zr1 + 0.5*zr1*zr1 - else - ftind = zr1 / (bpade + zr1) - itind = max(0, min(NTBMX, int(0.5+NTBMX*ftind) )) - zexp4 = exp_tbl(itind) - endif - - ztdbt0 = zexp4 * ztdbt0 - - else ! if_cldfmc_block --- it is a clear layer - -! --- ... direct beam transmittance - ztdbt(k) = zldbt(kp) * ztdbt(kp) - -!> - Calculate pre-delta-scaling clear and cloudy direct beam transmittance. - ztdbt0 = zldbt0(k) * ztdbt0 - - endif ! end if_cldfmc_block - enddo ! end do_k_loop - -!> -# Call vrtqdr(), to perform vertical quadrature - - call vrtqdr & -! --- inputs: - & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & - & nlay, nlp1, & -! --- outputs: - & zfu, zfd & - & ) - -! --- ... compute upward and downward fluxes at levels - do k = 1, nlp1 - fxupc(k,ib) = fxupc(k,ib) + zsolar*zfu(k) - fxdnc(k,ib) = fxdnc(k,ib) + zsolar*zfd(k) - enddo - -!> -# Process and save outputs. -!! - surface downward beam/diffused flux components - zb1 = zsolar*ztdbt0 - zb2 = zsolar*(zfd(1) - ztdbt0) - - if (ibd /= 0) then - sfbmc(ibd) = sfbmc(ibd) + zb1 - sfdfc(ibd) = sfdfc(ibd) + zb2 - else - zf1 = 0.5 * zb1 - zf2 = 0.5 * zb2 - sfbmc(1) = sfbmc(1) + zf1 - sfdfc(1) = sfdfc(1) + zf2 - sfbmc(2) = sfbmc(2) + zf1 - sfdfc(2) = sfdfc(2) + zf2 - endif -! sfbmc(ibd) = sfbmc(ibd) + zsolar*ztdbt0 -! sfdfc(ibd) = sfdfc(ibd) + zsolar*(zfd(1) - ztdbt0) - - endif ! end if_cf1_block - - enddo lab_do_jg - -! --- ... end of g-point loop - - do ib = 1, nbdsw - ftoadc = ftoadc + fxdn0(nlp1,ib) - ftoau0 = ftoau0 + fxup0(nlp1,ib) - fsfcu0 = fsfcu0 + fxup0(1,ib) - fsfcd0 = fsfcd0 + fxdn0(1,ib) - enddo - -!> - uv-b surface downward flux - ibd = nuvb - nblow + 1 - suvbf0 = fxdn0(1,ibd) - - if ( cf1 <= eps ) then ! clear column, set total-sky=clear-sky fluxes - do ib = 1, nbdsw - do k = 1, nlp1 - fxupc(k,ib) = fxup0(k,ib) - fxdnc(k,ib) = fxdn0(k,ib) - enddo - enddo - - ftoauc = ftoau0 - fsfcuc = fsfcu0 - fsfcdc = fsfcd0 - -!> - surface downward beam/diffused flux components - sfbmc(1) = sfbm0(1) - sfdfc(1) = sfdf0(1) - sfbmc(2) = sfbm0(2) - sfdfc(2) = sfdf0(2) - -!> - uv-b surface downward flux - suvbfc = suvbf0 - else ! cloudy column, compute total-sky fluxes - do ib = 1, nbdsw - ftoauc = ftoauc + fxupc(nlp1,ib) - fsfcuc = fsfcuc + fxupc(1,ib) - fsfcdc = fsfcdc + fxdnc(1,ib) - enddo - -!! --- ... uv-b surface downward flux - suvbfc = fxdnc(1,ibd) - endif ! end if_cf1_block - - return -!................................... - end subroutine spcvrtm -!! @} -!----------------------------------- - -!>\ingroup module_radsw_main -!> This subroutine is called by spcvrtc() and spcvrtm(), and computes -!! the upward and downward radiation fluxes. -!!\param zrefb layer direct beam reflectivity -!!\param zrefd layer diffuse reflectivity -!!\param ztrab layer direct beam transmissivity -!!\param ztrad layer diffuse transmissivity -!!\param zldbt layer mean beam transmittance -!!\param ztdbt total beam transmittance at levels -!!\param NLAY, NLP1 number of layers/levels -!!\param zfu upward flux at layer interface -!!\param zfd downward flux at layer interface -!!\section General_vrtqdr vrtqdr General Algorithm -!> @{ -!----------------------------------- - subroutine vrtqdr & - & ( zrefb,zrefd,ztrab,ztrad,zldbt,ztdbt, & ! inputs - & NLAY, NLP1, & - & zfu, zfd & ! outputs: - & ) - -! =================== program usage description =================== ! -! ! -! purpose: computes the upward and downward radiation fluxes ! -! ! -! interface: "vrtqdr" is called by "spcvrc" and "spcvrm" ! -! ! -! subroutines called : none ! -! ! -! ==================== defination of variables ==================== ! -! ! -! input variables: ! -! zrefb(NLP1) - layer direct beam reflectivity ! -! zrefd(NLP1) - layer diffuse reflectivity ! -! ztrab(NLP1) - layer direct beam transmissivity ! -! ztrad(NLP1) - layer diffuse transmissivity ! -! zldbt(NLP1) - layer mean beam transmittance ! -! ztdbt(NLP1) - total beam transmittance at levels ! -! NLAY, NLP1 - number of layers/levels ! -! ! -! output variables: ! -! zfu (NLP1) - upward flux at layer interface ! -! zfd (NLP1) - downward flux at layer interface ! -! ! -! ******************************************************************* ! -! ====================== end of description block ================= ! - -! --- inputs: - integer, intent(in) :: nlay, nlp1 - - real (kind=kind_phys), dimension(nlp1), intent(in) :: zrefb, & - & zrefd, ztrab, ztrad, ztdbt, zldbt - -! --- outputs: - real (kind=kind_phys), dimension(nlp1), intent(out) :: zfu, zfd - -! --- locals: - real (kind=kind_phys), dimension(nlp1) :: zrupb,zrupd,zrdnd,ztdn - - real (kind=kind_phys) :: zden1 - - integer :: k, kp -! -!===> ... begin here -! - -!> -# Link lowest layer with surface. - zrupb(1) = zrefb(1) ! direct beam - zrupd(1) = zrefd(1) ! diffused - -!> -# Pass from bottom to top. - do k = 1, nlay - kp = k + 1 - - zden1 = f_one / ( f_one - zrupd(k)*zrefd(kp) ) - zrupb(kp) = zrefb(kp) + ( ztrad(kp) * & - & ( (ztrab(kp) - zldbt(kp))*zrupd(k) + & - & zldbt(kp)*zrupb(k)) ) * zden1 - zrupd(kp) = zrefd(kp) + ztrad(kp)*ztrad(kp)*zrupd(k)*zden1 - enddo - -!> -# Upper boundary conditions - ztdn (nlp1) = f_one - zrdnd(nlp1) = f_zero - ztdn (nlay) = ztrab(nlp1) - zrdnd(nlay) = zrefd(nlp1) - -!> -# Pass from top to bottom - do k = nlay, 2, -1 - zden1 = f_one / (f_one - zrefd(k)*zrdnd(k)) - ztdn (k-1) = ztdbt(k)*ztrab(k) + ( ztrad(k) * & - & ( (ztdn(k) - ztdbt(k)) + ztdbt(k) * & - & zrefb(k)*zrdnd(k) )) * zden1 - zrdnd(k-1) = zrefd(k) + ztrad(k)*ztrad(k)*zrdnd(k)*zden1 - enddo - -!> -# Up and down-welling fluxes at levels. - do k = 1, nlp1 - zden1 = f_one / (f_one - zrdnd(k)*zrupd(k)) - zfu(k) = ( ztdbt(k)*zrupb(k) + & - & (ztdn(k) - ztdbt(k))*zrupd(k) ) * zden1 - zfd(k) = ztdbt(k) + ( ztdn(k) - ztdbt(k) + & - & ztdbt(k)*zrupb(k)*zrdnd(k) ) * zden1 - enddo - - return -!................................... - end subroutine vrtqdr -!----------------------------------- -!> @} - -!>\ingroup module_radsw_main -!> This subroutine calculates optical depths for gaseous absorption and -!! rayleigh scattering -!!\n subroutine called taumol## (## = 16-29) -!!\param colamt column amounts of absorbing gases the index -!! are for h2o, co2, o3, n2o, ch4, and o2, -!! respectively \f$(mol/cm^2)\f$ -!!\param colmol total column amount (dry air+water vapor) -!!\param fac00,fac01,fac10,fac11 for each layer, these are factors that are -!! needed to compute the interpolation factors -!! that multiply the appropriate reference -!! k-values. a value of 0/1 for i,j indicates -!! that the corresponding factor multiplies -!! reference k-value for the lower/higher of the -!! two appropriate temperatures, and altitudes, -!! respectively. -!!\param jp the index of the lower (in altitude) of the -!! two appropriate ref pressure levels needed -!! for interpolation. -!!\param jt, jt1 the indices of the lower of the two approp -!! ref temperatures needed for interpolation -!! (for pressure levels jp and jp+1, respectively) -!!\param laytrop tropopause layer index -!!\param forfac scale factor needed to foreign-continuum. -!!\param forfrac factor needed for temperature interpolation -!!\param indfor index of the lower of the two appropriate -!! reference temperatures needed for -!! foreign-continuum interpolation -!!\param selffac scale factor needed to h2o self-continuum. -!!\param selffrac factor needed for temperature interpolation -!! of reference h2o self-continuum data -!!\param indself index of the lower of the two appropriate -!! reference temperatures needed for the -!! self-continuum interpolation -!!\param nlay number of vertical layers -!!\param sfluxzen spectral distribution of incoming solar flux -!!\param taug spectral optical depth for gases -!!\param taur opt depth for rayleigh scattering -!>\section gen_al_taumol taumol General Algorithm -!! @{ -!----------------------------------- - subroutine taumol & - & ( colamt,colmol,fac00,fac01,fac10,fac11,jp,jt,jt1,laytrop, & ! --- inputs - & forfac,forfrac,indfor,selffac,selffrac,indself, nlay, & - & sfluxzen, taug, taur & ! --- outputs - & ) - -! ================== program usage description ================== ! -! ! -! description: ! -! calculate optical depths for gaseous absorption and rayleigh ! -! scattering. ! -! ! -! subroutines called: taugb## (## = 16 - 29) ! -! ! -! ==================== defination of variables ==================== ! -! ! -! inputs: size ! -! colamt - real, column amounts of absorbing gases the index ! -! are for h2o, co2, o3, n2o, ch4, and o2, ! -! respectively (molecules/cm**2) nlay*maxgas! -! colmol - real, total column amount (dry air+water vapor) nlay ! -! facij - real, for each layer, these are factors that are ! -! needed to compute the interpolation factors ! -! that multiply the appropriate reference k- ! -! values. a value of 0/1 for i,j indicates ! -! that the corresponding factor multiplies ! -! reference k-value for the lower/higher of the ! -! two appropriate temperatures, and altitudes, ! -! respectively. naly ! -! jp - real, the index of the lower (in altitude) of the ! -! two appropriate ref pressure levels needed ! -! for interpolation. nlay ! -! jt, jt1 - integer, the indices of the lower of the two approp ! -! ref temperatures needed for interpolation (for ! -! pressure levels jp and jp+1, respectively) nlay ! -! laytrop - integer, tropopause layer index 1 ! -! forfac - real, scale factor needed to foreign-continuum. nlay ! -! forfrac - real, factor needed for temperature interpolation nlay ! -! indfor - integer, index of the lower of the two appropriate ! -! reference temperatures needed for foreign- ! -! continuum interpolation nlay ! -! selffac - real, scale factor needed to h2o self-continuum. nlay ! -! selffrac- real, factor needed for temperature interpolation ! -! of reference h2o self-continuum data nlay ! -! indself - integer, index of the lower of the two appropriate ! -! reference temperatures needed for the self- ! -! continuum interpolation nlay ! -! nlay - integer, number of vertical layers 1 ! -! ! -! output: ! -! sfluxzen- real, spectral distribution of incoming solar flux ngptsw! -! taug - real, spectral optical depth for gases nlay*ngptsw! -! taur - real, opt depth for rayleigh scattering nlay*ngptsw! -! ! -! =================================================================== ! -! ************ original subprogram description *************** ! -! ! -! optical depths developed for the ! -! ! -! rapid radiative transfer model (rrtm) ! -! ! -! atmospheric and environmental research, inc. ! -! 131 hartwell avenue ! -! lexington, ma 02421 ! -! ! -! ! -! eli j. mlawer ! -! jennifer delamere ! -! steven j. taubman ! -! shepard a. clough ! -! ! -! ! -! ! -! email: mlawer@aer.com ! -! email: jdelamer@aer.com ! -! ! -! the authors wish to acknowledge the contributions of the ! -! following people: patrick d. brown, michael j. iacono, ! -! ronald e. farren, luke chen, robert bergstrom. ! -! ! -! ******************************************************************* ! -! ! -! taumol ! -! ! -! this file contains the subroutines taugbn (where n goes from ! -! 16 to 29). taugbn calculates the optical depths and Planck ! -! fractions per g-value and layer for band n. ! -! ! -! output: optical depths (unitless) ! -! fractions needed to compute planck functions at every layer ! -! and g-value ! -! ! -! modifications: ! -! ! -! revised: adapted to f90 coding, j.-j.morcrette, ecmwf, feb 2003 ! -! revised: modified for g-point reduction, mjiacono, aer, dec 2003 ! -! revised: reformatted for consistency with rrtmg_lw, mjiacono, aer, ! -! jul 2006 ! -! ! -! ******************************************************************* ! -! ====================== end of description block ================= ! - -! --- inputs: - integer, intent(in) :: nlay, laytrop - - integer, dimension(nlay), intent(in) :: indfor, indself, & - & jp, jt, jt1 - - real (kind=kind_phys), dimension(nlay), intent(in) :: colmol, & - & fac00, fac01, fac10, fac11, forfac, forfrac, selffac, & - & selffrac - - real (kind=kind_phys), dimension(nlay,maxgas),intent(in) :: colamt - -! --- outputs: - real (kind=kind_phys), dimension(ngptsw), intent(out) :: sfluxzen - - real (kind=kind_phys), dimension(nlay,ngptsw), intent(out) :: & - & taug, taur - -! --- locals: - real (kind=kind_phys) :: fs, speccomb, specmult, colm1, colm2 - - integer, dimension(nlay,nblow:nbhgh) :: id0, id1 - - integer :: ibd, j, jb, js, k, klow, khgh, klim, ks, njb, ns -! -!===> ... begin here -! -! --- ... loop over each spectral band - - do jb = nblow, nbhgh - -! --- ... indices for layer optical depth - - do k = 1, laytrop - id0(k,jb) = ((jp(k)-1)*5 + (jt (k)-1)) * nspa(jb) - id1(k,jb) = ( jp(k) *5 + (jt1(k)-1)) * nspa(jb) - enddo - - do k = laytrop+1, nlay - id0(k,jb) = ((jp(k)-13)*5 + (jt (k)-1)) * nspb(jb) - id1(k,jb) = ((jp(k)-12)*5 + (jt1(k)-1)) * nspb(jb) - enddo - -! --- ... calculate spectral flux at toa - - ibd = ibx(jb) - njb = ng (jb) - ns = ngs(jb) - - select case (jb) - - case (16, 20, 23, 25, 26, 29) - - do j = 1, njb - sfluxzen(ns+j) = sfluxref01(j,1,ibd) - enddo - - case (27) - - do j = 1, njb - sfluxzen(ns+j) = scalekur * sfluxref01(j,1,ibd) - enddo - - case default - - if (jb==17 .or. jb==28) then - - ks = nlay - lab_do_k1 : do k = laytrop, nlay-1 - if (jp(k)=layreffr(jb)) then - ks = k + 1 - exit lab_do_k1 - endif - enddo lab_do_k1 - - colm1 = colamt(ks,ix1(jb)) - colm2 = colamt(ks,ix2(jb)) - speccomb = colm1 + strrat(jb)*colm2 - specmult = specwt(jb) * min( oneminus, colm1/speccomb ) - js = 1 + int( specmult ) - fs = mod(specmult, f_one) - - do j = 1, njb - sfluxzen(ns+j) = sfluxref02(j,js,ibd) & - & + fs * (sfluxref02(j,js+1,ibd) - sfluxref02(j,js,ibd)) - enddo - - else - - ks = laytrop - lab_do_k2 : do k = 1, laytrop-1 - if (jp(k)=layreffr(jb)) then - ks = k + 1 - exit lab_do_k2 - endif - enddo lab_do_k2 - - colm1 = colamt(ks,ix1(jb)) - colm2 = colamt(ks,ix2(jb)) - speccomb = colm1 + strrat(jb)*colm2 - specmult = specwt(jb) * min( oneminus, colm1/speccomb ) - js = 1 + int( specmult ) - fs = mod(specmult, f_one) - - do j = 1, njb - sfluxzen(ns+j) = sfluxref03(j,js,ibd) & - & + fs * (sfluxref03(j,js+1,ibd) - sfluxref03(j,js,ibd)) - enddo - - endif - - end select - - enddo - -!> - Call taumol## (##: 16-29) to calculate layer optical depth. - -!> - call taumol16() - call taumol16 -!> - call taumol17() - call taumol17 -!> - call taumol18() - call taumol18 -!> - call taumol19() - call taumol19 -!> - call taumol20() - call taumol20 -!> - call taumol21() - call taumol21 -!> - call taumol22() - call taumol22 -!> - call taumol23() - call taumol23 -!> - call taumol24() - call taumol24 -!> - call taumol25() - call taumol25 -!> - call taumol26() - call taumol26 -!> - call taumol27() - call taumol27 -!> - call taumol28() - call taumol28 -!> - call taumol29() - call taumol29 - - -! ================= - contains -! ================= - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 16: 2600-3250 -!! cm-1 (low - h2o,ch4; high - ch4) -!----------------------------------- - subroutine taumol16 -!................................... - -! ------------------------------------------------------------------ ! -! band 16: 2600-3250 cm-1 (low - h2o,ch4; high - ch4) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb16 - -! --- locals: - - real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: inds, indf, indsp, indfp, j, js, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG16 - taur(k,NS16+j) = tauray - enddo - enddo - - do k = 1, laytrop - speccomb = colamt(k,1) + strrat(16)*colamt(k,5) - specmult = 8.0 * min( oneminus, colamt(k,1)/speccomb ) - - js = 1 + int( specmult ) - fs = mod( specmult, f_one ) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,16) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,16) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG16 - taug(k,NS16+j) = speccomb & - & *( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & - & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & - & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) - enddo - enddo - - do k = laytrop+1, nlay - ind01 = id0(k,16) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,16) + 1 - ind12 = ind11 + 1 - - do j = 1, NG16 - taug(k,NS16+j) = colamt(k,5) & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) - enddo - enddo - - return -!................................... - end subroutine taumol16 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 17: 3250-4000 -!! cm-1 (low - h2o,co2; high - h2o,co2) -!----------------------------------- - subroutine taumol17 -!................................... - -! ------------------------------------------------------------------ ! -! band 17: 3250-4000 cm-1 (low - h2o,co2; high - h2o,co2) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb17 - -! --- locals: - real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: inds, indf, indsp, indfp, j, js, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG17 - taur(k,NS17+j) = tauray - enddo - enddo - - do k = 1, laytrop - speccomb = colamt(k,1) + strrat(17)*colamt(k,2) - specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,17) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,17) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG17 - taug(k,NS17+j) = speccomb & - & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & - & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & - & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) - enddo - enddo - - do k = laytrop+1, nlay - speccomb = colamt(k,1) + strrat(17)*colamt(k,2) - specmult = 4.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,17) + js - ind02 = ind01 + 1 - ind03 = ind01 + 5 - ind04 = ind01 + 6 - ind11 = id1(k,17) + js - ind12 = ind11 + 1 - ind13 = ind11 + 5 - ind14 = ind11 + 6 - - indf = indfor(k) - indfp= indf + 1 - - do j = 1, NG17 - taug(k,NS17+j) = speccomb & - & * ( fac000 * absb(ind01,j) + fac100 * absb(ind02,j) & - & + fac010 * absb(ind03,j) + fac110 * absb(ind04,j) & - & + fac001 * absb(ind11,j) + fac101 * absb(ind12,j) & - & + fac011 * absb(ind13,j) + fac111 * absb(ind14,j) ) & - & + colamt(k,1) * forfac(k) * (forref(indf,j) & - & + forfrac(k) * (forref(indfp,j) - forref(indf,j))) - enddo - enddo - - return -!................................... - end subroutine taumol17 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 18: 4000-4650 -!! cm-1 (low - h2o,ch4; high - ch4) -!----------------------------------- - subroutine taumol18 -!................................... - -! ------------------------------------------------------------------ ! -! band 18: 4000-4650 cm-1 (low - h2o,ch4; high - ch4) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb18 - -! --- locals: - real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: inds, indf, indsp, indfp, j, js, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG18 - taur(k,NS18+j) = tauray - enddo - enddo - - do k = 1, laytrop - speccomb = colamt(k,1) + strrat(18)*colamt(k,5) - specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,18) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,18) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG18 - taug(k,NS18+j) = speccomb & - & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & - & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & - & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) - enddo - enddo - - do k = laytrop+1, nlay - ind01 = id0(k,18) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,18) + 1 - ind12 = ind11 + 1 - - do j = 1, NG18 - taug(k,NS18+j) = colamt(k,5) & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) - enddo - enddo - - return -!................................... - end subroutine taumol18 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 19: 4650-5150 -!! cm-1 (low - h2o,co2; high - co2) -!----------------------------------- - subroutine taumol19 -!................................... - -! ------------------------------------------------------------------ ! -! band 19: 4650-5150 cm-1 (low - h2o,co2; high - co2) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb19 - -! --- locals: - real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: inds, indf, indsp, indfp, j, js, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG19 - taur(k,NS19+j) = tauray - enddo - enddo - - do k = 1, laytrop - speccomb = colamt(k,1) + strrat(19)*colamt(k,2) - specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,19) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,19) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG19 - taug(k,NS19+j) = speccomb & - & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & - & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & - & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) - enddo - enddo - - do k = laytrop+1, nlay - ind01 = id0(k,19) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,19) + 1 - ind12 = ind11 + 1 - - do j = 1, NG19 - taug(k,NS19+j) = colamt(k,2) & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) - enddo - enddo - -!................................... - end subroutine taumol19 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 20: 5150-6150 -!! cm-1 (low - h2o; high - h2o) -!----------------------------------- - subroutine taumol20 -!................................... - -! ------------------------------------------------------------------ ! -! band 20: 5150-6150 cm-1 (low - h2o; high - h2o) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb20 - -! --- locals: - real (kind=kind_phys) :: tauray - - integer :: ind01, ind02, ind11, ind12 - integer :: inds, indf, indsp, indfp, j, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG20 - taur(k,NS20+j) = tauray - enddo - enddo - - do k = 1, laytrop - ind01 = id0(k,20) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,20) + 1 - ind12 = ind11 + 1 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG20 - taug(k,NS20+j) = colamt(k,1) & - & * ( (fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & - & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j)) & - & + selffac(k) * (selfref(inds,j) + selffrac(k) & - & * (selfref(indsp,j) - selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j))) ) & - & + colamt(k,5) * absch4(j) - enddo - enddo - - do k = laytrop+1, nlay - ind01 = id0(k,20) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,20) + 1 - ind12 = ind11 + 1 - - indf = indfor(k) - indfp= indf + 1 - - do j = 1, NG20 - taug(k,NS20+j) = colamt(k,1) & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j))) ) & - & + colamt(k,5) * absch4(j) - enddo - enddo - - return -!................................... - end subroutine taumol20 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 21: 6150-7700 -!! cm-1 (low - h2o,co2; high - h2o,co2) -!----------------------------------- - subroutine taumol21 -!................................... - -! ------------------------------------------------------------------ ! -! band 21: 6150-7700 cm-1 (low - h2o,co2; high - h2o,co2) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb21 - -! --- locals: - real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: inds, indf, indsp, indfp, j, js, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG21 - taur(k,NS21+j) = tauray - enddo - enddo - - do k = 1, laytrop - speccomb = colamt(k,1) + strrat(21)*colamt(k,2) - specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,21) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,21) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG21 - taug(k,NS21+j) = speccomb & - & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & - & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & - & + selffrac(k) * (selfref(indsp,j) - selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) - enddo - enddo - - do k = laytrop+1, nlay - speccomb = colamt(k,1) + strrat(21)*colamt(k,2) - specmult = 4.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,21) + js - ind02 = ind01 + 1 - ind03 = ind01 + 5 - ind04 = ind01 + 6 - ind11 = id1(k,21) + js - ind12 = ind11 + 1 - ind13 = ind11 + 5 - ind14 = ind11 + 6 - - indf = indfor(k) - indfp= indf + 1 - - do j = 1, NG21 - taug(k,NS21+j) = speccomb & - & * ( fac000 * absb(ind01,j) + fac100 * absb(ind02,j) & - & + fac010 * absb(ind03,j) + fac110 * absb(ind04,j) & - & + fac001 * absb(ind11,j) + fac101 * absb(ind12,j) & - & + fac011 * absb(ind13,j) + fac111 * absb(ind14,j) ) & - & + colamt(k,1) * forfac(k) * (forref(indf,j) & - & + forfrac(k) * (forref(indfp,j) - forref(indf,j))) - enddo - enddo - -!................................... - end subroutine taumol21 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 22: 7700-8050 -!! cm-1 (low - h2o,o2; high - o2) -!----------------------------------- - subroutine taumol22 -!................................... - -! ------------------------------------------------------------------ ! -! band 22: 7700-8050 cm-1 (low - h2o,o2; high - o2) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb22 - -! --- locals: - real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111, & - & o2adj, o2cont, o2tem - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: inds, indf, indsp, indfp, j, js, k - -! -!===> ... begin here -! -! --- ... the following factor is the ratio of total o2 band intensity (lines -! and mate continuum) to o2 band intensity (line only). it is needed -! to adjust the optical depths since the k's include only lines. - - o2adj = 1.6 - o2tem = 4.35e-4 / (350.0*2.0) - - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG22 - taur(k,NS22+j) = tauray - enddo - enddo - - do k = 1, laytrop - o2cont = o2tem * colamt(k,6) - speccomb = colamt(k,1) + strrat(22)*colamt(k,6) - specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,22) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,22) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG22 - taug(k,NS22+j) = speccomb & - & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & - & + colamt(k,1) * (selffac(k) * (selfref(inds,j) & - & + selffrac(k) * (selfref(indsp,j)-selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) + o2cont - enddo - enddo - - do k = laytrop+1, nlay - o2cont = o2tem * colamt(k,6) - - ind01 = id0(k,22) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,22) + 1 - ind12 = ind11 + 1 - - do j = 1, NG22 - taug(k,NS22+j) = colamt(k,6) * o2adj & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) & - & + o2cont - enddo - enddo - - return -!................................... - end subroutine taumol22 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 23: 8050-12850 -!! cm-1 (low - h2o; high - nothing) -!----------------------------------- - subroutine taumol23 -!................................... - -! ------------------------------------------------------------------ ! -! band 23: 8050-12850 cm-1 (low - h2o; high - nothing) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb23 - -! --- locals: - integer :: ind01, ind02, ind11, ind12 - integer :: inds, indf, indsp, indfp, j, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - do j = 1, NG23 - taur(k,NS23+j) = colmol(k) * rayl(j) - enddo - enddo - - do k = 1, laytrop - ind01 = id0(k,23) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,23) + 1 - ind12 = ind11 + 1 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG23 - taug(k,NS23+j) = colamt(k,1) * (givfac & - & * ( fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & - & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) & - & + selffac(k) * (selfref(inds,j) + selffrac(k) & - & * (selfref(indsp,j) - selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) - enddo - enddo - - do k = laytrop+1, nlay - do j = 1, NG23 - taug(k,NS23+j) = f_zero - enddo - enddo - -!................................... - end subroutine taumol23 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 24: 12850-16000 -!! cm-1 (low - h2o,o2; high - o2) -!----------------------------------- - subroutine taumol24 -!................................... - -! ------------------------------------------------------------------ ! -! band 24: 12850-16000 cm-1 (low - h2o,o2; high - o2) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb24 - -! --- locals: - real (kind=kind_phys) :: speccomb, specmult, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: inds, indf, indsp, indfp, j, js, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, laytrop - speccomb = colamt(k,1) + strrat(24)*colamt(k,6) - specmult = 8.0 * min(oneminus, colamt(k,1) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,24) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,24) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG24 - taug(k,NS24+j) = speccomb & - & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) & - & + colamt(k,3) * abso3a(j) + colamt(k,1) & - & * (selffac(k) * (selfref(inds,j) + selffrac(k) & - & * (selfref(indsp,j) - selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) - - taur(k,NS24+j) = colmol(k) & - & * (rayla(j,js) + fs*(rayla(j,js+1) - rayla(j,js))) - enddo - enddo - - do k = laytrop+1, nlay - ind01 = id0(k,24) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,24) + 1 - ind12 = ind11 + 1 - - do j = 1, NG24 - taug(k,NS24+j) = colamt(k,6) & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) & - & + colamt(k,3) * abso3b(j) - - taur(k,NS24+j) = colmol(k) * raylb(j) - enddo - enddo - - return -!................................... - end subroutine taumol24 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 25: 16000-22650 -!! cm-1 (low - h2o; high - nothing) -!----------------------------------- - subroutine taumol25 -!................................... - -! ------------------------------------------------------------------ ! -! band 25: 16000-22650 cm-1 (low - h2o; high - nothing) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb25 - -! --- locals: - integer :: ind01, ind02, ind11, ind12 - integer :: j, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - do j = 1, NG25 - taur(k,NS25+j) = colmol(k) * rayl(j) - enddo - enddo - - do k = 1, laytrop - ind01 = id0(k,25) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,25) + 1 - ind12 = ind11 + 1 - - do j = 1, NG25 - taug(k,NS25+j) = colamt(k,1) & - & * ( fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & - & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) & - & + colamt(k,3) * abso3a(j) - enddo - enddo - - do k = laytrop+1, nlay - do j = 1, NG25 - taug(k,NS25+j) = colamt(k,3) * abso3b(j) - enddo - enddo - - return -!................................... - end subroutine taumol25 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 26: 22650-29000 -!! cm-1 (low - nothing; high - nothing) -!----------------------------------- - subroutine taumol26 -!................................... - -! ------------------------------------------------------------------ ! -! band 26: 22650-29000 cm-1 (low - nothing; high - nothing) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb26 - -! --- locals: - integer :: j, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - do j = 1, NG26 - taug(k,NS26+j) = f_zero - taur(k,NS26+j) = colmol(k) * rayl(j) - enddo - enddo - - return -!................................... - end subroutine taumol26 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 27: 29000-38000 -!! cm-1 (low - o3; high - o3) -!----------------------------------- - subroutine taumol27 -!................................... - -! ------------------------------------------------------------------ ! -! band 27: 29000-38000 cm-1 (low - o3; high - o3) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb27 -! -! --- locals: - integer :: ind01, ind02, ind11, ind12 - integer :: j, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - do j = 1, NG27 - taur(k,NS27+j) = colmol(k) * rayl(j) - enddo - enddo - - do k = 1, laytrop - ind01 = id0(k,27) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,27) + 1 - ind12 = ind11 + 1 - - do j = 1, NG27 - taug(k,NS27+j) = colamt(k,3) & - & * ( fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & - & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) - enddo - enddo - - do k = laytrop+1, nlay - ind01 = id0(k,27) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,27) + 1 - ind12 = ind11 + 1 - - do j = 1, NG27 - taug(k,NS27+j) = colamt(k,3) & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) - enddo - enddo - - return -!................................... - end subroutine taumol27 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 28: 38000-50000 -!! cm-1 (low - o3,o2; high - o3,o2) -!----------------------------------- - subroutine taumol28 -!................................... - -! ------------------------------------------------------------------ ! -! band 28: 38000-50000 cm-1 (low - o3,o2; high - o3,o2) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb28 - -! --- locals: - real (kind=kind_phys) :: speccomb, specmult, tauray, fs, fs1, & - & fac000,fac001,fac010,fac011, fac100,fac101,fac110,fac111 - - integer :: ind01, ind02, ind03, ind04, ind11, ind12, ind13, ind14 - integer :: j, js, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG28 - taur(k,NS28+j) = tauray - enddo - enddo - - do k = 1, laytrop - speccomb = colamt(k,3) + strrat(28)*colamt(k,6) - specmult = 8.0 * min(oneminus, colamt(k,3) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,28) + js - ind02 = ind01 + 1 - ind03 = ind01 + 9 - ind04 = ind01 + 10 - ind11 = id1(k,28) + js - ind12 = ind11 + 1 - ind13 = ind11 + 9 - ind14 = ind11 + 10 - - do j = 1, NG28 - taug(k,NS28+j) = speccomb & - & * ( fac000 * absa(ind01,j) + fac100 * absa(ind02,j) & - & + fac010 * absa(ind03,j) + fac110 * absa(ind04,j) & - & + fac001 * absa(ind11,j) + fac101 * absa(ind12,j) & - & + fac011 * absa(ind13,j) + fac111 * absa(ind14,j) ) - enddo - enddo - - do k = laytrop+1, nlay - speccomb = colamt(k,3) + strrat(28)*colamt(k,6) - specmult = 4.0 * min(oneminus, colamt(k,3) / speccomb) - - js = 1 + int(specmult) - fs = mod(specmult, f_one) - fs1= f_one - fs - fac000 = fs1 * fac00(k) - fac010 = fs1 * fac10(k) - fac100 = fs * fac00(k) - fac110 = fs * fac10(k) - fac001 = fs1 * fac01(k) - fac011 = fs1 * fac11(k) - fac101 = fs * fac01(k) - fac111 = fs * fac11(k) - - ind01 = id0(k,28) + js - ind02 = ind01 + 1 - ind03 = ind01 + 5 - ind04 = ind01 + 6 - ind11 = id1(k,28) + js - ind12 = ind11 + 1 - ind13 = ind11 + 5 - ind14 = ind11 + 6 - - do j = 1, NG28 - taug(k,NS28+j) = speccomb & - & * ( fac000 * absb(ind01,j) + fac100 * absb(ind02,j) & - & + fac010 * absb(ind03,j) + fac110 * absb(ind04,j) & - & + fac001 * absb(ind11,j) + fac101 * absb(ind12,j) & - & + fac011 * absb(ind13,j) + fac111 * absb(ind14,j) ) - enddo - enddo - - return -!................................... - end subroutine taumol28 -!----------------------------------- - -!>\ingroup module_radsw_main -!> The subroutine computes the optical depth in band 29: 820-2600 -!! cm-1 (low - h2o; high - co2) -!----------------------------------- - subroutine taumol29 -!................................... - -! ------------------------------------------------------------------ ! -! band 29: 820-2600 cm-1 (low - h2o; high - co2) ! -! ------------------------------------------------------------------ ! -! - use module_radsw_kgb29 - -! --- locals: - real (kind=kind_phys) :: tauray - - integer :: ind01, ind02, ind11, ind12 - integer :: inds, indf, indsp, indfp, j, k - -! -!===> ... begin here -! - -! --- ... compute the optical depth by interpolating in ln(pressure), -! temperature, and appropriate species. below laytrop, the water -! vapor self-continuum is interpolated (in temperature) separately. - - do k = 1, nlay - tauray = colmol(k) * rayl - - do j = 1, NG29 - taur(k,NS29+j) = tauray - enddo - enddo - - do k = 1, laytrop - ind01 = id0(k,29) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,29) + 1 - ind12 = ind11 + 1 - - inds = indself(k) - indf = indfor (k) - indsp= inds + 1 - indfp= indf + 1 - - do j = 1, NG29 - taug(k,NS29+j) = colamt(k,1) & - & * ( (fac00(k)*absa(ind01,j) + fac10(k)*absa(ind02,j) & - & + fac01(k)*absa(ind11,j) + fac11(k)*absa(ind12,j) ) & - & + selffac(k) * (selfref(inds,j) + selffrac(k) & - & * (selfref(indsp,j) - selfref(inds,j))) & - & + forfac(k) * (forref(indf,j) + forfrac(k) & - & * (forref(indfp,j) - forref(indf,j)))) & - & + colamt(k,2) * absco2(j) - enddo - enddo - - do k = laytrop+1, nlay - ind01 = id0(k,29) + 1 - ind02 = ind01 + 1 - ind11 = id1(k,29) + 1 - ind12 = ind11 + 1 - - do j = 1, NG29 - taug(k,NS29+j) = colamt(k,2) & - & * ( fac00(k)*absb(ind01,j) + fac10(k)*absb(ind02,j) & - & + fac01(k)*absb(ind11,j) + fac11(k)*absb(ind12,j) ) & - & + colamt(k,1) * absh2o(j) - enddo - enddo - - return -!................................... - end subroutine taumol29 -!----------------------------------- - -!................................... - end subroutine taumol -!----------------------------------- -!! @} - -! -!........................................! - end module rrtmg_sw ! -!========================================! diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index 49e9cc6b3..692042937 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -234,30 +234,6 @@ kind = kind_phys intent = in optional = F -[iswcliq] - standard_name = flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation - long_name = sw optical property for liquid clouds - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovrsw] - standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation - long_name = control flag for cloud overlapping method for SW - units = flag - dimensions = () - type = integer - intent = in - optional = F -[isubcsw] - standard_name = flag_for_sw_clouds_grid_approximation - long_name = flag for sw clouds sub-grid approximation - units = flag - dimensions = () - type = integer - intent = in - optional = F [cosz] standard_name = cosine_of_zenith_angle long_name = cosine of the solar zenit angle @@ -464,22 +440,6 @@ kind = kind_phys intent = in optional = T -[mpirank] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[mpiroot] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 2933be7ef786d843e9eb7e8cfb793bfcdda6f2e2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 8 Apr 2020 06:09:44 -0600 Subject: [PATCH 021/274] Cleanup comments in newly added/modified radiation code --- physics/physparam.f | 4 ++-- physics/radiation_clouds.f | 21 +++++++++++---------- physics/radsw_main.F90 | 4 ++-- 3 files changed, 15 insertions(+), 14 deletions(-) diff --git a/physics/physparam.f b/physics/physparam.f index e722297de..3c5d22186 100644 --- a/physics/physparam.f +++ b/physics/physparam.f @@ -234,7 +234,7 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method -!!\n =4: exponential overlapping cloud +!!\n =4:use exponential overlapping cloud method !!\n Opr GFS/CFS=1; see IOVR_SW in run scripts integer, save :: iovrsw = 1 !> cloud overlapping control flag for LW @@ -242,7 +242,7 @@ module physparam !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method -!!\n =4: exponential overlapping cloud +!!\n =4:use exponential overlapping cloud method !!\n Opr GFS/CFS=1; see IOVR_LW in run scripts integer, save :: iovrlw = 1 diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 8a943a032..96c3dd664 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -241,7 +241,6 @@ module module_radiation_clouds real (kind=kind_phys), parameter :: cldasy_def = 0.84 !< default cld asymmetry factor integer :: llyr = 2 !< upper limit of boundary layer clouds -! DH* TODO - HOW TO GET/SET THIS CORRECTLY? integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & @@ -2341,13 +2340,13 @@ end subroutine progcld4o !----------------------------------- !> \ingroup module_radiation_clouds -!! This subroutine computes cloud related quantities using Thompson/WSM6 cloud -!! microphysics scheme. +!! This subroutine computes cloud related quantities using +!! Ferrier-Aligo cloud microphysics scheme. subroutine progcld5 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & - & IX, NLAY, NLP1,icloud, & + & IX, NLAY, NLP1, icloud, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: @@ -2356,7 +2355,7 @@ subroutine progcld5 & ! ================= subprogram documentation block ================ ! ! ! ! subprogram: progcld5 computes cloud related quantities using ! -! Thompson/WSM6 cloud microphysics scheme. ! +! Ferrier-Aligo cloud microphysics scheme. ! ! ! ! abstract: this program computes cloud fractions from cloud ! ! condensates, ! @@ -2393,6 +2392,7 @@ subroutine progcld5 & ! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! +! icloud : cloud effect to the optical depth in radiation ! ! uni_cld : logical - true for cloud fraction from shoc ! ! lmfshal : logical - true for mass flux shallow convection ! ! lmfdeep2 : logical - true for mass flux deep convection ! @@ -2755,7 +2755,8 @@ end subroutine progcld5 !................................... -!mz: progcld5 benchmark +!mz: this is the original progcld5 for Thompson MP (and WSM6), +! to be replaced by the GSL version of progcld6 for Thompson MP subroutine progcld6 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & @@ -2768,8 +2769,8 @@ subroutine progcld6 & ! ================= subprogram documentation block ================ ! ! ! -! subprogram: progcld5 computes cloud related quantities using ! -! Thompson/WSM6 cloud microphysics scheme. ! +! subprogram: progcld6 computes cloud related quantities using ! +! Thompson/WSM6 cloud microphysics scheme. ! ! ! ! abstract: this program computes cloud fractions from cloud ! ! condensates, ! @@ -2778,7 +2779,7 @@ subroutine progcld6 & ! top and base. the three vertical cloud domains are set up in the ! ! initial subroutine "cld_init". ! ! ! -! usage: call progcld5 ! +! usage: call progcld6 ! ! ! ! subprograms called: gethml ! ! ! @@ -3883,7 +3884,7 @@ end subroutine gethml !.. cloud fraction and is relatively good at getting widespread stratus !.. and stratoCu without caring whether any deep/shallow Cu param schemes !.. is making sub-grid-spacing clouds/precip. Under the hood, this -!.. scheme follows Mocko and Cotton (1995) in applicaiton of the +!.. scheme follows Mocko and Cotton (1995) in application of the !.. Sundqvist et al (1989) scheme but using a grid-scale dependent !.. RH threshold, one each for land v. ocean points based on !.. experiences with HWRF testing. diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index 51512835c..924d750b1 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -1228,7 +1228,7 @@ subroutine rrtmg_sw_run & do k = 1, nlay zcf0 = zcf0 * (f_one - cfrac(k)) enddo - else if (iovrsw == 1 .or. iovrsw == 4) then ! max/ra/exp overlapping + else if (iovrsw == 1 .or. iovrsw == 4) then ! max/ran/exp overlapping do k = 1, nlay if (cfrac(k) > ftiny) then ! cloudy layer zcf1 = min ( zcf1, f_one-cfrac(k) ) @@ -2068,7 +2068,7 @@ subroutine cldprop & !> -# if physparam::isubcsw > 0, call mcica_subcol() to distribute !! cloud properties to each g-point. - if ( isubcsw > 0 .and. iovrsw /= 4 ) then ! mcica sub-col clouds approx + if ( isubcsw > 0 .and. iovrsw /= 4 ) then ! mcica sub-col clouds approx cldf(:) = cfrac(:) where (cldf(:) < ftiny) From 6a8c80e538f23cfa7b6703b423dd9963c4477334 Mon Sep 17 00:00:00 2001 From: Man Zhang Date: Mon, 13 Apr 2020 20:32:19 -0600 Subject: [PATCH 022/274] Merge mzhangw:HAFS_fer_hires into NCAR:dtc/hwrf-physics Squashed commit of the following: commit 406f7408b6308145d81e84cc6047d8cd19396f22 Author: Man.Zhang Date: Mon Apr 13 20:24:59 2020 -0600 FA uses progcld5 commit 682fab9654f7c6188109efa3fec9a922d8034c39 Merge: 25b3f66 d979604 Author: Man.Zhang Date: Mon Mar 16 10:42:12 2020 -0600 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 25b3f66d74fc4ece9a665c4e2c353294bb60e636 Author: Man.Zhang Date: Mon Mar 16 10:37:42 2020 -0600 modify stateout update of FA scheme commit 05c533134ac5d61581dbd37a7995ca8af21fda60 Author: Man Zhang Date: Tue Feb 11 16:45:48 2020 -0700 sci doc updates commit 982a11d13d0f8287fefc8b3c217f0933c57e1a95 Author: Man Zhang Date: Fri Feb 7 16:47:00 2020 -0700 FA sci doc updates commit 27c1fcbe3e57ece5a039a083451195e2ed652303 Merge: 8d87e55 73f9f09 Author: Man.Zhang Date: Fri Feb 7 14:26:54 2020 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 8d87e55fef1a4e7b7b8ce9420b190951a4e47cc3 Author: Man.Zhang Date: Fri Feb 7 14:24:47 2020 -0700 FA scientific documentation commit 67ad5a523f4815d145233383343d15655a29896d Author: Man.Zhang Date: Wed Dec 11 13:13:48 2019 -0700 consolidate with Chunxis version commit 76b547584344386ce4cee467b588e348676b6ef6 Merge: 7c6a472 02812f6 Author: Man.Zhang Date: Wed Dec 11 11:49:22 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 7c6a47282704958e18f02b8c9f36f6ebf2262d71 Author: Man.Zhang Date: Thu Dec 5 16:28:50 2019 -0700 output mass weighted RF in GFS_suite_stateout_update_run, it will used in FA commit 41086af5af34ed011ecc7fbad64458a7c9c54ee5 Merge: 92d9edf f895fc0 Author: Man.Zhang Date: Thu Dec 5 12:08:30 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 92d9edf0d624eea93d1a0ce740c6d55bb556015c Author: Man.Zhang Date: Mon Nov 25 14:16:16 2019 -0700 chunxi fix : f_rimef = qg in FA code commit f9e3ee0af2c0cd27b9861ae6d89fd06744ee233e Author: Man.Zhang Date: Mon Nov 25 11:39:54 2019 -0700 From Eric: convert wet mixing ratios of cloud species to mixing ratio before the scheme, and convert back after scheme. From Chunxi, modify: 1. FA interface with GFS RRTMG using progcld2; 2.air pressure improvement; 3. add f_qrimef mixing in PBL commit f497d403dc61b52b0cba01808a2e58ad2461db60 Merge: bd4a30c 73b8c0d Author: Man.Zhang Date: Mon Nov 25 09:44:14 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit bd4a30c08411d2bcb692c7499028284920ccee08 Author: Man.Zhang Date: Fri Nov 22 14:30:16 2019 -0700 monir format fix commit 4c2abd18beaaa068c32324f7dbda5deff78712a3 Merge: db7fc8d a7c38a6 Author: Man.Zhang Date: Thu Nov 21 19:29:50 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit db7fc8db07c4291f791e835f2f28f824b6daace1 Author: Man.Zhang Date: Thu Nov 21 19:29:04 2019 -0700 minor change commit ab52b2610907aa7aeae78a95c610133c526a9195 Author: Man.Zhang Date: Thu Nov 21 18:48:53 2019 -0700 delete update_moist module commit db9e3a75590043ef03dd840229fe98572081c9cb Author: Man.Zhang Date: Mon Nov 18 14:40:10 2019 -0700 cleanup FA codes commit 482a43bc753ec033374dfc387edbfde5281b5083 Merge: 380229c 74851c1 Author: Man.Zhang Date: Mon Nov 18 14:31:07 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 380229cf38ec5ecec5aae31677c7038de9d9b79c Author: Man.Zhang Date: Thu Nov 14 13:46:13 2019 -0700 1. do some code cleanup 2. correct tracer diffusions definition before/after PBL in GFS_PBL_generic commit a312444323d43746cca3fbff816a087ab14e2787 Author: Man.Zhang Date: Mon Nov 11 10:52:21 2019 -0700 Chunxi's email 11/07/2019: the srflag is based on sr. so we need to make sure 'cal_pre' is always set to false in namelist file. commit f2c927192cbdf27e91ab3f5b4bbbba1709bb7743 Merge: 6777489 333980d Author: Man.Zhang Date: Thu Nov 7 11:03:56 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 6777489880b16735c809a70cc98c134566b52b72 Author: Man.Zhang Date: Thu Nov 7 10:56:33 2019 -0700 add Chunxi GFS_MP_generic change related to FA scheme commit 327b07f577d1cd367de27a7104113533cb098e36 Author: Man.Zhang Date: Wed Oct 23 19:56:11 2019 -0600 minor fix commit bfedaabc2a9900cbc2e1428823e8ef57d1f31f1a Author: Man.Zhang Date: Wed Oct 23 09:44:46 2019 -0600 add meta files for FA scheme and HAFS_update_moist commit a5b5fa967a3a350c04c8f7936226ce71ce973ca7 Merge: 1ff46c7 cfafb29 Author: Man.Zhang Date: Fri Oct 18 09:56:40 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 1ff46c78740c8d69dcaeab4dac881651f9f757d6 Author: Man.Zhang Date: Tue Oct 8 20:42:58 2019 -0600 add update_moist() module to F-A suite commit 258fcebef1cb17750fc1f3de0d143e1ce3ea53da Merge: 53fba5b ecb641e Author: Man.Zhang Date: Mon Oct 7 15:36:47 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 53fba5b4086361d4d4c2ceb0fb41334c48ee30cd Author: Man.Zhang Date: Mon Oct 7 14:55:21 2019 -0600 1. recalculate some FAmp tables which depend on physics time step in F-A scheme 2. change ncw value to HWRF application commit 1656aac7574026f40bd006d37771bb845b0ed4bb Author: Man.Zhang Date: Mon Sep 30 12:02:24 2019 -0600 revert MP_generic to original version to obtain B4B for control/csawmg/satmedmf commit dfccc5b66b3148b6b27f5ea41c519280db1a9537 Author: Man.Zhang Date: Sun Sep 29 11:06:55 2019 -0600 fix bugs in GFS_PBL_generic commit fc744d37b4d1793c5b12915a6980a0226d630406 Merge: 1a024b7 dc74b57 Author: Man.Zhang Date: Mon Sep 23 14:17:29 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 1a024b7e33569813915088ea89cec4004af2e46c Author: Man.Zhang Date: Fri Sep 20 22:01:07 2019 -0600 fix ccpp_control crashed problem commit 957ff823926e8eae5b94cdc9baec00a50725cd09 Author: Man.Zhang Date: Thu Sep 19 10:14:59 2019 -0600 turn on/off spec_adv option is working in CCPP F-A scheme. commit 370d49f718bd1c13be7b8d1176d54183d8452a5c Author: Man.Zhang Date: Tue Sep 17 16:55:24 2019 -0600 use progcld5 for F-A in GFS_rrtmg_pre commit bbbf155ebf1584d27fc357f66b35f874c78d706c Author: Man.Zhang Date: Thu Sep 12 09:19:17 2019 -0600 F-A scheme modification related to meta data file update commit 2b8d9e4cce92c59447078d61feef8dca11dcbd20 Merge: 08662ae 9fc5ac1 Author: Man.Zhang Date: Wed Sep 11 16:15:30 2019 -0600 Merge branch 'HAFS_fer_hires' of https://github.com/mzhangw/ccpp-physics into HAFS_fer_hires commit 08662ae5463aeb30524ac0798219f5c7454cbe13 Author: Man.Zhang Date: Wed Sep 11 16:14:47 2019 -0600 add vars to meta table commit 9fc5ac15ff2b7a4e822f68e592ddb4aa7d207832 Author: Man Zhang Date: Wed Sep 11 16:12:00 2019 -0600 initialize Doxygen documentation in F-A scheme commit d749a6879a47656bad756e1823a12db92df14efa Merge: dff5b0f 20dd8d2 Author: Man.Zhang Date: Tue Sep 10 15:19:15 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit dff5b0f17da3a6d6d47ff5d184fea30f7b21f010 Merge: bed9c0e 727417c Author: Man.Zhang Date: Wed Sep 4 14:30:28 2019 -0600 Merge branch 'chunxi_physics' of https://github.com/ChunxiZhang-NOAA/ccpp-physics into HAFS_fer_hires commit bed9c0e4308b5c44ea4b3daac0976c69d848200a Merge: 1f8a26a 44137a3 Author: Man.Zhang Date: Wed Sep 4 14:26:51 2019 -0600 Merge branch 'HAFS_fer_hires' of https://github.com/mzhangw/ccpp-physics into HAFS_fer_hires commit 1f8a26a47908983229e19052b511035e0f5aea92 Author: Man.Zhang Date: Wed Sep 4 14:24:27 2019 -0600 bug fixed in augument list of FER_HIRES commit 44137a3741ad118cfbf6b46a1e39ebcdff84d808 Merge: 1808226 6abba22 Author: Man.Zhang Date: Tue Sep 3 10:33:04 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 1808226b104453dc0907aad07015a098991db9df Author: Man.Zhang Date: Sat Aug 31 17:51:49 2019 -0600 tracer treatment fix commit 727417c249e2c20d91c55334bdd8da1ba0de9a71 Author: Chunxi.Zhang-NOAA Date: Fri Aug 30 22:13:06 2019 +0000 GFS_MP_generic.F90: recalculate srflag GFS_PBL_generic.F90: define tracers for vertical diffusion GFS_rrtmg_pre.F90: change ncnd module_mp_fer_hires_pre.F90: revised the definition to tracers mp_fer_hires.F90: revised the definition to tracers commit ec729e8434a0b63010547ba3b8ed3e21a6d54342 Author: Man.Zhang Date: Thu Aug 29 21:43:36 2019 -0600 make consistent standard name as Chunxis implementation commit 3a26975a0524594c917a99826c6b7c558894ce8a Merge: 1426c6e c7faeb7 Author: Man.Zhang Date: Thu Aug 29 21:02:59 2019 -0600 Merge branch 'chunxi_physics' of https://github.com/ChunxiZhang-NOAA/ccpp-physics into HAFS_fer_hires commit 1426c6ee9ea83346319faf966d22b93ae508096e Author: Man.Zhang Date: Thu Aug 29 20:32:12 2019 -0600 fix omp message and pass F-A scheme commit c7faeb7b8b3a2e98596308f088824d4f097886af Author: Chunxi.Zhang-NOAA Date: Thu Aug 29 16:20:51 2019 +0000 mp_fer_hires.F90: changed the definitions for f_ice, f_rain and f_rimef. Deleted QS since it will not be used. we only need QI. module_mp_fer_hires_pre.F90: changes related to f_ice, f_rain and f_rimef module_mp_fer_hires_pre.F90: added commit 4e0d9bd0026cc53ea67fed262d3632d05ac917f1 Merge: 9aaa575 01823bc Author: Man.Zhang Date: Tue Aug 27 17:13:12 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit 9aaa57535015ffb489ba51635a65fe0fc26cc1e9 Author: Man.Zhang Date: Tue Aug 27 15:57:43 2019 -0600 minor fix commit 6b888640907453ae7f90c4c16107afe811a478ec Author: Eric Aligo Date: Tue Aug 27 17:31:03 2019 +0000 Fixed bug to allow both Qi and Qc to be updated from CU scheme. commit 73f95a60f1f7fbc2a2679f2a19498c036845a436 Author: Man.Zhang Date: Mon Aug 26 22:05:00 2019 -0600 fortran format fix commit d5f8a622be5f9ad4c1b636f4762cf44cdca91774 Author: Man.Zhang Date: Mon Aug 26 17:16:30 2019 -0600 minor fix commit fb011da3962ce69c10c23c6241cc0f29153936f3 Author: Man.Zhang Date: Mon Aug 26 17:05:04 2019 -0600 Aligo-use the dx of the 1st i poit to set an integer value of dx to be used for determining RHgrd commit 80fedc458556b9c7ca4a73d61dd1c50eec023fb4 Author: Man.Zhang Date: Mon Aug 26 13:41:24 2019 -0600 further constants fix commit 473ff9ea06d080d5a17483c5731081e463523840 Author: Man.Zhang Date: Mon Aug 26 10:45:49 2019 -0600 dimension fixed commit c29c3cdcdf13db9e53e838a6e42d7c6f6afb379c Author: Man.Zhang Date: Sun Aug 25 22:44:04 2019 -0600 convert USE ESMF to ccpp mpi method; temporary constant treatment commit 8b886b9627cf5fa8a053522f7411d77f61c8a368 Author: Man.Zhang Date: Wed Aug 21 11:06:19 2019 -0600 delete HWRF F-A scheme commit b78a1a2ae7f8ef288c368b5b0cf3fa46405038af Merge: dbabee7 ff2c6d8 Author: Man.Zhang Date: Mon Aug 19 13:42:42 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit dbabee7650a6fbed815c3dc566f478b78166baf8 Author: Man.Zhang Date: Mon Aug 19 13:41:36 2019 -0600 update commit 7c481b51e96a40e43fa5b79e45dc5c12a3908401 Author: Man.Zhang Date: Thu Aug 15 08:34:33 2019 -0600 initialize FER_HIRES scheme commit bbac675e1379f533a6b492c0c6cd4cf90d9d3a21 Merge: d06f755 fb29006 Author: Man.Zhang Date: Mon Aug 5 10:33:29 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into HAFS_fer_hires commit d06f7550c6873d7b724d96fb6b066e7324396699 Author: Man.Zhang Date: Thu Aug 1 11:29:43 2019 -0600 minor fix commit 970ae6694eafe6d0481b527f39dfccf51cdc3f73 Author: Man.Zhang Date: Wed Jul 31 13:41:12 2019 -0600 change file name commit d666a3e34cab2efcd3aab998c510150fecf3b022 Author: Man Zhang Date: Wed Jul 31 12:25:36 2019 -0600 pass prebuild commit 63f07c4b13a2b73aff22402560a32839c9d79e51 Merge: d0d4035 6bb0897 Author: Man Zhang Date: Wed Jul 31 10:10:31 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into FA-HWRF-V4_0a commit d0d40355c48ea3741aa5d365145d7b5c68e0c8e7 Author: Man Zhang Date: Wed Jul 31 10:09:44 2019 -0600 initialize FER_HIRES implementation commit e77c0a16075569a3856fc2ca7990ad2ccd9e93a5 Author: Man Zhang Date: Fri Jul 19 14:55:03 2019 -0600 add fer_hires wrapper module commit 193435bde766b7a0c891b88a8af6bc33fa2f1652 Author: Man.Zhang Date: Mon Jul 1 16:31:01 2019 -0600 initialize Ferrier-Aligo MP scheme implementation from HWRF V4.0 --- physics/GFS_suite_interstitial.F90 | 20 +- physics/GFS_suite_interstitial.meta | 41 ++ physics/docs/ccpp_doxyfile | 4 +- physics/docs/img/FA_DRI.png | Bin 0 -> 162043 bytes physics/docs/img/FA_MP_schematic.png | Bin 0 -> 135098 bytes physics/docs/img/FA_NOR_EQ.png | Bin 0 -> 47494 bytes physics/docs/library.bib | 554 +++++++++++++++------------ physics/docs/pdftxt/HWRF_FAMP.txt | 91 +++++ physics/module_MP_FER_HIRES.F90 | 255 ++++++------ physics/mp_fer_hires.F90 | 103 ++--- physics/radiation_clouds.f | 240 ++++-------- 11 files changed, 697 insertions(+), 611 deletions(-) create mode 100644 physics/docs/img/FA_DRI.png create mode 100644 physics/docs/img/FA_MP_schematic.png create mode 100644 physics/docs/img/FA_NOR_EQ.png create mode 100644 physics/docs/pdftxt/HWRF_FAMP.txt diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 935dd9430..1707c7f7c 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -409,7 +409,8 @@ end subroutine GFS_suite_stateout_update_finalize !! subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, & tgrs, ugrs, vgrs, qgrs, dudt, dvdt, dtdt, dqdt, & - gt0, gu0, gv0, gq0, errmsg, errflg) + gt0, gu0, gv0, gq0, ntiw, nqrimef, imp_physics, & + imp_physics_fer_hires, epsq, errmsg, errflg) use machine, only: kind_phys @@ -419,7 +420,9 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, & integer, intent(in) :: im integer, intent(in) :: levs integer, intent(in) :: ntrac - real(kind=kind_phys), intent(in) :: dtp + integer, intent(in) :: imp_physics,imp_physics_fer_hires + integer, intent(in) :: ntiw, nqrimef + real(kind=kind_phys), intent(in) :: dtp, epsq real(kind=kind_phys), dimension(im,levs), intent(in) :: tgrs, ugrs, vgrs real(kind=kind_phys), dimension(im,levs,ntrac), intent(in) :: qgrs @@ -431,6 +434,7 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + integer :: i, k ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -439,6 +443,18 @@ subroutine GFS_suite_stateout_update_run (im, levs, ntrac, dtp, & gu0(:,:) = ugrs(:,:) + dudt(:,:) * dtp gv0(:,:) = vgrs(:,:) + dvdt(:,:) * dtp gq0(:,:,:) = qgrs(:,:,:) + dqdt(:,:,:) * dtp + + if (imp_physics == imp_physics_fer_hires) then + do k=1,levs + do i=1,im + if(gq0(i,k,ntiw) > epsq) then + gq0(i,k,nqrimef) = max(1., gq0(i,k,nqrimef)/gq0(i,k,ntiw)) + else + gq0(i,k,nqrimef) = 1. + end if + end do + end do + end if end subroutine GFS_suite_stateout_update_run diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 9cda625ab..0f02e7c63 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1043,6 +1043,47 @@ kind = kind_phys intent = out optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[nqrimef] + standard_name = index_for_mass_weighted_rime_factor + long_name = tracer index for mass weighted rime factor + units = index + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index 339ddb3f8..0578d14a8 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -133,6 +133,7 @@ INPUT = pdftxt/mainpage.txt \ pdftxt/GSD_CU_GF_deep.txt \ pdftxt/GSD_RUCLSM.txt \ pdftxt/GSD_THOMPSON.txt \ + pdftxt/HWRF_FAMP.txt \ ### pdftxt/GFSphys_namelist.txt \ ### pdftxt/GFS_STOCHY_PHYS.txt \ pdftxt/suite_input.nml.txt \ @@ -262,9 +263,8 @@ INPUT = pdftxt/mainpage.txt \ ../module_mp_radar.F90 \ ../mp_thompson_post.F90 \ ### HAFS - ../module_MP_FER_HIRES.F90 \ ../mp_fer_hires.F90 \ - ../module_mp_fer_hires_pre.F90 \ + ../module_MP_FER_HIRES.F90 \ ### utils ../funcphys.f90 \ ../physparam.f \ diff --git a/physics/docs/img/FA_DRI.png b/physics/docs/img/FA_DRI.png new file mode 100644 index 0000000000000000000000000000000000000000..63737c469b2e16b5dcd624d12cbb3824142abe90 GIT binary patch literal 162043 zcmd4(Ra_lQ)HV)c37Z6WcMTBSHMqN5g1fuBy9Rd&?iM__I|L67!QI33&dK|J-+$&e zcXKi4ChWbttE*O3ty+)t30II4M|g+(4gvxKK~h3Q2?7Fg5CQ@^9P}3W#*FDO6awO1 zr@64Of~2r8v4VrGiMf?A1cXF*@>f_DWlh|{GtWbkyf;Ges2<`T$$HS#60mqA{>V}w z8df~gKr&8D5s{jxAq5QlWNys9fZ$JpwMTwo0pAfZ1x1aCYJ#%X>f20T_gAlc9@f1# zo;sgS`Syt*BnsdO8E{hG5(m@nz&^Fik{0Bfx9meeF?K_X=Z=1P=VtTi6C}j+kDKcB z_Q)|Yrxhdi#jcIl>ID6MxKs$iPoTj%m@)LAN#cUg;qCX3g1aR4mGC6CDVE47+hlJ@ zyibaoJbBS$WEx%@shvMpMeBoOCh;YL_Lt&rG7o=Ec=^{im=wXS^o)UB_jKYC zNV;EqENVCfINU}3IDPST$Lyi1K6@4hrM%M+Wq> z4PJHh^A&?IEe)A5Hz;I4H@X!hN;*ii6SLCz`yt``S3##+ne98d{f~*>efFO`!tOOm z>UuCa<2SJyQmG```H9iVAy9rnVTM6_A-`Ap#EcAudk%w748gmD1x>snjQy1+)A|Ql z^4I?T8nhr*jve&==>whOQl{}AV?W^imRPu6hXoY&CvZhNYO$q{Ai6st;Oejp;prik z^&kY(bfU~V#G6KKASP~@MW3%9ejYcy!4`y35=5kiWXpYX?GIN2!9KL)`bMuC35GOF z#J|xm{5mnfDFKq*kDizaJz(t%5jC`UH`71>AeY}^2#G4-IH8vX`vfoN zMou|@L-K$?_+&WcdGJ0eK(YqE;@!~?X?>ob2)Cian{14Da)I@mylzxF@6@{oH%;zI zz0e5#U^f@fVczAEE2t#B9f2_py%c2K<=dw@yg5@= zOxaJfQNMpG@DU&axH@R z&{Tc9+laqnwm<%Qv?ptkcY|x^UWYo1jva8kXuU`EBKX7GN%V>;AR9+{fQ%3FhruL? ztcg^RG^1K2jY2LCXBOehM`KD#l~@&`qhLp_MkYcNkdTltllm!Lk@QPqMT0OF3p>%yrF?%tNjz4;>EK4?Snln9*?@(*)Dd z(+HTInHP=4jP2{b*Xh;KE%7cH)_pY!rJ;_%><|1=XjP=5RHY!cQ{&*_;M6M8D%6VR zz~``iS$C;+xp|p(xqG?416xX6_Ayybw)iwZJAb{%M^Qo5PB~2ZXVp~hR5fE!i^#Mp zlU%J}t)ji)MI@^1ur!UNd8|_844QF6UEZbCF8prqhIOHga!m*G+hB-Jk% z!pUEfZ$1pFd{?DZnOE^vaW8{aVJPiXEGTO&qbS2D&r-)zF8Rh&?l>1Y&+x4)e|UD) zY`8&b*?74nBqF3bL}L4!SnNPUakfdSNtH>#9vXdqN|su?TCG~iLQB*4TZa>b<(p+B zXArjwHyrnq^LM9WryD0Sr{=?^gP7kmzo&2NZhqeo9wpxBUe8|BUY}uqK{$p_fJel+ z#{Chp5CRvn8`2#0g$$1@W}2jc-!Q7SgK4ql$9*>3aNjujTH(6UP?81imvqZzgGZOr z+nIwR&lDH>7aJ4n6e~6J+aaBW)k)sP_O<7Z;Ji1p`Kwzo6iYKJ4)w<6yF9dH<(%cc zYIl`13!|0Inyy;D^|g(gE37}GmMm5VeiAlxm{OTy88!Ewrt=M~uldx!Xg*CMvLgzG zDkJ)Gr*l$rEpWwroYlr`u5ehYNi0U|J^VJC%QDV2@L;kB^&IF`Ga8O*Wriou0m)v7USfTgTG+&H6U~0{@XW zw-;0ApH5G&vuV{s84r5z)yW0hf(>Ke1m7^d;kr9#69a9%0E(l;kk&flV=9#$ua%$RX(pndxX=pEJFKW-QowXIY zCB7tg+;LnB^ED_Thyx!<4rgCC-*zj$ue7kc@ONR_PT0->x|fuU6rOrYMqfu}SxS1^ z@*vCB?$z5_{F&RL=&P3pRVaxXv8fM9!ejEy5}&UF&8XM7I(T1{#oPuCWzuA9Ok7j+ z7j7%QF0C(hRft!cR-LWp*6NRjxFW*b>BA#2X?PzEwMs8;Q+$1_4K( zPT#qGGsj>X(P5_J+G|6G552T)KDAFpO;W98HNUmlnmuYLTlO3(t*x!Iq}HlDTJ%%| zT)b{B*3q)5wD4qbW7w7O-pdCh<|kJBL_ge|(!45Xm7K_NWKMHA)`ZWfOu@66vc)!& zH^4WEHQqKpG&(o&G;zF`JZj%)M%VA|?@XR>%k$>A`s@ka28Sc+4Q50hNA_kNaTDoA zv^(uzj*RlDKUeFt{r0|5`l`JcY$>-mq37DN?$UcIHY%HuF}}92CflX`x;|$(JL@%i zt7cj4ZR@#F*Ln5w@deA)bG_3e)MtOMJHo%SP2crwL)+W-od4+0LEsMT8DX(Nrccrp z_EpO-;1o?L`5;gGhw;9^e#+#0HEv(wu0GB*HYBaLI_G`1FTt?qCm+R2r5EFqZ~X^L zOlP(0>g9UT?Ry>BK8dd!XFF}#!>Rj!s!9T&fbF));{bZ&K~_^{kB{8@W_+D=PK!yycuOs$8aHtN2(fM~CN z>xUog2HU5OMzPO#m6_|FBOv}u;G(@cI}rh5z6v5}7XsPOEva{CYB=p~p+1FX4x>9I zW$OY7Zi}9N&oLf(Km37}^?Lc_yU6E2ni=K7 zJVOur2K;k|N1kS?_ng&K)?b0rHp^T^!%0I{hTG8A`lG&)t%31JH)}hf(uIKFb>jy9 zv^I9qCw8;8vT@{g<0Jih1vl_F_-h7I;=h+TS@Mx;$SM#E+d3E%vwdX!$Vkfnj+mI3 z*TKkyTS-Lh-|fIBK2kF$Cp&Hi23J?tkFG2qZ5>P*n7FvO7#Nuun3?H;E9f2FZJhMo z=xrRy{%hoa+7U5!G;}bxb27KJAqKarZ(!@}#79aBe$fB^_g_Da-OT^blWZLS4GS0` z1NavPrjLva|JycjD=+w4ZUu8UV=E02b8BN8N8lO!tZZz&f3N@l_~rjR@&CG0^Z(q* z#rXfY^Z)wg-<`Y+-~s$!1Ntvof4>F7#s7|%;eSKV|L#+?`fmsbK?q5aPbzMZ$62tc z=>4dJM=@S~Wa5yY0w5tFp+AI0q_TvRgyE2V`!)$m#c=#_4j=Yz4}vtp56T32SYm?9 zl=t-ZraJFyt1-jz`srFo+1bjo?Gs3d`jT45%-`dI7Icpt=Abxs(e%Exs^e~?*9d2{uTV&CW=D6 z1-zX7!{zSovSoE6-_c65E&Q!QTjAeM8j$6t8Wi6t=j(=3(_z@ix?Cb77b-HpHvBk?+2u<4|^F!o_D7UWR0$8>pc-q zv3Y!IWh%oyzQ6oop9gOO{|l(#HMp0g0|L+If!9Zilj#y1w(E57G3m}fpQM>)$L9%$ zK6b%A+1<>mukz8%A}b6Apd``LK0N>}N-llfDJ&&y+- z-KNlMYd4a>>vKK6=W*@rc@mBCPE9Z3d%FCMf3uYD2lQDHVxGsp;Gk$y`e#+v>#B7ku290I&X;-zKa`%jBmBBKy=o+Pv~nWurC&aPeYaEl+c{|ay)di=DLwgTh(IFb>;DImlAV> zsJX;o7p*E$R}OwK>-?}^ASapBYP5iJSAh;5! zX@=50>~vLXmFedrk`w$-R-V5LV)>N}#^A{Ls{StZBxHqgCaG@BLd}G?tk%mai@5Kh z@)uOW>ns-ncrGSHyP2x9W%Th5%GeHW<&j0(zrlDSPbtJ;KT*`Yl3m^`ex_y8BEOFP z`}E*gU||Kvy2q$zGU^93Sg)u(ULTUhkUP>d41TpHdnzzA?^0|N27$ zPCBGtv~>QPP2vk+W63;oEueh(|JuMX)5X4q__u%Sh!jdHh6Jj(|KHL@C4!_F?8`AE z$om)4Fd!Nspj1rt|MsAS7myp#{+}JlAP5C%==FQ^=TvAn%ekDcrl~9b?>dEovf5WK zk;_812>Prt%;a?(u%Odm7N6<+=b_H~$wg9DwV#(-!b9P2AQ+MF?>2mmCo;M8=ioac z5)2PgceMf$BCtN{P&0Hr*UgowN>7oi{tM^35QvetZI~D-z&gP;r>v1lW1gus6qk-c zvC+#={+kWWQK;z>KR}ePF-Qs2M@2Bwu5Ja zfu-n0%P={nQHJ0NOcPunAZDLs*@sMpnZ%`ZLVicD{~0gjDjg2bw8w~rTtk4(zK+{!!B0q zS?AMEZXn_%(IQf9G_d@vCSz~qfax*7hYULpMB`AJ;k9V zL`vC0pdlcKAHLM2vstEiT@F*FU~{=oaP3P}>orT3DpBmt$_pfy z!x`f)_EpFxBOoCpubucT)fv}0AE|jp9I;#doJu#NRj)dZIPygQd(N~hH-Lu?3sr$6 zWLMpBn?9DxB)m}lIj3^ls&1vqTKmwx7h$H=ao=j+=lMc>GZ;8h|0Zqo**(xx2QWrv zn^jI67LzE74&Y>vWOTTG@TxN!Ms@%5uwM!1viT#p&SV_-;`Fmdxf(s!c{lX#as6b9 z&DwW3>v9n!AoK_N<@B^b9RSd5OdWUYo|oOwNJAsZw1KzS^r!Eyw5&iCp90^iB|5z! zVUj5ZY3X)&+^o`+D&z&|ng-#Ma4(BT%1BFJecgn%Oo$cu(-MWxHN$;r#M62=8i7F@ zv^ZC)Tv>|AQYCc_&QJgIv?#J}kIjSWg55t)XOm)4z*QNC;Hc;6MkqlEG#V8 z>#|tQ6L>F&$e2BEt$Ydir$Xx|xTUok%=Cwv62QrZn#Z6Il*Z*)d@?$b#ZzQ7oUru! z@aqssjqL*IVsX=db&U=&qv-^GIoJ0I15EGp9@yQjNQS0R#=Lc(r<0U+MsHH&c_QCu zlCQchX*UuSDbvGMx@{F`vNylyPe_JPt*7B|iH$;Y8xe7sMFwIBj^y6&gb%#acR83M z!Hb_M0WKcVw(T&kj!Y>-c}E(~!3e8Y1}(Zp@+pvZ0bfW5={cRQKucYLpsHcMl&e)n)yt$=75D{B5l{cl zyrb?55i{%1SRpWPY>bVK-i*wx~GhoBgX+7Wkwhw{W;dDumSGpFU+B2Cjtw=1AGQn{e z+ejRZA>euL+kKmuoo&M=a<|qY>||ycgYOOm7l})#`0Hn%R^-!*D*ICs>6lrN{eV8f z)sOcKN!fg!j|65@YFKm{ztWq}cJwMgclk6KJ{BDyPx)Tt_v%&Shl0>K^j=c1Z@`aa z=)eA^@yBiYmY{OFpXz%Lvd89F_9^xmGTDCSue{$f75ITa2|bUQgadSUfkUfap9Gos zDBdmetwqpWKg99RTW5wscRJ?A9Mt14(O(56kJ-MBpU9HE~qmbLVj%Nlj)0@S( zef8+aOWEX;8w%ne@AaJUE*^^)Z@Mxav>((ghbPym3Jf{K0BP_kbcCUwm{JVp_kXS? zGzEH^E*UXRsC?HSJh%ixZEn*H!BJKux}u5G)eHKntlT<3UX5i=tS>Z&%ucD3oG&go zTzjxD=!q;2;4SV5t5m&H$mOu=iHJ~bH0*7nW{dam z0MGO`f!KVP@g^ZlyyyTtIgeaZgncMbp$p7emC3JocK8VNhu`1zyzwZm>p-^*_FpE_ z$6LRVgnED$<`;rQRxamohj6~IK)B9ED3Ybe(}WSy=!`iIZe;sg(nO#_F5E-SR-^Qt zIXBq9kU90bmpQ;!&K~7%kL=zN)YH*ywL>u_s^|bbHBhHUyHDwX@e~TNAaa-bpFdBw zZI&T-*h^-`@;TY#?)!ewh}3bWG$!-x*2_jK_o+v5f?qCohSx{W?$V;T{bNL)FlM0N zhyk(aMz(+kAD`8rIF!MoBw;O1tb&7qzV(Q%Kab^478`Jr)Mh_}R|J<<&V%64j}4vV_3k{g}gMZlS`;OW%u2e~wKao&s6j7JFTkrDDJOw4{cBhAp*W>ulv zwxH&^yxs18wG;6EV_dOp#_~C$%=g#ltJv{=Zl7m2uB|Y#o!{lvm`x2z;fO#InC?;4 zR)sOZ^IzLDX}{NupEnf!t!JdiCj;aC@blCW-D9yrlZESU)p2)T{c~gGcDxjB%TaZg z9xl6;*&@#Lo{obZDE^WhA~pzIl`*@X>bL`?!?R^p71A~IAW_|I9AkG;-uCxvs>q)h z$=^tT5{b>MQD2l;3}uKh<7&cJ!;99}pjl5+^D?h>#RlEn?kmaA&Wy-Z`)S9WUXRm= zUO4Brpxkjq&nT^14NxCy+O%wjya)-l?+QIcEqL6mxvn@*0MOyR9GBjv=PxE+EBn1t z1(F9sllGq?PxT3g4JZq@82%bUU+z5OgJZ)haBRb;3vEzx;B+N4nRE(+m?{@qDGx!Y zCHP8RD9cP1bJWsedaqYqR3VE{j9B9i>SEzv5Uoh)~N5y3^4>pGLWqA%9iH*yqH2C;=VOw~;+D@u)4?r#1+IPe#G)=4@nt6If= z)451)>@~!TWN<%K3CWd>RVjCg`9p;IEvACkC+F&wJ##b>&nM`hYEx6h}=2P9dsWrvR#gJN-X2z z#Wl2}m|#>KqiW%%PpP5wNq%i%t7Au_D4P|&LAcz=+S0!7WUA%Y57SsACPS!g!qNtP z+r!qr%Ii>s5fX<`E*nlxmo>Z|V8Q${Zr{~1Bx6{n%k*Q1g#``@v1Q3D?lA98-I5y0 z-VZoa@nsTR6j6py{Kx1?%lT24%-DzM<0)wS;vWI!_xG!OZfT;RY zDu*Tnfoc-PiVPhH?dC&jhE8c)BBZxBg(to&f1HhF7chBZ$|A&`J zFhm!er~LPM3lH)}E&A+XcAXZgmCR2VQ6EdhpfL6B`JHGbi#*8ra-}In8D(QGuQuzu#E(Pj^mhU4*m~7Mg;@po}%D?{YroYo@kV6Oi=I-GD?5} zGR#*@wSNHlEilkT{S@b@|3T;^xq0}18}R=r@@0P_tIqSzhDNn4DT!K_+%#VIx>bi!dWSXV z#o&3wF`JcuxW?lcXi4HRNGz*Xes8Gn`P1Y+$02k)~6!@e5u!Pjx1JQ}G{Erg2 zY!>9+kJs@D6w)Dc#zQv?+P014E&y%{RpF>%3>q&7PQ;l?ZH^VnbaQ}$gNpnOG@S=# zF%Ayrd-_qKD&Y99r-W0y0GvY!prSgh9e}hmhP!;Z+xWWPaW*CvW0orSt=EI}DALTO zg5eU;U0=$%SYZeOb&q$S*kHuI0^kL1>n&%W{&c;*$cMn=7)&->%u4}~MDfi0Da~>= zcB?;f#b=5#hak_9zCl0862QdEK8OI!d~)&4q27KZ)R60_upmZJ5$0)jo5;WAfv71i|s+Yy5kd$9;Hs@61j!vkw+qvpTFnJ-xuCK9#xO_ zz!K3Bd7b;Ox^8%b;Ul;hUj?QD%p_?;1!6O_Ju@HLd&lM$HUdnhX1z)DJZg^DrKGL; zvFW34KZd$SKnO1^5~0=L48Zxi-*1K*Z~hS7^SFa6HY^0d^yU3_tTY%`K~=MlXm6 zubPHUs_nXkA`%?i4;aW)@E0UMMu}HVnhkc&%JGaZoNaVQCaHy{%3BJ8QF+d8LLDjq*!ZjdX*$z8nsOpp+u# zQ8PDaoH&mut{w&COMOpYZ?^nYQ)3Njk5kM7SVp=YS$7bwKkOImx zYj5?h4j&B>b4cWuTL7T@93%J#VAdxxBbTt4fyumUU@H+ax!xUPnY_*^XeToo=>2Za zm`CWaYCrfO$*#c#xV`$`ft8^V88ZP?T*!qt!(Rdgl>kD^pTvefVe%t-z+}?q%?NFE z7?bSsWW`0^_$QA!N9SRyKr+OQHkT6%VJ@@4qgKoBb@;AzJ}+;(0ulCgb5`BY+HTxB zj+xI$d{?f~>=%38&DOp<-=?-z;bj~lS>|yP0VgC=sNX|;8L%{U9ixa-;pURUaT<=S zE7$ zHg7)xiqJ^{mU(k+R}(zmlyWm! zb!X4TvUN}^Rd5^UI7+uUrde@@74da0W@Fv_3n+)KfYjzau(FV1ESr2(zc=Epmt<^x z4M<2A%_T(W{;SB;V{GDV<>@>D5v0i0Fkv^ng+t$UpbeWuKB&tzXMf}KylueEV+qf8 zoZwoRi@>6Ve9`^x6i-{-E_K>o-^?ecM!?Ew06R_Uu3y*hnT!lKmbw1RbAdD(I?CyE zmCMY7Yk>;Lh)x;mH$d*a%h0f<8YfyN^OUbQ8Moq@5E*fwh(9z1_89wEpLtkj@6$rC z$&~39lkLH@@B*%Nf`eIlRJ2zOkdP}#;-I7lwMw>H1vqujktVfJkEA~QD8mK?Eza%t7UPMD2 z&e(iEEVhbazu?Osy6ZIPj}UrGhz5=GFwiI}N(>KN*$W|CP7ReuEO<=JrJ(8wAA?KF z6IY<^h@dAG`vEE#5Jn9*w<^`8g<$OZNRl(8CP3e~*i5aiWu}1xM1!^ENHq~2vg3hj zDd@;U{ zB9anS*doxe=$8|P_+6rO^2(Jle`I*kPP%wz%CrZ_jxl!padbIR;zNK4koiut2uXzj z#q%}XDx0DcKJgbXI>i)q1`Q6Sx!YcGVSqGjIfxS&9|7uP6^NV^ibhPE)m?_3=`!2a zpCB@ACU0)obz4gTCCnX0sHVQ}S)(EFU$7$tMZio0C~7(EUxh~sAl_7o`clJxI%F6K z7#51ZBHq8x66C;x(9GGL>Hal=@(CCYDWe71zt7=8Kp08Ki(~$2Zp5TOStbS}W-anh zwTTB0sc>nomKy4bL?O=CJ^}WxLMOow!zwIyIo=w>8IL@)`Z1w#J}OLx9dgNPC`>u- z+O|^$MQP}So#FGBONY)3^;)OIx<(OFk}{yDbU+^;g%x17aQtkMm2%DR0` z3vR44Xgg&RMR*J6?B61foU!+{T@%DBea?U`28f?@ol4`3u(?y4q1v*$C?7Q#R4D)M z*Ww`TBt#(;pjeRNKrgjxAsO1-T4^%+sXrY)Q1wW}B8M-JeGlA#(n?t%pK^u9I%3*H0Ug5a}jU}t7BSER1N@4n(3%Y-* z2mmotGciw+NRh!a9a!NKqe->;fhJOqol>p7wN`!meQoPY1YT%n(q*Fv?i~~EHq)L{ zP~+^&$8WIc{`sQ7{a{+H3M7K*kEGrdqAksOx9<(hPx9FE#EK|VNhX##43~7Iu{R2J+cH_4A*>gI9pLrA)T9^ z*UDmO(_1(uHBP}DLDm7oyT)?hx#XXK-jb)85tt;9D(pHL8l0H34mHHdRJe@S^;nxk zUmTFXkqgZ_29Rm$aTf%EuL0SYMdC>oLm4LfIQcN!ufraR8Cd1B*m$>?k^&^PwbRoy zP_1AB|KqO%8c||>AlxAmfrJT4%ve+eVJHmh(oqDcCI{TeqQv+BHim~~t1JNZ;X#qZ zRxge3e5R+Rxyo59_~bDN!IV->qx7makKNI7uwMv{YGIZKf!hp8_pP$3Y^r!*Mt$`s zp(x`IIMEk!@guqkh?oR5q{#4)^Z0>z`Ge^GBBFk5L+M|`(W{ARu7>)*o5!k`RWVWi zjyh`j0ZtJzzZ%j>krzR~`lZTRF^F)LE#%Rv@+_n5`Er&Y!od82y+q?DK!QN-?$g>P zH8f!}ncKpU4RsEtKs1qU(*TQ^n4~{FfMFIR`w>TGoRollAzuVwuI=pwB(DGYJp}83 zrv3)6>%SDx?F0Iz>HPPCI1P}IiAls{kR_lWE@9;;%cNu)^hasVOITQxy*e61>xdVC zf?|OUfB(~5R+QKT#SfW^d3CnOC{@O$H-I1*;FDPql5ha!r402S!QaBhLhA5^O{UlpR~%hg9`ilpg> zeE{WYruwtMicPc4+76f{-ANBZK8j032L?l)buWT_TR|_q>yJY;w3&>Uv>rW~GSe?( z(Lf%**5*3;v(|7Iz@u^Iv&F+qgZO0fycaaub0^mIm5{tqn zsqTC%14A-qhaCy`=ZnGJIAKJ%a_h=M@QTMBL9t~ierW_fH`;fuvhUJAIPZ$MdrmOA z>#s8|C8x!sAJp*Q17gEavbr9PR|xTj=NTW@b`;AGN-+jIw>qJO*M~{p9l(o_0I-ci zfH|cQ@X9b-{bcM}5(mi1N$QE&eIETH?c!wQCuQ~cA0@qX0i7nJ zQ;BYrGdxtI`_r~FDS%Vn1+>H@Fo^fKJEaFI@cK=hCn?Nlv^+x2UEbTDhG1fO7$~Oc z6@6ZA7T?(FX#dr6DF(4~h)?ufVE(K(2-;*kr^x8>$tuZsWyAdHDK6+t64Ayu0D8 zLb>9tl~W4INZ)<<>(!*d<>e@YG_Zemn^tUSoeZ29iQISM12~Q=o7XMI+uRybKB$gl zAwG6m%zw~qv5S`!tWltp%cKSvo2J6B5_)}#K79aosee%U_T{tnN>ehJxN{hOsmj@yEL}Ted+Rg|Np`u;^Ib_2+|a*Gm&nh%SZ1{_5Mt$aJBUeO%$Z zhOZ5hIHu4itw^kk(QLF(#j^?61GU;L)ro>AHc9-PRhaLP%a;lz(YW?A9mm+X)3C>- z)};?jMTyJ6g$ah9b$c%8SMsv$!k4txk4OgBderl&8m?zauKV7!r8K1u>WPj;Fe@zm zrF0rKf?(4C9w4{1?u)HnP^xH1@VPD-e;o#7YHEPI2+x%jG65k98}0R&9{}Igz`Z5z zi)85hSrwa)g6b*xz-&AtQ?)2lj#HN%fjRs>+5xc5Tms2psSxI`j|*@zxMVd-fBncl zuKUe<;W9!HVCJ|&B2rTrSYh^Tv_E!~w9~(87>re=?JUDt8py_Hi3NIjFPJLTilpl( zzZ#*zYLYHmO!E&%zi#-xHd2ZX`DutYuMhBOT55Q{N0$g=wFAKU=dp^xM%#_`ge?Ht z(SV7jCAXoCh*?B9IOLJs3j@kvcpO8yAKYZEx+qGES>Crx?3HVmyQ6`2&Xl|IM@CjX}Z(dhBb ztA=St9IPcAv#Lg*m-EEp0B#29BF6z;|M+-i4a_WQkUu4>?;o!Wh)gHz_Js;fL)$;8 z=$h(**qZWI)A_;U_7U~(8El3sW)tj27M_szCwB^Rirt)|xa8gG8vXQqsq$dDEQyHC{c7fPH?iDU z1!qwlk@Jr}IA)t;PT`sjt$;NE)3Rx!KKhB9R)CCTUta+=@`xNppTPI|Lh*#K^kfJz zNbCXd8fcjkvP#z=sNSYZ3M1VNgquCxTIcD>jSk`fHM%{!e)y_xyOO88w{)>~^&Ij7 z_7#+Ib$BwHgwl8s1_S*fHkxJsR=lKIOw$miVk$-!+%?#{DM!27KqAbJj)>lD@>cOX z8wbAH)KFFHBkobs<&tU65`Iacy`lB-1kYK6mZ{B=tN&v7!X2=oltHuIB>NBhIn6H- z3ytk3z!%XCk67r-jeo^^cvBOiJ^9wC`w^o|qz4H~bVJ8@5K7%UDICwd-5IXOGf z=WxC*dzSCR8JHu1VuqQWCSp6RVrK_;=^CzSB9PVTB9Lv-UyZ5E91N^GElZipuU=o=&+b&v z?tO(CF&%7Y-*<$*SSSPF5nRHh+^_c7D{&=Z@@dRsf)Z*vB`fsl;NY+r-4jYf z**5KrdPAZq$@k4krrXdmZ9zBRRLfI%3eO}1fHo6k8W8J$fof#Yw8)mV7!{2}^8+|<&SYFF{fH&2G3h@U_GQW}q<&B>6FFkmZ;niB zRV)~w47Hw(TS?`1E^EISz+(^2DVKq|DVO=-DD(5fa468hzsw0d*mXz&5ON7A^xC-M zN!N^8VR{$~%NmYkBrdGMe(pdVRf&)7BrGD)>O z4p7$yrP}t>SPP24Xf0>^S`n|1?e@}4#pZ)K(FNurQ1V&Aq9auq3!O-L*JO{Fwp-ptULfK|i{-rY%7OIUhdpF(_DR>RtbntxL}2~gA<{26kI$k}WMiSqnh8DHr&13O>;c=~Gc*AySh=1&AdT4wf* z)|F6ehVs8$EBgw;@D?n+GGl*S!j+3-kcxq0j^~C4lwlA8B(Ktijc&V}eN#jXL_NXk zQ$I?eHit+eKCfHN+U!gQuisWG*9PE{#2;S+bWCO%&{Lx?oh%8_648m zxq&Dgv^mxzZlSU^K!qLhZp0-D$G=SEB%qIp5+o0Bee&3f3#M{j<92>FB*8ZZ3`w`R zX0?FS*I-|k!ETMJgedgunBM_-Yh#(YAu`U5z`%GBW0|T6gCqrWa^=~quSp31RnZ}8 zdw8}AY;3&;2^xT%cjIm_hr8-iL&OrSl_+Fl_u=uCz1i-2INKG8CPT)46mliz9xE<` zr(Lf;o~dX1Ili5|fU~KIkCkQS*Dj@zsKIC11ZH?#)*(!a@ihY1YxcvJ2+aUWq*DL{ z8BNCjIR*5YW?Tw5q$&Umrty1!pVyj3428$pqEh*Qj49#(cRN(*6-&rh5hCm9y5{^f z`h6n;)j1KxAWXInK{~+Z?8HF8;8bA-3Cq9!d3nJ)m_K5F#U=E#-lO=4^)W5<&(ntI zvB^^00wB=>`+~v zD>r&8Ph2I;4_v48iJ+Whd^CMbXLx`(Rv-ttg$IkEY)S!Y{EO-|IT^`%=bNTOStEaU z&Q!Nim<1#?{^=MRF3RPo-)_K8$(=&B(<|4B>$}!_c)1gBaIUhC;c#n@A>>{QU(ZPI0{<_EdYBPh3g;yT zr>(wlE*<;VUOfjwcB|C2gR~%I&Z%EJ!d7H`646itBp#S~HSuFaFP2W}vZtV1hv zww<^da1zgl$XIQ3uK9>1dIAK2wP&B~_qwX_ZdW12Fn#h5p zR^&{LzA#v`&w-!Dggdg++WrJfU?hor5>@jK1_3EL2KoIK0henp0>{sv(hU*|&tWWM zvRchH*42@wG};EAieZVoY6R$@naNNfYr}1L>edxPR_FmCTWZ1(*ICnk z>VQ~fIp6Dx=Azy&9uuAAJ<*l9s|cP+rjeE-m=yh2sRT4)a&gX^Ic56It<`M=yo&|e zu}N|@Dl$d=FyLhu|2jQkK*0bcNf3Rr+pu8WWdLNF`*4C|oH}&^mi?|X|IbGJ@V7i) z;Rolm+5Xp5Bgl_zSF9ef*SMY*ySMcnXvv<>d)fW30f#gYVwpi&sIaOxO3EbD2ovzy zWP1~|{iR_&QMw_+g0@qYQTAmT?wn>ifVIDtbmaHfnFERutV7Gk!q9cR&d&0u>0Qu1t9u@VX1+t6b3b| zn9@}`oX{#mzz*b3Dng9Tql)69%uxBC>j_v(gaCdD4sFzv{3rd$0gsAG44<+2_rlKq zPcFdS*KpIodPz=6`-m+5x$U4$2nmx;gScG1I_3J>$s8b&Rk#}gA~%i2v?_^CQwVU> z#~;Z-A1zcS0&hX=mRqTCmq!B~5*!2T0%J0wNj%KLeH=qnov~vstXKJ7l^x^tH{*cq znF0J-ju*h6Jn3HNg%Tzh#`39o+#a`Xv`P?Qb2${Yig|LKG|a+Wj>>}R)jWGPvQJ5>ob^GrF@Dh@c0h<(4ufChAgdp{!7LfEN z@6~&vYng#A4Gs1A)_!W>9n;`ec2P(t)yRJR`E=SL2hig?A$T@%fR^upBz}EGQ<6#A z^>UlRl$??TyrZ#SZte0(UD6At#_9__xY%5K;IBqe&VE4zwkapz#$8ZqZ&~NR`azdH zd2~E*b-X+88fIUkKQv#QOD6W)?kvX`1@J8BO@7f=Me~lk5 zF>dX$xEm?h*iM7w@~2kx%UQ#?r*DM&kkzE$A>lsMK)O zIP8ur-3iXD{J*Gs>$fQ1HtP2)0)jM%AU$+(;~WPJF?XEjTA#IUAot5<3HJWRotdFqGKak(!|2Q{uGDQ+Z?IbXK8VT) z&FBCCiE7Kno&c*e3Ftu*;L?}CWS0j)r~#tdC4hZouJ*?5EwmN;gutC)17D2AM2RcCdXid5NBuTH4F?GL2NF!@?#f)9z?nIxaDybFopZ6tqsqxs#<{! zwz(U9=UX7j5j-7wyWwh?^T~38WrX$VYBN+7TQUSkbC$#L;uI!<;=f>RGzZ7xGk^S5 z06bWxl@XJgO2=Mv+Cl%n&Zedge$75u2TZ z%M`QToQ%IU@b6;2B?SL?XdLzqe7=u+OrHnaTOsgXw?xkSfP2G`4MaZ!ABUM-tr{$A z|7Mc|ChyzI`5yty^zuUw!HQt!hIX|WQZ`W zk*r+7468|Zn={3WB=Q6__rxMp-UAZZaGfy6VXb=71)3q4SYcVaWsKC<<|!eR$qI-m zcOaN@B~S+lp5-?fTZ)hoQ(n2^6q>`DlMzMwY=T_RuKpxS{iMFfMSusegYMq?A=aO`P`>~KY!r;_Y2~HRgmj(x z0^ppUorguS{aWvfPxq!Dd z538WR2-36N2~i0k<2h@|X|&idagIQ)&D=@oGIyEm-v&V3}wS9`t@y~3v{$La_6IdLI z06Y2d`6}xL)^cIao_yq98vyj*#-fC@K6|CxN<ul?LgBI zy5=q2ck2JQ3m^}UNu7Nt0M4Ad*VJh!DlizRyp+)SiNJ0MlK7a;8FCYJ-mX%JwF_9m z#yl55;jK6d*BqgL-%RN6d>8@e99=Y{0=p!kV?2taO@W#TspFYxKqP@}Q5WLth_^xE zz?m7PNYdHTcei`G&|~^7n0paUaOdgMit;{J?jUGp7HRcMI9C@p3zcD{lOg3|*80}B zBwb_TRRa%%<#q(fPgEWZn3`W{nnuC4{tzbCb#YO{zo=a)##1EYv0>K+C}d-=b4UlO z0J69={~AJXSF-ia4}PJ}Oyy+`_`Z#)B;qojBhX-+)0zcXU7zimHgjKXDb;=(eSg%} zTfdyfU!u)veeuQ=(5fTfbGfghk^l4Yw+2w5du}dTv@u|{0%|}HK>hIR>FJSwmAis+ z=`F&7g!gHA@#l{#$t?*pqq3Eyys{VVNBQwDhL;|92LFg-l~>t#jOph})MK?K9w zdSP|c7;iI5OIv?~Z>#Jm-(V{^7#~ngZDvB22u(_gfBWG6<=)9MiQ}kICed2a6!{v5 zUYE`qm8f=qIkS^uOv7EzF;uleW8T~0ch2191eKw@=j7}3JB&S*nZc{vp1w|Xe}@MakqXsQ_f=2c5!CU1~WFV&qCUS#6)rQT)tMoO>%FCKTT|Ngu2er!Ct?4Tfk^=**0Bj z!gThzv^eJ*ybP#B*a0d#GCw^K|9+n(^D!HqzWu;_{zjTXWttFEzd#X>NJ-x6)Jd7s zE?v+)rS0Z7TCDPS#e06*e@-USaS|N616G0O{OLTle?(m^H->)Hq)fMI>WYzMAoJWa zQQ5z*h+h!I&9Iy>12@DHyWu6thhY{r`$h{k*%F#vlug&6xrX@b$_u&7tPBF#JU9x; zrD`?S8e~n^AbiG@os7Z-P+0SK33qk~jb<9`2j^AoM zl&eKGXVwjCVz%c`_>49Rx4(_2%0CdjL%v92(w~pkOS9OKT51%;Gbaj{d;I!6G$ZKV zu~g@`}jn z6f*DPlqqUo=rX*&Yx7j-s+8v6KbVgs(re1exYbMBU#5mdHsVDAM4rg90fbMRl0J-I zFb)z^dV4*gf4m7f5i6N3Q6Kg$6Ay`v)#DYbNkqFP9=(CsYd2KZ*k>3q5GFq1t|Rj# ze4n2WHzXDl6ZS^+bm^?wP_CR8Jc)!k(c*|*?>s(wk#3ghN6wxrPieP^pv5-Yad#fI zvX`&SORaJIevFU5PyMhhd7FBA@>G4A5%fLb)-2~Y=jBxj$1MNtsP*n*YRvNUVy0BD zFvo`E(+J4DpD*0?KHjEt6{s&+dI^i0viuFHxu%M9U z{^yU+nyRayrSAo=9o=$gra$@)55~W@s@q=V_585Fh*-$Nj<%^EwLjA4c|a~s@g+zZ zn0%*v#m5qXP4|9^R}>Pi%M`;0#@6QTToY`crjP&Cl0fK=#W5qRRNm;d`+Q~JtivvK zL~wXk} z4im}@Ik)|6&-@ks08L5&NR$dPSn4+-1k|IuuM~d!@fPOliD~Zj>1EZikf7+uFTOY|7d6oA)-b(q!jxf%54aB+jO9j( zf+Wx@rwo!XB_JN|0KB;2K?8nI`F82^oA0ttjT40Ig-l7k#fJm3nA!55|5jtOT z6G~nC{y$`%n#@tB??!IEQW-(!e()&A%g4TONERF;m{f<#gmwbUZ_Eu`AqEMHP#eQ( zpR(9(Kt5C_aaFD<1ZOY8@10p3<&!0Qa7GVGqyPHy|T03Sfo2&y@lp z)KavZUF|D6l6`x2;2^`_XeJFqa`Y;i~xW%U4InN6DOdBWp;?EM$!Rz`l(c{*MrFx zKBuPEMy6X|yLUgK^pT(Qb!tx!HOB{`@7`Y@Syn$kW!0FWw(C_|B!-8$f%=_5Zj<}8 z*1c47|GZNpv#m{WiW}%E-p(W4M6`(*tb$-`lzhc33t80wfXn#s?x*oHdD>|bTU~ZU zE3aXaVF~~4z4-cG5MdvC=6uaD^ktW4;OuoFA-`*euoZ#HQ!MO1C~Kr!>#*eXYZ~+s z(2E5kSFd=-OrW1QfQ^XrqCGZOjJ4r+0)e5qAZ86$UrYopOV4j5co6W2i(pf7T1f^) zA}p5Q?gw?>afQy#8r=Uq&GOl~7bY;wGxz{XR!p6*y5eOh3yW0>mo1lt5b>lp9CnSUFVwHUW?1xKF?=zf+ zBZ8^>l}>Lt(AjG40YfK`TM^yv8Z%_gobfa0LMIErRRfTZN%#uKU{mv;48om z#ZBc(4C7?#^0=@LHgAG3Yr|d%;8~X4&WJMpRL}>4NwsO@lc^lCV2NP_OIy^aM^#IAq-`zUx8OwBnPh8-+Pt65 zPmM+^-6~o)IiS7aH(J%V3c7@hW|(jxMq=TI+|p=~ z>6OE(lI87g;Z4jWsOlLpg55RLRo_s>y}7|<&^_8-$9}Fvz|zKJt)>1UVYexiG#UqH zJe4C3xXry2`nNFH0hl>cRR`?A<)~zJ>HFSOP#s@S0Tn z3=IuEk_i8kXmzr@r5h0=Z2tT@!05k|Wi?d(vUNlBR~)4S8+qi)Nkf5bK#zdXA*2!= zZjsRF86kILP%@NRrtMh_zR(`dOO0bqN|Rv`!;P4OQ3GI=&albie9xZ%GloUI zB>QJ7D9{KpKMGO=!aTuo4bYwk?Zm#7{}U(3!^Ki}vVPN_CyXGM#yS3-xAXBbjKHSr z72J2aosl&8(?RDkhY5~KCA$w-NMCN#8;pYjU;LF>c8I>i{ZB>hk@zv*DlMXkn`1oJ zBdl5ZzlJlAr2h;US&oVVS-w*67sZJG*ZaYIB9D743IjzFf9!?vlrz?Is=)v{7%rwp z`Ce0wYp5u)8BZ~MO_eBpcYLX(jSQGq77{ zRtU6U5=?|Il;cr69Oqi(u_TB7GFzlT*W8*YkA$Aym%={*2Q**S0`d_*DV15*z)C5^ z84|z+-vCNkVly){C6C;AGoj$t{*tV3$3x$7jEMn;E1G2Jhw+~pZ*6Jeu?<9ZP?K<3@dB2$Nb1L~6WwK;J+eVh^M!_Dtyn}5t_(@s^s(U(HVHp_N zH_#`!7j`m*H861fmdNJDyUTNtk#5d;mY&}3Qh6H=cTpO}e;KS}(+zhMz{9BSUnXjV zTB1>%!w;nS>gn>PLrE(%ehYhvd5WZOAvLLkD zv{9{DQB57=AK6Xx;f^2q&v1Go>2M(z68`z3@B~CdxGsSQfD8xh$t7SJ!Q{ z^8AD*v~tZ-XmBstD=SNvcA`VAzqpT89^?3p%EC2}hhxe61vSdZ_47E(fN_gXvmJEI zK1x(v0L@SYP+hZ3`prpfeKfd-;KxnUekJ?L{z3UmHELf(Sl*DuR#?-{P?<=DRz0h> z2N4%mW^i$>(}~uD9l4b5L=uCx`k(po(FKD36;4NzXpLV*cE>ia6n;$pkMk{o`frZE zcz^(k^vmF%TFM#7$7(X{&#EZaYgyJ=|K{(yI1g|%cz$%15aT0#d?ntr2PAK!ZeO^Y zTdiW{{wggK9qvt_o%QPz+u!RtukEgDtaytGk@JJA7z<}VI`T_iA4q(yvkcZH8IPwf ztsMb{@gqc&_2>sWBn__fa)gdEVGii(cuXU)pqa`<)@t4Bp}ea3EE?i>QqUdwD3eHU zmgPG|kNE1RU}`a+eu*kg8pF;(Zd3z{oi5 zoj7v=Q2+|4D{`U_GU=Dv4BE|`y+PVo^|vHwsgFX%}kO?C=@3ocAD|;L)Se zf?H#dqpGMOBR$jsKNdr<{|oRlsjuHF{aMc4H@W(joxsV9WWLCw7gYZXuqba|@J**q zyIBX{iYRPcJODuK1JWq%%aRx>PoLIX(ytYJJ}~wS*}{*3Rj2^1AN6K9ds7BOUrG;R z&WXFXP5=^e3;QRe;sgMSo)`X?R&pxSg^Kc*HZKHdk=}VV-E6962fe!h!kC#0K^Of9 zN~$+7ADek5eZvn-BLl2=V6;K8;oM{P9)UdVL)`5 zY@Gz*%|`N(+Yl@&JgNlFL~4yzabL648*!MYP0HCuYyH-ak#R(}ZH@&UvLqe5kbb6V zG2JGc?2IF5;N&KiKi%QaEX|6aa$aSMiaWGRa!#G4-+p`GQBT!(dkoyfnSczK1g1hE zBQ&jNoO8Q?@Kr{9eveGRaQHgAkk?5Bp{V0ixeEMp8FeEL)b%`TZM4V{jCLE;)&L|1 z64D`zPSCXgPVLZmR}9(WbSlN1j{%n zK%tCB9Q431V-R?s2Hm+f+FY{UvE13H^qCd7Tx_ZH0lod|HkE4q5#d@hi~QZI6H29D zz8XwMgqI+pgTSA0!k4#kkANXuFih+6SVPCpWwJ&529ttjorH|*-nZ@YZ@cejbE5=kKRX-|VYvz*68aEK&HvKTb35D>J;OQ5 zg!1!xbN)h`ns_CTV4QMF>DESj)Fd`y^g~1|%){F832>CA>VC$#DjkNKAD69lSU~nD zBxr_?C; zNRmPb5O$naEE|`+SCv}ED^OhG?XYs&p|SN-kBO*s8@Aa<5FyY z0iFAcaK25lWA6ObeB-ZtNpjH&B!>7k{o4vGJo}bUxYj+$vb^q#9}U=T=lwO2j88(} zV9ndD$rC)LSnF}eRT1%>%`57!u#u9dsfcQzOZ>u-lyDcX z#aEYcR<9n0uCy2Ix*MAX`0Bj#mrd+v;`6=8$3RfAnrR`+NH7QqzFTavB}=M8LmNYqWxt>uw!aO%_^<^Za!w{@zrEKR zg&M_S#qSwm>2_9xnZZSGYP#INJnw7 z)L~R@@AZu%ocN{j^?3L(otfsErmd1|&TMA~^Eh9j(=A@QXIGYaVi6Caq~OzgMkPjH zBL=Znyumm}mykkq2_&PJ6(%_?AdEGJ#mt_p{J=Yv9|Yqp zG@VG%JZLGz5V(;3s2A5zJ)_F+f)sl+=H5VB^({>bJ_8;~4~nmMa;!w{-%RI_vgRfG zD;uK9+08f5scYHWAzbzKvY^%eMJmUAJm-}laUKB}((Lz6 z(3H{O>GL;P@f7P(U#x~7**)W#M0H@|DKID>S`5J}IYoK$AF>REFM?bK z@0tf^m*NnaiZJj^=%UN0&| z;@lz{;@x4O2$22+ee)tuF0vC}N+@u`U?AdE8a}fGiVYnZD#{3NVxhbhdhGcSV`mXFDJA&Q9<)`C7 zH&0l{R(B{(OkGgAi98+y+=-9lS=)V->xYOBXW!?oh7H49V;w(^CHdp?#2IsYMj2%! z(0$glHdr?D&@fH^(mgES^~w^74%NKgUlUTMy^RsB$*S5t`aZn+eaz$QBUELJ%5QJX z`#?>NfdO}AV=A2n-;CgHo4ty0lEhD5u2)~cAYcHysc5Y&p!w&=V4K6Ce6XSfL2hns&9+=UFJ zxZ6$`o~+3B#fxbm^|y_Rp%0&21a(1xB=e7k8I2xNB{*`=lsBYBaowI0*h3h0B98I= z$&Oz1{Cav|crb~kwt+t3B;`eh1f>Aa;L+sBZpmySfXsMKJ<&>^Dvm3KqoeGYD@}lt zIBQnEl(t?rKWN4ydrm}_G&430kE;xR;HrwcF|5Zg<`;<+UPLs0&S!8V9^DQw#5~e1 zOUd!6!hV5F*8hNzE{iaQIZ&7$W)u({^Nxmj z5jOP)NJAr^yFVf_6J!$YAp`esbwpeX3d!(=BH^$=+~`;I@dA@-2{R7vamd!?)V+ znr%Nm5Jvo0OS3>3|3-9FzKP}Xj}^Q0W$2cNFBTfAo{IwMs@znA4f8hPKD%DE0q?k_ zM>GZ#0+Bo(la|xPMq?PI9PP(TMdc8viZ6YhfpSB&{Q}Ee@%lR*-d}y2+h%W2E z9JEb#>kEvCK_`P=>4{7jeC~C|OoIyNzB34w-D`Vk+|>R<&TjUe5a?yk!-Z!#Ek24X z=i^HLd_zyAlk1_y!P9xlVyD!+Z0keGrMzwNb=<(nL8O%Q?mxvp0TiYv{@=g+rf7q` z(((%6=|4*RObSR*K#H{LB7G#=%kJlHT3lydX3=6d`aq3NN-4kHWJK)5EFY`nli?8T z9N^G3W|ru4?dNHto0mkf>)%ptt8*`UxO%Cz|v`WakZ7E)xZycQT#)b0uGLXO8qqBms+@O;NI z>&Z!bIk<}c*39LdWhadm&uM>S+my(AqUP!ue{cD^mXfa|dOX;r;dH<#1Rje4!osDO zv#QkmDlXhNEpLPf)`p&x4}E7Z*6e3~jD2Dm55n?0`vEcdJmu2)%rO?1-Wk5P~iSv$+v zc(LfsARpe~F)#S!*&=VdDY$TxR3kj?W&dytNG1w#ATvbs$em-mx2*FAHOq~Z)jCW)pgQRkJtVAo}^@T&WaJ2W0KJAOK z@lX}TwjAXL!_ZLSr0;kJ9y$GLc6Rkc$CEgBF+uaB=8^nQh7AVpEUYmbzkKGqS+>S{ z5NU)}AV_b`CC}QfBF8<%5a9N-+pyH$`4~Y{BQeH!ltvxOri4F6gpmZuhD zW7BAt)vd0#mF8hHQ4mi&4J4b5eG~l)%vmW6u`9c!y^%)mD)~(Z?96=l3XPfxZxr8~!9^dIpLjj5D3=)SA@qcS2OozFH0s^% zmM`O{aQReu*b@VBE|u&`y716=be61;t(9vIsw9HvgR}*tyC72YRV3W=kv1EUI7BVd zBk8iwn@dvBT;G1Zvz_ib>^WLXRw4e|L>dikrJ&p@qZ~@6eJ30DTYiFLv`Fx-2V~KH zHn;9uJ9N+&YgHuvwVGFptn`o)#WW;A=l-!FEyK)76zx)rSvASa&4ejZ>ok-KQNZVp z-H1ecrTm6TdVUyGAU`DoJ7x^}1Fnt-yBCjAkU66Woth8LLOtqT!Y`894y!M>By(9r z!=vh(loiUSMyRJ<)q-D>h#ru-A6)b#WC~mRp4c`H`j7A}lXq`;|0;y=zu#f`@!^e#h^>SFOGCH=nf0r$e`irx1G`CbP3P#0++~`qWuBM^t|4Md9 zbYNp2s(E#0>-1tslo~W>?yTdkc4{OFk)(%jo2pMwz=O2POqF}q=8i$A-d-x^uObu3 zvcrV<0b?bEElHXs_D??T@S6N&+zI9L1)HJ4c%Sqj_wj6r#-wq_q0Y5UZBMd}dAKyo z1+Ub{pV1gfZaY>QI}g3iYJwB6-1Cia`BA zLa0CZgo9qVO%*qR#n3VgN%$k{SHrPWhG)6uK)!4VjFaGxK<_uSRj*UL6aBHq@5X*$ zut0o*XVmfC4Dvr;?bw<1L;GB9WcOy zG7h#%%R$#ph_JeP;#xKtc(&5%fQawqtg5GaZxK-s`y(h)qFY$GQD;!sGW8P z`WP4>ZfOqWcff;|t<-BbI-Jg*E>t9@(QT<~Oa=u-v2S1L8cCHL&UaIi!3fq)?nXnz zj25fDg0^}RBJiMtL~t1xemLv2c7nZv%bW+U=rriAN|sU?w|H;VSl~M=PfmbkK|h+v znE0x)gC6MBBMU z;Z$&I#%#+hu*d17r5%26aabyyNcT&j{ zt8AgKsh_Awt4>W;=*Z8ny<}FKG`v3ZKDFlI&jYKcaW3~%U?ozjSH*57OP0|;YNAeTw zK3Wn>qzP&;%&IgP4R1~7iy_fiSJ~GXngk*fvuQe=-Y+~3+|+A>WFpVqq8NGmR)?d~ z2r40mG*s8EsnZuMud6ekQ~ItZ>n#5V^!`Bu<6p%-i(`LIbzf2H)oUFyUl*`fG$CO| zU_E!y)6M61GlT@clRlzmn9M#Dh%_}3$ygd4IEGwE{ypE6a3a>yKBC zcQk5p^3=`GDqH8mkE$1*Cx5#OYdR&Eg zmX^6}Ezi=HhxtzJ{1(Sko`>V74Er1B=SR!gS-~jc=c}`ylM7Y%Ybo8*kH?ZDhS7pc zQVLd$NK8+ogPUhX`bz^ZS;xeK?n3uCLo;_K3FlHBn^nY$o`;PX2OUz8S5vrNcb!iR z#>Tl-@x3y*c9_Wb7dz{oe=+UiJ=b5fy(4yaVG-ATF>jCln0A@GOupppG=+9}HGP1k z_tA|Yjt86MJyBv0`BjE(1;}@B_(&eH)I_TOWTYTFM_i4AtHJjFM4w!y9!N@ zR_N2@I2vBQghE4E43E4Vow$P=2gnw?0oof|+uNkCPEXCVm7IL2n>?)`fmeq1tG8R6 zOABH!OG^u5*N;3t#6H%cq-qk5A+=Po$Gsr>P zq%i}SX6XV#0WZ&kFBwjKoy{&kbaqx*-zfIba?yn>5mCQ<+@jy=C4Qp*eO>Y5PuLz| z^T~~_QJnQPM5NJy_-ljoW;u( zq9f=$+`-vFFto~l8pecHbA~9h8eq_UOy}8>uHaBN3pwbNYTE6%c6KB=@555u2-APu zDv;aT%4nu3oQYdyhj}MXFEsEm5JvP6Unh3@xVlYr&0>Fga=F7Fmj+hjcVC2dIxgID z3ts14%;bW3%<_LbCIaQfg2;E8idb`7TGw0kkr)ZP+3mV68()Y!{szD*7n?5PG-`j+C*?KH;Q_KP~z8(*7zVF)A^Hb5uC{#uj&u?5% z9y*K0OJ+aRWyyh*8#@0uZaZKdW zA(4XAr&&(Fk>`|1a3dDdXaBlpG3oZmAWHJ??WX6MJMnjOCf*|*b87J1sopn2|3qZc za&mqZAXvzQ+u_;YBSu&n%$;p=DYxwzrp-An$N)mf1z{V5__xxM+0RkCmQFjs%Jo(B z{G+l6%qKNTN>mO|ztm49c!9|OZ{y?STq)5{eQFrB@E?rcb2hg9r&2*5klL4J*U9;& z8@I6a$`;ZJxfw$vE>6e?UO$#$ZeOFf=5{zw$6f7vo$eLJiF>p71|{M?mkTzMZZG@1IB(!`R-IsJ4;1l{_50g{~;9~ zp2k_CN+IF$8kc6{`WXO23;$U`T?iqat3jtu&z3EoR-jR7-6*sBf%DZAzX#n8sf>Ac5f z_mQ}TL`2ZlhvZ{=n=+PKiA%oV7-1jFr;rO7>O)R2cP#oM=qOe!`bMjE$5V(PyuOXV zDMcsZxx|(ym#AjxNND`Qy-v;20Ykb5eY}r0&Z`81((7eei!Cy8Dc+;_4tb}%+KG}- zwctqOKM7f$LA(@zok-W)*M-wXpwY_iuE4V_@ADg_)Q4BQ9C$Q~oq%Nb5h%%4bWj3kMhQjy9#}O2ZfG zkj|9-1a7Isv>K^72!69-Hgi5iM#p2Tn*?RT~IKb3Dq1*E|I z)_@ArB4?FhUQSf3eW-P$1E!{p0(7O)8TszQHz3^%t%Xx10|)Dzi<+at|6WqVaDh7L z?f)NsfmT8;US-JyG=DfB&;`6VW?tU6VFA0V6*DsVnCS{sHzzAW%gf7-g!UPX`WKGb zN?koYFpN=wmFFAiN9v z=&?ga+zlu>#8O938Ft9fZQH)UzxMS90d{t&>+=zg50jmbqn#U3FaM%000BZ4H!R#B z9e2S)fZFzaT{(F6e0sJ8TH7>klj*p6%ID%@x93}a^J;^GvgwB~Z33&Z7GqK?L=I$| zL%X}XLt}HL!e9O>zWD1u&FS~=?2!BWFK|MnA*0?8jo!UOLkNOThl<-L*4_`xx_|8h zz&TLH{Bt=2dR%-!Xj-$%C8}RJSx{BkySkGdlF8#Pol~EZCKB|(?R;A4MER7Pm^QdA zA}Ja4AuZaLGmRs52ef}*geZFS6lt`!w2ZVKoxKH(ff`?h>-nI+A{%K|8K6+3ma5*>z~LThjm_ScLubc zwv1Xl^x$;-fL^MoWt$}<3A&Ry{!(}xh!M9?R#!R|5nJJcfgV3l4h{PFxbGqxAblP1 zs8bx$_pckx3;oc+?b_V7&vh$=3Oz(zy>ab0sJNKM@b=xXQfl;N<>N>t?lj}=lMkB5 zf0O)I$Q@57)@kw~;xOxX6VB(S&YdgV2l2Nv>j`3CJk<|IG8Ena_h`wDNa2l9{b$yW z%Y;fDQnijld23b$mW1@K+DXB%?Ck70#rDSpnI?xBlnPcg~MKKCe6;w~4tXn7%RJ z-`}5aqIu)$RW`N_KZ3$)99$>cV@%9;qaeCRTTqN`0ID7&Wa6tLOxasn7Qizj!xJA2UVcOO^_|c|tx)Ut*Yw^H*lWJdEBy#!^#z{pg61YEi{zAhBf=V?go~4=# z{!vs@x7L9m)sT7(e^%-IJ~m@-^5t=oMNqKAO-frE-)qmr3!Z~xbIx)XjdZwum%+Ll z)Nm~byuVO5IXyM@<_KK%|FXatqg=_(R5;@pB2Gi=9pX9LzyhwLR>&30rO=b-D?;$> zKOFB19CXQaJNsrGmoxWubA+lk%M)uzlMo;m*p)XT77ISUeK)!A{QN9CTVnpu@mM=^ z=n^1KGyJ;F5*b`n@%>6~pu4&=E)3{N>0N&uU)RBGf!GFOGD4L9B&4F}6p8Ha&#}i~ zGMzn0NU3Auny%o&(w^yRHZsBNhO;E#ZmzBpJa3>qZ(vdpNS{C9 zcV6Hh93PkU(Nru36@7c{(?zi!LU<{2t0$=6r6v98I4X(QU0U*fP#*HLl8_57i%4f2 zfq>fvz4Q5~(`xl#^okzaY(ItnRbl;qX+lH&CBb(~u8YYE^thNNh*XVqV<)04B8U>PECQ|Lfncv^Fb??M=>z}8ZW_W*U7{8|fi4y)$%}^?n0aI)1j_uClSiU? zoCs*%+GUJvod$w$yqRHJdqXZZA-uooH#;O>$kI;}nBPLsAny??i^Su8+}r)|Y!zE-&?fY0J>;ztf4=N=DqYz3NkK7!482TJc7fC5g-?NAPQDk% zj#L9@K=Ci;D=nys7S)L%w*N;e zGR$R?_*wAvvx^Q~8uy?S>6xO}Wn6SsxLurvSn;B*faBrczwClH)lqBAJPmbqxU7kb z{q@sX;rpx2_5*=5OdrkDT>4}ZWIizIW|f+rM|Wa^YsM?Trrc5lDU5%(R7qu)2s=gr$A$E+TUs=(lcouRXQ-zrqnv^qRnJ3hYaES@jgO=3+~rr0XpET_09zA&=zw{3 z0V^8c!yiw2;&jvPX&7%j6E87y2$Rnnxw`4IE{$ma75-|506%|~Kfk}Y88?Rp$LSPl zD~3x*ZaS;??=d;WJS+?&6}&=L_p#_Zwg3XP=qGC1AA}i%rWTfz-Fz6b(gHmcWC8bL z4zx=-W z|Ft-sc01|+U_y&eraKm^(qt7jJT;LpTZ{c*vZEq*M%(XNGu5vWY;GACDL^nc=?dCH~^(7C$|QT7q~&onJfj zZQ3Trf)^%2Do$g+m@}QCc=ymVd7nr0t5B46PTo$RT{^8IW_Uu|q4UE=_N)dq4^8#b zug2Op0xP^We|AXh?vURbvg}Bas<*!8h`%AwIVenu)6gM(;CF0jM zKk^9WzeN|mOBls2M!iu=IPQB?j>SAA!R#~fq7kXLNBM)NEuBNum&*}vkrZ7!Ci44D z;zty|K}_X%r?U#Pk0#D^b2Bs=7L2nT9LjDH%x&2{V?*wL)7Bp;1woT;KdVx4N~qFURPwRmVGE`HF;e)siJJj9dQIZr_}SR}&RCyo zR{O%#zw^=ZBw`dlT2l;;7?udAv%sjcsv@0OiG0Qo;B(u|ap2?>e4{8v=8G)z^4$51 zzeiOVolVGy6@`aLoirLNP9Hog8J*2wHw{dpHFW^VTM5R!vBz9UR z(pCNR{t7Wq`U^(mYcJxtvIgXnJThwIZPU{~y-hPw7uAs2`k8sD!*9k01R;y`%MZNO z<@Pw1-hwjeG~vkUd7fjDcqKxvb`BvZH68H3r5NJ$gT6w#@9>Y%m**qiS%$?GP8xhQ zcpFz&ufRy3OUdjfmj~}uojpBoT)$IYTZxjZa#dtqw0&`voHo9>-f;y(G0xqiS5oBX zCDUD3Zd`+K`jfQT_mSF3{X&7E&@gUA{n%wI+pT^F&EP0rjziQm)GuOr0~P-S>e0Pfqk$k%MN|2IcPhvv~D%v-x&}87}X9QcD((O{%;&< z6)G&f6i!)kF1zuEOlBum;<=J+8x($2x*naeLWxV4i@V$dGiyH~bcxA{_5*Se&iV#? z6T%9oSbD7Pd&=c!0$e1Zag2^UB*%W^?bdghZ(o@V>bStvvFMke|VU7zQ+!ke(rHR5!;U3F# zDeD)As5L}#x%YNYM$!{JbVYvVU=O7oBGzV_}Y@Vnw`A->z3tI z9!?>OHU1ja71T^(v4;js4*>?;Y_`cQ+~G_GF8jEv0UiW6Ob+PP^V&weYv=4Qeynj#H4QZ<=Q0YLh1)%6c5mVy7q_Dc?zKbFD z*)f@Gu!YWa1P#mf9Hb;xNp%m+$>n|BlOi(VaLbriV|E6^R8yn8-f{5+lPoC?kc{rN zH>gw6{XrI?v{K*MdSl?Zi+glJnP%AHh;miU7%7u?`!;(UDtPPaqK(Yb!X$7G;;VyO z0-Y?*+K@)4C`;Dfn+fGbloV!oep(LCkj%VkA(u9Xq;wzrg(2vF_uW^o#58xT7Tw_g z?E;W9QzzY=C!3yqMRgLAFNzo95i`MC_gVQ*9zHq+JMT-L-CwEeobq<;@@ucZe;vPi zI3f1#zquGw5&Ds(m))&Is5Yq1i;i6^h?*T3=9GFhtfWhunJ-%>pULfsS|~YS8;VL{ z_*$&4JeIn-=iLG1=vt*FPs<@BS)=B|qS+b!r+^e1g%8701h%2=C#EL|x$TB{_V%^$ z)JaNqV^g`cnbVi0VPtLd4AkQP4|i|b6<5@Biv|f22p(L5LvVL@cXxLPPU8|FI5dp~ zcXxLP(zsi2cM0xrI?wyO=lq2`Zhza|YmZ)g*QzB|HRsf3#MD?<5~UOm1$0s=vL)Gy zdWbe`Uq0Ojyx$k;;er4Dt$A#H;oqjeiRylcYM?&3^5fx5deNJ%r1-VGh%GD}+;xKP zp|^$9vRPQ>X8N7bLpDq?J>2PDXZho61NCx3;WDF~d(nzwI4&?e6LvQjU*or6B=RWQ z(PtDc#KZz=S~gX);^o9UUaLU!wm@!&1e-DwHg%h@qmRe#e0b+3A=w9Gvx7K!-jhnG zbH0or>@uvQXz~1o9lFcp218SHoRNj0JhE{yyRPtg4SKrtirypp%pClRU?rxe*{YV} zcEnBvlbiFkF#Kg+f|7Ih#IYAgKCplopEZ6I=tHI^AMY{2rpZHC#ptaFHGMvKFrNr zp%`Z2=;C^PX2E<^Jxo3>G5&x7UsJv~G-Fy%;>emQMt2J&b|pFoO0qm7;ljW})BM!Ofg>Hej~EH3BP%Lt){0klXu^tu!g zmzOfiSCOiDatDWhc%pi95qU?nr>56JKbT=r4^mIba})@nke_VXY272 z@=jXdnoH#tCfRus#o&@gWH7q=y;Ww$PdcA`gWx{pIz8Mngh5$xYC7`+!0tkL8EWGl z5NqPhC`(o}` zC~R}mz*5Bq{u}#23|Ty{;WD&m!T|+9np2^>y@A(-xl1GPB=g{Y%YaLm+ND{{?z{Id$Hb0)pT=(7DphMKwQHJIsPtwOgt|@ zsQ7ApYKRhrSpR)$Atm1&dvgQRjhhGXl&YfUaeJ4W+Zu#n05!{oB<+KTDNRl6LmO^S z7Teo<&Fyjnd(K;v{jCp~Kj$+rav}qETu&8wC#O%T2IYJ?P{qhHRC&$B>j>8@pIx_r zw?_FSSSC<&nZ5I-h2d}bWrn)e3Qb-X9(PRB(@5oTN1vO)<`xnNH)A5o7jVMzx!!o?EEC|g1%vV7%yeqpi=gJgTi4>CKHq!TcxR6jXiT2SOq zrKRahf%0GKgGI>SL6KK`@<^F&<&V3At;3_Q1uc(@qtQZ4yeTpsAiN2a$eKu^h?eD$3>^h|N;; z^3%ky{GgdaaMTfZJm4{i+oWnLtJ0Ro5QmXWIVDWS8?ytBt?#A?iw#xIJ61240k?q3_fw@)EcXb>rTg7$|{H zikBd6<}B-~A8)XlTx^z5K${r)hXBOip7BGkigXh(ipHe_V#D=6TP0+< zkVn7!tg5dx<+NH+^AlC)V-ZN!0Qmg>CcQ`KdT)$NUWK=huukpUE(F$Y&9$} z{ZWTjzx(*1@loYN)tmr8)|#SR1*aqq@g~56@IRJ7K$(h~&JykA zpcw@NPtB9pt2p&{-(%r zh&HZ zeqRku;_>40mn1w z%1A#(u4F}GYmfJRn-xX&r9=UJi5;?RaDBEFP~rIcbv@Em-4A7!m^$gtwcA%b;%pO_ zOCEX^jE49&LJw~**1eUX-DnlHL1{%9V5!noPE%uknqdUSj&}XEiDk+WXU#59PWukQ z3*Qf))f;t>a1%{kZnmQ~%zis_@wT;1kLA2pwO_E5t-FE^`{$-~)Nb>u$}w}FEL&35 zjgMbwc{ds3Tl7>GXB6RcWV|9r|8jcfCll9WjPeNHJA`Q?n+7U!+(vsM!^| z@gJYApX*Z&yE)}F%T6aC5xwt%cYe>m*!7I&$-tFdnFyf@INo9kAjY)H3XSo*J?lUv zYQG4lRu=nW8!<1sKUH_;NFSFWYOtgb(FmWl@JzGyq>|#6^S;Y6sK97^0OKUqmj$mZ zHYr^Ujylv9;yw4v*zL$9t|(RkUxu#S&1_NkM-t1WMyX*4`h8-P|6rW|ttHo=+94`j zS#2W>ymH<<^TM9dU?6+l;(NH(1%`cPBI1#}SmWV+UOF6Kk%gz~5?6N6H9w3DkAQRW zMa0cbRB&*J` zfl@)`d)efQM%`1bo7am9`BLFU2)@f;h=Bbt~~& z2ugt<{ycg*i6bU{mLI3xFAO2ic;b`Se{s(Ic>0Sb>ov^@4<@!N6fTd_kv3TkX>&&^CVgvv_mwN8FxhDtg*6CroE}WtYe3}_!4M28pC;bgj7{u z6~EacStrHC=2znv^1oA$;G;{k3%hmuPbBa(9I|j(WSQZ~mSG9H8ImQnFkQ=HxTd)NVImELtjS40^?Z-g4Ho?DwMZ}t6&si{NNuYFuKDTR#`qftxd#d!HV zqtV=>WAFsYgyr%mn<>$}AW2HFJ&`~F11FNDmGuQO2g`KeW}o<}9fdXy{&!B2+dh~ zK6t+=WMgnSxS{V;C#{y3Gmx0UU3?@29KRPf+hN@*Fwm1UCc++LVw;t_$(< z#XihH@1SN{SKF}3^p1NHuKb>(Fe5M<`e8a)Ta*PNvsFRe`ItC1rRInM+&24|fUtwQ z23j9s820L8PfV6uleHm3XPi)d9ex;TJf5$ub>_c@c1RPrpIsQ*Vk4Nu5ReZK8;ti1 zbB-sjo?*RlGe{-w`(WTsk9j6Eey62;fH z=E1s4yRm0Aw4tRUWm0vZo#*GaEmJC8FR$z~2`u2lrs3^ZqXr?DiBBA~Y` zyHYRf7!)KmEwzPFU8_#jI-u4z8mB#T)2MJlG@6V=F(MiwF4aBg^Q*hLU?4fAabcZF z6$u3CJ)}XL!IWt7=)^w`d9(SrR)E4oevKl=FgAL5GHK|)Y&OlKBl?BN&eAo9-;=lS z7^&8qJ|0VRBQD>j=7Ww!>EdkGuO&~rnn}nHw2k5wId2wpdZW#)igz2D{?Oi1mIBA7 z7!RdYW#uUueH}zDy5QqaN<^kLLWJo$4FDY_$_ImRy~e04+Q1=c?+SRE>a{RSAGVhU zrDTFV_Pch`tU3kOvj)~1^E4h+ObEh?CPobc^Yf`E5SbiV(r=)>JM9cNYs_~Ci9?rjv~QH z1#9Xj(l_{2QOGEJuycjJIjQ}dxUo`iDdvL%OK4#z#8CxkQc|}p>`h})D6!#&!l#!O z;7HVR6%;2;Nt>j73JBO-k?5z{74>#WF%ZPQZZQgiBuuaGP zKH0y@crn0?a4DOaO*nX&V%XCgp5~*m6g4j9eiEC>XKbOr_pnR$6vy9JhC{^tP~^#s z%`zl_n@k!^fM{!SgZqRU;4tu<*wo)YN8568pRO%MpppA=`AHRms`e!X%$7=J`0sY8 zdaC@gPq*xvwaR`XJ`q?a&-``9h?DqpcGP2cX!biBwY}QKnxrmBIT1_1%c9_1m;sY= zY8J#fi&eiqgw%%-@+wD(M|hU=GNCakIu2^-zT0!k$)6sG=663_?OHUy7@jF_PA=0Z zt_8gVT>k!|^_iCe%tts%p9y0`fKOY#&C`~4cjSon01+E2yL`MIvt8jYYIO8k?l z{gfGeFB%WOnx^lp`u?P#n*F_T4olRQXLaE_3sMuKE)_I1m*vsK=eZUGa+iC~ahSwT zaLpdXDx41dbCnK7S6L% zse~L|VqUvJ!yaQ^Rc$CKi9A0upZnH)&d51+=7a+zbh+c;W8-GrOb$)PRp^2(77c{1 zq*5LA;`erAq}Cxxxcveigk((Mn_)nNXRC4FRKwIMQh6B^foO4>h{xIKxKiuq`JHhQ zEl2ch^Y74Ru#;+yLsJN4);KzH&TfC{9e(f(;)JpIUIEIim2#VcI7KxVQ;GRwbTs#u z+$Uj{Jgu1={B*E2vj#>to&vPh{|v$&fR+!5SC+;<;W<+w#dY@JM-jqD?7s{<<-Lbq z;4^6>3dpctl-_jrH+X5vCU&~z(C*`WzbUOYi@5!o?Q@RMX#n$+nQkf%ja03zP^V%^ zE>0buE{GyOk^6ndgq+9wm10X2E~*qjD6}@Yq!ecNw<9-~_{ct|rXY7fEJS(XjZKQ}lkYVWc{ZcS!cAxziiS8b2PqQ8fP~A^VH>iFWYKaE zAnNi7Ngvz?`4++o70Hp_T}&qHeqQ{ke?@MKGgfj!TGmTvx!KmiCZkGYo-^?$l{FcU zINYUhjfu^31#@}@lX|5NQ%Mh3)zzB=nTH&WaFuX=B*j3G)RaQqsEz(5dBJ&MZnR#91e038754 ztb(1XRE(z&KVUXnl}IWe9Q2ms_fnEXocsGjqBsd6^R$Dwd&X z7XB)z^GSx-j1vjc_Q-=wb&{sv6irP5bR;`C>A34tE4oTPUy<;YCJ4yT;j;@5F?Kk# zzqYg{97`=frm`EC1fcorCBQ1cC+lM*OcljD6Y~>@jufm3iA%BFB0}%v6R4~>@usk4*98JYsR*p-wV*;&o|_V6-?Z;DeS4_ zHwA~WGJm8pR@G9<%die?532nXKW=dtE^#05nYa5EzUt8&j8YQ$ugGvas$6a51FW^H z8(X(^;CdDix=I=zWc^JFj7g{OUj{4ZW}If!-m6IqjmRSBCy`Q`SmtlR zU$=_KO-cI^odd=NQd12i--p=YxbLi#P;#?w$w+u>h&aYl@D(g6nb0&c#u!F%ph)|X zU3;j~SgT7Jqm>5IF4B@~cX^cAWZX=C7 ziSg0bf0W6Nj?D!P{hp#YJ;)M_h9}|fe^9`Ylmh=uMDjsp#$mYp=d9TOoHeu|tN0rl z8k0Pe*^1#RwX0d&Yf`6iB;o*^WKOo#;pl!8?lytDOm@;8(w9hbb z0q%fyJY|q6`#6%-B$nZ60l=5yG*L%$7P)lei~_##)moliBnr=wP*PsPM;qnwSrlCJ zU}x0%YM{OTHi1MLp#|ABp+>VH#&=T>s06s;UMj4j@q}kR8?muz$@Hz&PGV|)WEp2z zKN=Mdhpp9p$%(uGW6%~ONK$5bCtpooWf3u8gIIRb7yVxu{QsTdywSeTNK(}X${Z`= zq`k9E3i}qr-q*t>=Er(8W)c4oFl%6=su`<6<%4;mWY8yq*_WdTgq=@l#UOG$M8?GV zQc=Q3OSD{}DC zhqr4Loa8J-OC>V^V&vM!vwNNULeQuU=ky0YirX+PMxQt(J5kW083DM(v}<4 zC~ombu;7!M#S?ab=m+#Tdg9~oc@L%KE#A|h`0wcjbYx0an%&tz`LVWo*dL1O$LKqa zlxC`M3)kwZtl+Pz;z`%r&^oRC923_dq9(*4R+1{_-h6zs>oOS7&i18twms{9KGO?| zK4hH+gJF`FtD_+mncCt=0^e6oLy&ikSY5(hC3HNrM+?{hlxG1DsH6LO4nljCL(gm@|l2X2|fE=^CvrJWZ-u{K}p zJQ%tVN_2QqCH0fIW_=mqmnU0tBGV^VOf~M;oBF}@TaPvzH~RUQKuBf0pP#$O7fE4R zwU`*>zF!e6T-Nc&vSGN&zkiukWI;#<`a8VpSVxiS=cBVpjHw8WH{SdtIRL<{V!$_1 zh8s}@AcaA+O7tABar4xrcUJf}W?J@;wNh)TkQq8MwxFsnAF$T&RXtuvo#In>RsF}gy9Q0{c zrwvbg}Rz$_Dhrj6^X4j zGH<{?in11k*5QSNDFZntxT4zw;x5o?NJuy9462Rgkl;2U?2X~dzc7$Sa9|8Tft;e$ zgg0_5p7~e$iOyXF)X5z3vfK@<0uw2A(v__7>JC{%M5}@ta%YZKF+{(CinR2}TR!%V zz{b|ch|4#Ye_4l|Rl~(3kQAa4SHUt#&nE}E;`gsEecK|_p`=Os_~0qWK;&1_RB>_~ zD!>fR8v)~Oz6*WdJa3;~m@(bP2!(3*)-CO_H~&K8Jvf6`RG-*;>*MJ{?{=P+*?amo z$9X$VX$Fc$r)NEjxsAa0#@Il(%zEIiOK?u*w;Yx93`HkaBCN7iBtho9W7tek>P{&JO2GR@ns5$mF_ZieQ{4KUBrj|b7$;hwu5e(Y z2334(!^Xkgy~vHMsjZ5Ix~Ja||B}Zy1aeUi!KV4lz`zC@Ql>^tNfoy! zHE)B4BC8zp`LB!COqw}g@fYU^drZVQ zk;2mb)8g;TD?ItQ*xx`I<5=gQ;S5YRHI}eM;ZM&C%2#sqjm(xTV!waZ#hQRHP&3sJmFvZAoFnjDw%rzN9Ib^5{0Jf_P`Jdf zWIZegBUpsrZfIfoQBIfY!E=sd(;}8xOqz76H!LTOx7&JC8jP;XQdP^1HWyuJLGOF=oV<5 ze$8~N$orIO6c`%Ia~;8ti6%ZpHP2CT<58&2t(4@Lyh~iOFiR{QPQpv__)6b2mJ)0} z4XKGCh$01-@+wTX(kOuQFx1+|jk6wA3>dkZSZag%CVB#v`SZ<}anH(40s=k27-5Gm zW;=r9m~15`qJdx8V0M>Mk`R$8Fk_Q8_9Dy}`a~rOF}cCJ=anE20-F_N)!;AC3;)@h zcsD!zH;;GfjuEVEglRnGhj=NDoaun>T?M3HVMa;l>&@G;D`ZI3a^r~a(}s5(Hdjqp@mVkRBS9u@&v&8#aYIP928^dVL#=WwY$W9 z)|VdmVV<9zcaKQ$Wmsjt6oONv^yt8v7kT2cQg~&)m8H1gQF(R{F*q!B!Xe=@6qzZ( z?K=nZ$bGo=NWSAn=@E_?W1E6*4k+-#qq zz*Z9OfR1;vqVo9i+}u!Ydzu7wNW_tZ>{x#!!0^N_1o@Oibo&Kiz6x^Zo-R)nK0rI@%z7QSWWJ_eA9<}Db|=MmR&d*Jwk$mc$*7ErLNY4#@e9}LAEC*3 z+Fm&1_XeLr*W7V)*+GS{9G&s3e@u_1Q9R0!D%G`E;Y9f54{>+$*%YSYE#sTIsgkRY zkE{nU5HIIS6AyEVR1t)axhLdNa{JlcSiEa>`76G(j*SpeR0w#UNy@>fRakhCCl_IH zDk6S&1`U5C1buMe=Bewcfe*8pQd8eXUm>uaTKpqYoGVynYbR46g&hBnbYLM-_paXDFG{4=-rHgcW2NCUgn zVbZbb>mbb_PO1$xzFFQa+n~?l#+-dq)pyiIUNHZ-!pQ;`Yh=aItHuzF7)^u)Pw-S<^@D5bT(dw{SfxUjy)I9!ZiKfkff3NoHB9 zfNck4{@vUL)Vd-vL}f)>EAG&K!^r&jmm%%b2C?PTbq1yOk`lSre9~_TIpf@aQbJsT zkE7b=Z^1GEjoczHi-58y9%UePL}rs34%o_~OTF}6dvmGZh8Fy0;jbv$!2dbZ&3XqU z2+({yLzEbMdr@1#me`D-&g#MGei%?l>x7)LpzE^=Y|%DN86|udIi0M}jI`cPcNDvR z$#o;O1h;4}Kg?WI-KGpF@6vmZ8S=9nowdb)T*t9poL-PCwA*uh50QJPIz~{f$_AHQme)H1D#iRc!9sd8g0oP$LpZ1Y{Is_vHd3xbJ zv>IKmxVqCMf~Grl$*T*`-bru3BTwF8qguwm&wbmwqju1EXeznH=FDNxqc>Ze* z;L~bZkUaH2f)>cv%4d)mtmgBVg~$JBxk6A|%#ih;3ptJWKb`ykc7s2IgkK*w*wT<8 zFg{Ys>VFXCe_-5IUdUK-BD&ij!^Fgl=e1Bh9y#;K&&`D*d4B*qU6$P3{HK|{!@p*i zw@x-Ty;oPPf;YLSm9hN?*OmTV>+qzD+VmcsYd1cS_xTS+Ngymdd@t9m0q3GKl~ef(C>HCI07a;=!IK9ZCAM>cG0Ru9hEf!;n0D@c$b^lGE7u1qlhM zq_h;E@p>roUwh!7Ltx2d*q*1wOuk!4mZy!4jWpO%o~Qh7oB#75j1c3jGiq&9fg#8| zNAG{~8cuc80{Z{D1hMpRt?W6J^XWe%=ikl?KUAaV<;5~{P2SJ{>9pf#h$Wlh?mzRK zK!oA|vlkGwc~vctAh^ckpBw6Zgm~b}Us<_|{D$0I(wAGKcMielKa==2%t^8at_{R- z@J>D}D`SEXn)>JJ)@uLK|9Qsm?y&S@W2$XWi%;X0q+fG!x1Dtzx4z>}TQ|HM9RCMu z^e`kPSod_lN0Jrr23YmE=(Kd@%?umeYxBi<)%%~mZ}K9P?0OLeI?gW&y1}%VV|w|{!xC7q z>Hqz%jt%*JWV_X*Q%0wZ$^SB{=>1<|?jpT{`^}+B{RYAMUpVbb?+C8bJZmsy@F_PU zSZC}wxY#TX@{GhMr=*Zd#6uiST=wOrSja*0=^rlHu2YkV#Gf9UZ6MC#SxreG6e6hc z_sZbE?+h#G1&Sd{I|9t)q(u>_LVW|pBlrpk&IP}{}g*Uzd+qCEUC9}-I+T>kue^PTRjwEb!!cH&IE{rBv{;A5&W|Enl{%c=kU|W~_#;+<08{yOV_)Gj74f zwzW~mjdS1rKL}SE==nHEbVK8N%&5-ys^prEPemna|MxDJRrMCSfVzK7qjQd+7HLHI z>Hkg>->(r$bZ_@rItm2}RB6>{9777K+7~oNuH1bwk*7`-CV_eXE$1dWe5~7d8j! ztoF%^aWX#g@l=oYQRJm3%GWLoP5 zw})QDeeS$tP4bD|9o_QS3q6XV-FlyzS>i)^_cI+bGK%oi$;nCIZa>Ac?($bs?R{d_ z5Z%_ek)0joF@EGXoWagWI?rz#QWh2FRr`>FT476io=bG zJjoXttuKYEp?1A?#*MC^{_=Px$nLApX3M?1rfGFXJMe8mA z;+q4mjm_d@LB#~D7$Z`geY;am3)-H`oBQf--g`MVHE4yJ_sNVuc zA(y%I@_T0s7|m4>JdYx2a&+&>-S3mjsyUzCaa)FwX@2mR*d!6zfKvNUqY)PMhYuZs z^*N~$=}4J`bf`b+fmh50i8l4|ZL5rl_QKf2t-YZ`yS+(R9>eN0{PIvrAL_ElM){>n zky#^<2_5121>;EjRfE9aeaO-R*KEQU4>+O}I2C^Hn4Y<`j`dMQrJKK@2j6=02u%p2 zDg1JM(ihaW_YDLP>&Snk(}6X2yqdJ%`E9u`$4aNIDXqf{I{AwFwzp#5<)UET^~W3= z1qVE~`{`;5iIbBtaL;TU0Qf!s=B3CZn7HdZi^t|Kb3%Qc=&Zx2@5xh5NY_0Z(ZG|k zxqa8Fh3zyUHbKgbP&Dj@p_qaxVl=gx2_8X;%%IL5?K`>0?-+mWmyp3;cVl#@Nq$zu z2C1`#nlsukyS1+l71c=>&+I#;fGzG)y7*BhM@A9A)Mvow7}rE9?$L*l`|2@=J;(O% zN=8f7z7_gNf3yr)cYlpWLxz0Ipj;v3ej zkEkrqm);}(duA3UijUDoc|+N0Q2*$i7E-^Ua!1XjOOM@mq*m;_{eU>PFt_dQ zy%jbnHWhfXN zwhVW=(mYA;aWyqGZs550vBw6&V%%I$fV zLA&q!cReItbV4-P>UmQ1+s`>zyPEeY|N6}r2<3lZ=@IR!>xRHmlOMsLN(igjd`uJfO8rS5FAC@20-W&`mex^6DrXkuSU#1L53>po} zt?PzrLzrfQb9+r-#Y71CzoX@TABs;R)N>5ZCDdEDEcnh?=CU@K#e)<#8Uh24ni{TE z)y~5Nre0K|Xm{g{A!j1)HMU0+U|3t~w2A}JqG5coktk@vq*gLEHvW*XjBw8571yen z<_pI*%f{_|1DjV%zZBFfL>T%Qu2^UhBET0cN9 z36>i7qwpK){02;wo|zfD-F+0t0M%ym0zMtUP2|=l+x5J?!iA`2{WNSjca?MXI)6N< zX=wRD)ZPNu;QF~m*z(|MGVNK_kRGHDDPYlG>}rz#9+`@Y zdTM$-2<92(AHM?=vEQ_GOTrU^q@?8EEA%P=i1?!Qo|sa~wecMEerXBfVg=;e+1U54 zkOc6pU!UKna?#dHk3hSa^m0bYJZ^DLw(#%Kq1LvxwhI5pv0nE)vyjgF`?)7F34}47 zumDpMpU~#@00}^|QPkmOGmGcl8;Xf6fhc8~A6@H$4>10Y`?dNR<4!scj~}Q^5s|Y< z`hUL!15T2zhX{)3vu2uKnwi^;iB(k!-R?c|YjdaL^E>bqqhri`?V(ktT0Qlu0b=7S zWQ63oStQ)ub(s*vSVG-b1au*YP?FcK6bVbz{NWUhuOLaAPn+}2gUTI;qx5d4(7U0V zyC+`K!Z9=ePm^`>N`C~kJ-Yct*vOw~*93ch?rVhEFA5@*AD=nN@PaN5@8ss`syW+DkDL{*WFiKloCbu28V;s=q|_Q%p*Vx~;uEdXCBrTfbhNE)FHe z*xM98R~kWJ#d~a}p(H(Tnnv=$fWE8lXLCb?bV`wNQ$_%U7UV4R?C|hdm^G{a(e(h` zAQoRky@hJ*GRDN)WyJW~;>OO+SK^p-u1m203k&(5%FODcm*4LrxI@`{ldOil00+7N zE5j>keKuD%TwWpb0&vzjaYIv6m9dM62K_@S)phsZXzA{}LhV>40{Mge{i)TN=<_OK z*?n_;(gmc+pQqHjWU$msW-b9Ea$vLRa!bBa>Ej32`MePTcr6{D~+xx(;Y*v9k>R&+pnw;p}zn} zgvRKIk|YUR-_uL*U&t{QuQ8v$d}d)=E6eAR`}%d6Bg6-3f$rXRK_8skOM0z;w%Urh z=W~1IvvNa?dkxw*+^gs1LZz7ts2d3=0PQLkc;yBJkXE4 zGJun^tM`^zpOo&^Ok+(BvJCnKeqT?)ijL1dJpAaDr4RuCk~e}IJ90*GmseKCqtf*; z0XA8=GG!qv;$H-~_^i}t^LSByKzkjR7XNLm4)}cOl_7-4RvGh<4PgZev;`zU3Qp+x zDajR-rBmD!cm;o= zlZTG{CiCN* z;e3dy)T#=JSC+C0f9&c|$ns3sS52Gy;z~4n8@~e^CClEbB{t_cg#T5X>Y8DL{N%`} zCO!qmCJ&Co+$#yDZ;RREz?0x}9E4T~35~q9dbdz~4E?GjMK5r%pt#xURwv~^=6i`< z3EQIjIecr;RWPG2e(MBl%2gBOGhd6C*7bKAX%JcMJb>K4+a-*^IhkR(xa0FLF3~dL z-Onk%q9VC;jH6%oG;Zj@%N;mQo8=z81Uim}V)j~pWQfaL{#1;5CVUj}XH;)tn*3ib z0H^(ztf&ZMnvGb?L$ z=YJZ(n#c9h@uqVAjc2yn`s>-oYF$>0?}~597Z#UYraPUC9)qLlty)Yz0Q8woUqM#M z6pMjj+4BuLj@Is&g`k}h@%9&76fGY|rVA^92O~tjBdIL2+AYKNs)nkeR~n%` zDl@k>t*VIW4v5tB>Byuspj-C6>jtsR?Lx0XNGGQNj{tYxCeN0=EF5X2nTCEbqlq5d zLY3Xn^#%jf9kX`)JK-w+=jCf-wNE90d*NBx=(@l8K@Nb3rm>p1;Xkva(?56x(S*~K zuhX8q`C%?GPibpMnpD@&kY(nctwr|rzK(ud%R!5Dy!^b{sDjLR0r3~t;Wy*crE(+t z9(YRd=MRk)njFLtI2~_Qci62^#ogrX^xeusd1QCGW*2S0M}L%*y`sDm@qp<*>)O|C z3tz_>JxMLcPMVxExDL`5soFNvWnN!7Sje2{&MfSK4>uxvDusm?5T}KI_AQV6s&#h4 zC&)Q${}R8Jb$|ua{W9Am2rDi?amP~YBx~KLX)Vdof1vl9hN4Q%^gTLcSTnU_LIvF` z3Bi7_tqizR-od@dE5B|%Cgg1xiQgj)Ok!cuKWXs1^X!+}t~d`Ef3-fbXN%<}a8PR@ z`heMfwBCNdUHl%GJvcW9kq_m1DJf=+Da{8ExsF8osqgC`SP1$&i8+(}tzq`NQ z2dJ&Sn4Nx&4@rbtxh1RNUkn~1#bWz4)4I8~Of?b!pykKkjk(# z%z4EZ9p`~{ZN=(FJlnv}sgWLla`gE44@Kvur=LokI_LAJuj!zhv7mJHVmfP2M{9%f z|J~M`RJEr7F45q6;D=OZllAat7CQMO$^XzT#GJFCh2{zitSALy0ty{6yfq-1h^o=H zJ5F2ma~1I>Oks&Qte093>UoA|x;F4r}hfk*i1mjwnYf*LD9A zIpRkn7YQUS&iH5q!A13Xj^6aQfH5#(Hisg<466(Qb%Gt;6WRTN&#D;3>9El9h}1gn zyB5k2sO%Pk^3)P?I3Z*Jwg4@LRbW$LMJ%5pr!Bev^yc z^UV#T=Mwo`1En_2=!6c{->#7JFD?-S|Ev%{s+2FfIF5t>V+~5;w z_f>;Hp2^6E`v-9LfBiFZ(+g%HU?Dw}jl!F=eTgvK10G z+)CW_+$#u_*VBs*IU9$JN{$l-30 z63o&~6)NjC*4yg+fYI z4Gj(9_>to{aPYt@>N#F|#2x+@i$^0CN9iyA5~ULi(HXgjYUA#330}`=ox+CIoN>HDmiWdsAb7`&upR`I9M^-=tJp^fQbd1Q|7L@>R|bg?|_AMAX)sPLsD{Fg`)BwY$ZxS%#vf;#=YQFe&DyTM|m3*qFj}@Z{b)facapVv%DN* zS0(s7K8Q2R6;+(At+4#^FTx_W*5CZE!0F*Do}QeC#Lg}hfAyE(d-PG*gMrm`LZt28 zbjbOIU--{BKQxHG-ahQvvj=vEKIT^hQ#amm2*}zXYwAUZ9JM*#aTierEE#f49zgkH zs#Mqd~yH2edy`!(a*iTybY3cMroQa zmYM`;ITDOR&yu~HSyI|T!s;UAdR`_nQ?hD)0=8Vyj3*3@3`wTKlvIWJb@Nzl)h={z z7cX7JFMjz8G&eS*qrC$$@iBT7r6C2-~G&XMgk8bfeEjYh2>btpk3gBjdEO| zz!thWCw zK}Q$CJFTs)sHv_&UthoEEk+&J(5RxcWc_`{D7H0sx1fN-=)n#WIo zD`HWOH+~)1)B*o<=iv0U=K%MGGvf3JLr;m+ioA635-Mve5f&DPy?gi0sT_v}hfq^n zgUeSgOR33X1cwAGn-P`1J;(;EYc|hD0+s~Sl}}`votsgPGYFV5FWv;TWF8P4q9v?ir-5wVblqzVO}mxD{13Nkz_eD0O5EDDrZ{7xybArlUN{arX5cm^YaKpm)W zfWysVxCryjL=zb~Ub_LDIt{$?vVP3*%5lpS4!Sv+5;GI6o12>(qM{>_wK@x-5ur$4 zkqi${$(x*`5hxWB6pW1Y3}xS0k+K3l-ad0*-yHp#uZ;xeBLNy41moOK^?K02!rVtQ z%5jQ}Sje@tr4>cRMQCknMPyhcl9H3)>pL@oa7q_yEn2Qr#+kI)f1xw=G?vzTk&lOv zSZAbVz)|w}B4y%cYQnN;^SSrUEkIeBu-&YO<3IeL!XKA1ap}FAH)CW?1_CbROnfFQ zH=w!^qn{pz!_FNT70a!mu>oIv@dYZYDpihKH*ZCd0CuKpUOryfvSX_#$Y_Z<_8}@Z zYEG+>{ZQ$y%vy=>|LxzRn=wb>Sfyn=lMz_Gc4rTx-dP?noEZ^DX< zRK&zaKRFXF6&(o>_UysP>#w8Q(;M|-6?%Di$RZ&c?g@$Ld1?;^^KQeXyZ`=8?ibhd zE#YOYszSfyJLc!-e>yiN59DF(cpBl??{1$K(T;EVH%pzrQ_j1SPt(&nTX$A5M@^JO)RVl)L7iq#@ z>Fw)1<4v=^ux_4V$gw0c&u7sQREkfeB_h|&_+m>-GcI4gjHAboA}}COEVMPq-n0(x z;<*@o^<|7!{7`turQDU(q`cMW#VZ)j$rWx@VsqS88CBI(;ln?CsNN6%Ab(`~W?FmL z^_kum{*JC)yN0HQCL|;#AS-LNfRX&rF6k$260#s;Pf&1>xY0d~(zNT{Sf-uR(P98O zkM8Euhs~HxvrJCWk0+!SsJ(Mqq~_) z^hl0$S^D@&xG@E5SFhFdh?v+IIE&&WBGuuUr!h(p&WFeDUm?fU?J{_Ob{M5`7;PNA;j_5q`&U$!Rbs1D3i0&v!b+jF`|Pt%@zF;g zX)Yx#;-~gK1y_%0>yO;OKJ&^*z(xWb%N9ekcrluyeNW#CrpWl~U ztMfUhg>1tW{XpLUS{qwYS62tJ1dWV{n^lMga&mI;`H|1z;_4#GawWFy+-8*HLWFC! z9g~2})tp=H-HdXyButl{#9x#sT9UD;DB1c4`_bOfu7zXi4w_3b-tUeoQs}kD|E$l= zvys4T65tq1mnt1AR;(CXoY}?%8M~82{n2;c2XgOB?xwy4&X+DA@P&i$6E|jbR5SvG zB;fe*&w8 zR%wb!SX9{b1nl!WjM?f5mVi|!cMOmt6Stk(vR95&PL?G%n+%!2%vC#iDJv=~P*hl? zxm%@D-GHvvREanGc>B&vIZh}rtrW zK0OA9Z@dA=b?YR%b_CVc)k=C!Pl&Goa;UTxl9KcwBICI;&iJiA`4)Qmdf?;Zg8=^k z{oU+)YM&}?B3v^vGvFzyJEj>4EJOktvXXgqqM*Yherx>O&5v9auw+bGGZeA`foVkF0LHZ>mCt&OLt%!|@g_i&avIQ0B>F$Z5q9Q@p zwIeP)PHW=vhdmVvZ}mC#*|HohK#qR@2yW)o^Dyt1sRSY;;qd0`7`^@fNT7Uj>~Zw? zDRd_#p{S`*EXNwP*m`?=RXJX~a1pCAR!Lfi@U_Z#?3T0omfZvxEl8Y%p zdS@7KG|fohVI)9r+yrMe2eO^ovQUn!FfcMS0`f)X-OR&BfBXn{itlLLW33dAwHmF( zvuDrZ_aFQow+n8=VZ;I67rk+><{n;r@kJy`ZM>kMAZ*yU0dcW$=$3f38r&vS3&;`5`QD`02G_8r*&%zjO=nCQ&BFcNsoB%oe78SbzI;*GY}Ln+5s!@RL8{=&_^l@e;mA5h7O@Yy{dA7Z>CG_uof(dATyN z`1twY_O08RQ$|GKx4-iz2nh67Mv1_kKl8O1r`{vpNXv?x`ki@iB=ArYh=>r{ zxa}A{CJNGqbJa;KN&nni@Rra*>WWnO3*z<6+0*Fg>_BH*CwlvObxd+0nVX-BKYsW} z+^f5%)zvo(O&#+OO*0ZO5`Zx9EQ7`vV{>aWDk>_`-PsLqq2KcGk_2NX2c;U~CAPG- z;L6o2sFZD3M(BIr{T}}6dw+#*e)F3OQXpkqQDLDfQEqS1Vm*jroKT3es9}9PSH_9N zrDWRd5@0O2MUuqp>+8XiN{<4rJ^L9w#@{l5Udlz`1$j(q?!xrsSuA6@yF=sYE>13p z5M{b~(`F>ZB}|}T{beCYZd4*$S(DMtW8u|3rX1S5H4?C^1T5D)jhQiQ$9=EKVjp-} zSdOmlu856~g}bLa;uGT$c03GsitcE20&9Y8ZEi(rNvTq5Z4~7gpAfI`@~q4(q_0fJ z#fuk_e>)$k!s|(N-NQECIMQp44v(U*zfWDhyrG1&8z92;((RCh_48-X2~}tnHf`F3 z)oWMVH3l~QSuBxHNjVo93WqgW82v;@0cevig90Zmo(mN&Iyo8XM8xBnW+dcDAL*a4)=#c!ypuiw0Arv;@DrJ4W z$Z)A-F8O7oy&^c_VH+nOt6Wf1W0SghIYFhRrArQ5+RQcm9`?XXd4IWAeLcO%&&@|p zUXG$2R|_YoX|qT`6x^^d&xWLZ&Bf!v$9 zXlQ6qyhwRfIg%2S?h|C#;dGXTaqw-zaIakZZcvtQ5lkkUN*qyiim8n{o}HogxhUm`~d%;6+#HT_)Zt>{8pw8>a> zERV%RY~KK1O%vI@dpDAkli}v-ZXMb@+emJ2 zLR8Tu@x@o%CX?dFIy&PuFJDoRLpXKvq>Mc`q^G9CH(hFz&f<+492!KUq=HaM()~)W z%cA`@rnwIDk&(b`5};QjG9nUNw`@g1Y=SDtTgA6@mq97|ZLhZMlq21!mes}yzK^wK_|wt#04E zjq5kAD>{{A$ll)5PZ|rkh%pqEP{+y5b8~WozmLCx$j>1_E-2V&p-_Gk`Jr>{_auMK zSbK6xGXDIp{~8TzvQhlu?~#71YLZAIgf#ydvHniW!mLzWQy+i!F?{`fk)53lqE)#V zoQlW}2nxV+&p)SS+en}h5gzfSZ6+PWyfG56qXf8Mb9Z;w2Z1@H`DC5Yu{Jhu*yHfa zPC0UNC8DXPw+FNet-4BxJWNYw zO8mpE@+&V( zUAfP2=JXj|HB)JA*}4TUJpTeh!a^QKmJ|D`TU9I}0&)ll;-9^5>Z%%Di6x{d2WhMOc=O*^^X|A7YxEdA9(uc|AGmCF13`!)Wuaot8GL|&|kOeYpr;}Ci} z5|=ZnoxXDBVVX9*1SS>~Vtuiiye(*I`aK@6Pszi3`t)i1R*1hl+dFaS&>_6~+97bv zJ&MLfVW1QgZrQsFL+^hCR~yb%;flfmM^_|eug8y9B;&I`jOB^dO1;Gvsr48s1Oc3A zh6LQebS5hLfPernE@^k`_fZJP9AjBXfa9{ZrWRK(UjE<=cab^jR zIZ4EwDsEL50prkWSxVM6UHSF3^-6l*DusosDyuNe^qoi4MrGm{62MuLl%?_v@kexZ zlUR@A=A%40NyU!7FHWF0IUeEB(HLy&Kv`78wBMIZz9)#lwi1W! z(WoG2``&ijhj~rKNX6{o?xE;EKASeP1k`fmWG?ur5s8y=l}L9qS%#KE^AQfywQJVm zg@Z4kL((d;H>`W4iy;zRoI3sme*T9Kv00A)cjD3y9M_F1KZ(El3Fm54VF8LH**{ji zCeh_pC>k7qUup_=`FNo~zWe3dzZ43;79|E?4O1exiIt)oi}!@TA9`5$Y?_h4qm%$s zI^u*(pJfHx+S`;5cv$jy?bVi@ale`dRmsqykeL6(betxija`P~U*G)HJN$upYr-!IMH9 zQ};9PjRfW+0Y_)?#z|2LcNx2EBUVYk`Ru&FZH#hUpupz4ITa-T2rl7dN!OIkJT>2L zo}BGu4)^x;*22@tX~{@QOIdoZJGqA05S~;VJzYIYk4N-0OQyNIEe=SFirCZ3Q>;IC z4Ep#WS5T-e4ejvn60Ts5z44ar?1uk+#0Rdjy|+N(eWdz{lek&A0&fv={?;a`iXySo zoEtgFSebz}UTcKcvK+@w9K-qZ=aoR8%8xO7R~M-^GsV413-;EnTlmqx{Rrjd<=8H1 zCcZ(w2n-SAxE#|oBY}sKfQ)6*CK9k`(5eq5$**Q-T8v6QAd{twqstfxxzUVs-V8Db zty#B52R^E?dmm68`{2WyVhKsO`*;ywDAqdNn2K0hKlkE_(;jN zwJ*FViq{kPA3v6g9eoqsc+s8e>V-kEbX{c8=Fli$z3 zjSZ-gl#devCk?rg{M@veB|v4km?R7{AL-G5L&hH> zSU>ypGkpBX$B0dgg-?JF62-z>4CTnN#(p%$9TtH|;qfgI%D8UHvrVzNT#i7}%1saj z)Hh*7(wbbe*C8r42HES^Av7u+net(PrzUPPU#bWt`MRsC3r#Ie80a4`#boUv>m|}B#{)?r=usFP8B}+> z#Rjw(m%te94q?6NYVAaOTN~=@YH+F`AHMya`2Qf*+e`=PkfPGpbKu<5g|y5J{Kfaa zi_Wf2#Kpvk((}d5yqm(j(~1y@O-4pVY0>aA=g)xYD!!r=H*emoO7Pux-bL}fCT15X)AKveskDNS7tt6W)h%cWX|}FoEt)7QLQ=Zi?OhrNlY{TW@g&K zd_F%3aHY&iu(iDv_iFEHDJD~CeSWfAj$3g&#K*_uwbx$5s;pI-Z@X^YI(0c(*GmsW zn~(_<+`g$q_;g{$iuE=hYntTDq=NI1IO4gV{1`o-e};Hr?D6dEL4}JWk|YOm+9uS7 z4&oxkfBR?n#KmEwOh7!3;hO~#d%OpqYuB+&T&C_Xy@U)Y5`ON?X;q9}on0s|Ek{{# znJ)THo<51(++2;JZr-v5tQ~2r#c3sOK72q4FrHm5o{Y0+&Z1aybYr7qO`hWe%JM7S z%_>>tEPR#(O1Qe3Y8+qb4f%=>&R7W%pc^-C6y=zuKWbW3wku!8?TU&D@h|`KFKCkZ z-+_GxaOjOgT9IJJ)0ePIcV{=Ms;bc3){I*>Z{qyTJfs(w;#Efv1i1RD8+FG0`9+=N zHU8p#@wd9DlS)oi$oog&(btcL?shc9N8@S9;oKu-*ScCeaO~J|1r@bRok)5{5>gWI z^fOOuX|_$9HX(G8Xc%WbXY=I~CjtIem`W5A9fNx{_tZOQPbMv6Ioe@}X^c?-7>qjx z`3cXfK;<80&YK-B$#l605}+mJE@)Cdti~Kdrb>)RlD&h(4eJ~0k(ZaJ$}v7BUJ;~; zN!He1e&%YLtLS&%eHRz6T!5zlVSJ_daib`xs+vYbmQ=xCaz|%vERx(Q^{)6BZ!Hod z|K&g@-Wu+Mzc10IA@CE|En}Ko=uxr9NQ{z?)U;HDhJ>Q6wG9Em0SFOrkFgppNt)-y zl7O=SaTw2jYVT8^=fXiy)`NCrp)$&GvF@BrKNj#tDoDaziW}1{M&=&Vj09{Yz!*wZ zMHNn*JfT+KnyfYO^YX)m4ecN_C|BW|= zK5+#)g#`VEl&DJi;w+-uMe)rC+$Sj3f$%`w$V|hLvb*T-?!qP(nN5hty?gg?yYRL$ z=rG2)Y5gW-NSxBk(@P&DT4%oJ)bx%oowWJDNZ>&vARY}a%7TM~HI~hBHY%xd_G(5s z+Cj1w#CTLnBdB{-TvS@JN>)0i83|YtAo2b6E7$SX&)z~yTMJrWXvIq}zJ%|7?|bO& z>rpaPIl_^RV{ z+OAmM1K7F-PJi(oscI9CH}mpwPvVxrL4jy!Xi&N?y0M5(B@@ufRhe4W%IeMDd1uyf z%<~g00a@S;iM6O@t7IW&&t{aP9i>ZTBL6I9X~#pEu9uhuXf;+;RN&;9lgN`8A;|!G zBq5)bFw%uMpRReXjOTJsGKY`_kKg#l8#r+A03yR9rLsl?e)`jY$AwE51f;VX=_zUW zqpug99;(Fa&XW5$LmP+>hx0%DA8?VhjukQqMJ6TU>Xobb@Z%3bz|HQRyRmltS_Fg! zz~9dwS*un}ikZ&Pt@+qUU`a~AC`UWoHo8^$H_@2xX!CaBbMxYfl>n{Ay!k&BMal&+ceAsj69N7K2#p9e%5v(> zG4B^$0{Z)q`E<D|qzX(q+dO8tI|vE~Hho zoEz&Wvav8Xa}+mi*rYDYnXZ{*iutm&)wNm*jg>$G#pOw0Lh0R71@bVq9U|bFm%jFr z#sq_e)08W-CLsh^-PkS~aQeU_ho@6rGa62wfg7uFNSvG$a>u_ouB^WFQ_p9n^EaOx2|Tm}WT3KI59ijgLiW>-=Z8Ly zbg;ZHN zo}O-Z{=~0JuB2GoxM3sy{(t*>^h?Ubnl)>*;I?gQ$JBFUtfi>12><>+{~fmrZX+T* zLTi(*T(uHpt$FwTcNG2mCcfU~F|b^FB-U8&)7ml$c(ySa~e%S(71q1}3Lh>K;&YVHK$kj_~Iz zmGv~HIx}3j2)|v3qrdtE&IzyT*;6N!Xq<@D^&8hCJvALf)H=C3q2Ou(E}XxBn(7*5 z`zbCi#<|nyK*Vaaq>>oKs>sr`MU?=(N+q(;JA3LZDoQI13BaOC_YrqS>yf!RF76~B zpE?yi;*(hdha*UZ{G7BzxTp{>;<9d3kO5MnYrf4{(4>KZftmz;QTdQ7* zox67;ASgf;K7>~DcHMbFN*Gn(z{crDHW{2xPAL})?<#XmaCoq!E4rXtSa(jHJc$#(`vB|f>hU{K zdOs1in=%19xrhatBeBCz2Yc|QtM{bCc!;vha&$wu^C0@g<-2S5F3>7<7%8f2AS zBa=v@xcDPwV(}OEYi~yf&WH>3fP5ZkV?A<7k|N4AMX-8TMB#PFcKrkWC@LvZ@C|b_ z4?K53%3DPtDJe1mh@#`t}@TW_kV) z_i3(OtqETzjb$D`n@bjReQ!;y3gi%XiS>T2{g&PLGES;1tC5qN0}^|$Sg``DB-y^F zrw1p$IEgc7&w$iz&%f|Iwn+60rdwRRa1p1@p3?YVO>K>)b@X=k;?m{I7?jvdPiQCx zS{mUbaa?yPKI|=YZ@mJ3IyF3q&j!2jP4~&J&_J=;*GoL|iX8ve?OUi5+Bk<%N2R!H z5ayjeDW0s#Z(R5m_@=kF7Y%g{3JfB}S5R<}$$MOO1N8B@AbK+F-HdXyqlBp(l_7`L zkp1ta9k0axT~k*4Q+KpjGkpCdwxQu6oI7_8KltxIP!jT2UVcSEIJCy70DtqF-@x0; z8?kY*$j;7ISLTL|8&FbKg6isOoH%g;IXOA#>FQA;fK5_nYU8HOxRHBZ`aP@l@K{M> zP>$m$it>wrVYMEEY^+Cr8LY33xZ+q}Cn~F}P+U@qU6P0SH-GgvC@L;Opn!CWi;C6t z9T^n~Cl@EB^vcW4$0r|stjc-AmJN92l~*+0{v_T^6OUeHfI~3nu*&1Vi*G-I%L|4sOkw)oLX&?ntEQj-5O3 z!t*a6Ix1RGzAOYwImXAwBOxvUp`pR@9FOS8X!Q5?Yr$easkE_v#}15Utwf0vmn4&0 zoPciLbn?Kkl+L<%;v@=-?qK)s-PpNfC(268@QYvm0!NMvF)y_(dEr4(r`GG4@o<$9X5p?NbQ0SR`ZhA`&>Lx(Akc{)2Hx`ETdy2&dB|9@^erru}r#m*KJsbh^PpSjnb7$WOj$d zMib%_^n0s6^K2xr7!nvu=NON}(<3KJ(q7FdM>|NClRDEl93@UOEPR!8m6@s>vkRIF z3T?I{<^ih*R6t zf`Z;IWC*R?>+U}MdZHzW_4uD${qO^cPhP4hLu*Sbf&+uGDsvV5eEpD+BnnVcH>?RO zRcPm46rj+C4I8jptXo#@FwIC{F(tscv_~q|^bhurGmhDg*u^}Op^sZ!X{bK3{ z<3ye9oyvvTEetu{zLR0|*5>AU41mK0#K^#i(y4J#@uW5u#*XxeoIp5J`6$|1tVQM+ z(rRQ8?XaLQb-fl86rioG4Zh+k{nne`LTo}TT!fA3^odg_D=Wjj+Iw(wa|6d9^Ca20 zFWGjAg(RRzfI8=8G57qaP{i3-k1p~$N%ng^J{IZ1)tW5eAa6Gh?A^6jDgHCE|*$my{B^ zd(+a>G#*OBzq+DI%$4MQVH%0;rlz=j5$pY+7;T_aV?(VAeRqD=P zU^nyL+$hI+i)vvTDxgH-G;W@5I$?PV5rAp4OTbOIMakpo?(L4qn6awzv+uFYzZHek zDe=4WXV2sFW1oXnI1WghaNE{xl3y5rb?dXSK6|||;gq4XyHgcqQ*#sIV&aq}yrR4U zO-)Vk^6*kJ3g$xcL8VL21}7ULSJ|56ac*P)ha`@}c;iG9Yu>H40j{!QACUNGk)TvR z`t&0-);B8Yz`FJ81n?88#b=$xs-?mtzbZd-73zbCnI zfz{U1uE@_1|L`IF1N;#g8j1C5*TYMS7spG?@8EL>QP)tX)+6IFbe|Fs!?IS5&5fD{ zlD#Hdc~?uzN^#@H4KN>ZYU`H|z7TQWbQr=W2bak>hqf-XeR3FuQU#$*06>ESQoTct z!-B`|^2~aUrNyOEWVv4BjeGX&L1tDa$d+T8k-%a}fWSu9JI!8~jf%<&4KEB1jg@^{ ztYg^rW0a$FhM~< z>T>25j4|$ic0Z!yV^CF9sS3^A&0UeCzxvg$(A3tXO6o7a_m^7rBTVQs3^>T4=4eylu03H0clv7W2(E^%BAHY=!#`U7;>vJ z=drM$5I<}DnF7ODkeGz-j^f4eknIjRdti%rHXP-()f|P_Hb~-;Q~ez7qDWtJ^}^0! z@q+Y8%(A8pj2AVE=2ZHL9&tLo-sv&Z9LsQ6>wA7UZ~^H z+tXWtPE?u|oo)C;(k$X#+_AS?VwK}=R7*`xRgUaCOq6D*Jghb-WBaa`Gg`K7z~(nz z$I4Axm5AKk(_KM7)^_IENMJD~K%--5bVxiP^npw_QWxiFMma8y94GZ+xl>uPiUiHN zg0^OzNn4sXMgr4IfNs!gVXh(KlqJuSQxqy!Z$P{QC@D7ipDV*eo(I%@AVV1LIDVkL$+*Hok5 z%YQ?z&Zvk8#;u)O5GHjU*Gb|(0ad0M3D{EtI=7OJbFP892q$5b<01%grY^|t!aw6) znn^)%8m@37uzxs6ry08K|lc8_kx`}sx{Vs0Zx~0`G)~;TQ z-TU@v{E>*hmtT4rn>KC2o#H$A_>+%uR!GO0ciY_3jHcExnz_ctMx2q@;dOaj?(e~$ zx_Beo*&TGD&enP*-?DV$8aVvPH<2aC!KjFEAw&0^Z5Q*Mk-(x!fb;32m{W~%T(n#E z<&HSX5mcdp<0m^S;mg7?pUf%&Ceas5ZsEmC7ZDm6DwQ=hVt85d#9E;kYEJd1G%q8s$uW zE{|L2!2c@<)6EX95{I1m^txo<{OBmGTel9W$%&ITq&v60y zk^sj^P)Lw6;E+nr&)*O0*R6+}hnw!|BE^W)($etS>#rd!B1{=;T%BB{?qZ!L`Nzk{ zgBB*oVOK{NYHDiGF8PwI@yNcTqoa|vDocp~3JMEQTU#rIV_ncDZqd#Wi79r85|)MC zOwF%<2yy4m;q2xOhzbjVw~vo*O2t@SR*vJxkK>M{cdW}^ho_%;S}og|`ZAvz2`p3s z1A_y~`sC&!;4r~;*sB@kXb;JX4rHv6%CV!9)!Q4iRFH?4Vac(FxR+y}0RaJcO5%oO zpdm8|3kNfv$VTu@d_p`99Xf;!8#f~NW)7}hz9zL63-Qi-@8IcuPpdMeg?Q!q6}2u& z7w78gs->=oe%&RgQpPINR;DQ(SGzEdL`a%PQkf`90XxjrNM{jS--?Q(N0GBS3){1^ zb#s>1VsYdT{_p{A=HEnBb=6qiNn!G#l}fSzf{fIYBD&X8T(SPX{#s>Zw&R)aj07kF zF21U3t8wMZ6^+HGB&Eo2<32!av87~`<6=v6ygzbVGI-qG(+yTnCzHHUj&lo}KLD!{ zeDb7P+f;x7f&TiCVe};c0#iIf!$MVQ28-gXEw9Cq&yPsa1EXefK3|zl-2?05|2o$SOk0*zetPb=`+K01Pn=XS$RUzApSuu>Fe-*cIND@tmnM){D&jTD7^CQYH2 zrqjMvLryq$-N6 zNYEp0)hiMb$cYHV-k4adDy{%J?$ge>iNaph+z!WUH*ijf352r_Uz|9B8iWajTVFBvKFM9yPM_% z>jpFYM>dqY+B&s>nWLGyA{7aV3C0~egS?jO#|$qdB`0Cu-hF6pZq`hI!9k-Om(=~X z@*KHBc5s%Ev8%WT%}RI9d)U|Chr1PbkzbIH&6_rhsUW-9FQhQ%`7D(UsAyPdI5BYy zIm-9+TExW0;N@3dMp{N1KKc9;eEiYJ3fLiez~ImrNQ_lG9A%tliHgc_3qYxW$9~+` zhF?g94x(7S8XE9PVG(?#$nhJVuJGt4Mfq5B7FVlB#XVG)m7q{a(UaohbU|2AQK6m_ zdP`XSg9?qL=%l`T{@LddA0Myo^4Pdo&Ci?*&8o4}%UAHuZ{ATd_16x)hF60RNz7Cf zw`ot51n6O4r6b1A$AFKrs1rJBo-*UMQ@3aR$H1^aq&uafLP*1}U%jp=AaqN% zcD16rvs-&`6IW%TDAQKSgZ#gGTX9UDJIDL(?&`#a>sK)p6pZzvI9JidJ3b%rWu}u9 zLl#B)c5n#Nv(}(U@-HhZE0q&AGb2-DLU)SpfTgt7X064c*A5{yJym}fjLXxSoU1X` zRC})$1-A-73cQU1Lh6-xDQMN2_QXkmu2eqA3}w$?wNZ|C8d{v}Wv(|2IrEgSr5IgZ zT(t}m^O&Bb#zjhhAk zZFA27Q+I!&-dls+aa3$Zk(u@WNfAQ3)L^`L=>nL{&lq)DYMRE?sMw}jgbS4kEi~pf z63jq{Mr&&;GK47n)TvXrTPhVhdOFc31(Aou9UCV|(<%Yx^oc9fYE)o71O0ecKFD_R z##T{~R+H|qR_Z^NH?-hCYVS!*CV8LJoAHZQim)-NgN3MMgzM3i!y+ItBCmq)CAK@&5YEZdY%Vqa8$RP3+`W zC8CN}(WAJTcDR&B)}_iwj;18-PvAmgNMe9Y;x8;LL``LlqD*_bd$4j+5mx{6z)Fu=Lf+l`E08GE0fckDoY>n-b&o3=Bd5j#&#h z<1RUgrIM%ku5hx(x%wkYs(VS%+{!!10<&DCjcHczMo5>&eos#ZfQ$^VF70c!;rHi z@1ix)lgpA1RhCcSgujrRXDui=nOjKTh3vo7we6baBLP2!J!{{C}blAe#mRZV-cB`{%V$T+g*40}mr_9dIW zj`{@j%bRF{O6+|Tmy0+lC+4#8!8({vQez?GY+;&-6U9Ocl8WqJ-931F`+y~&QqoeC zM8aBlEkrg1<`DQorAI#2lDj2iC9tHEuI?_-LZx+CCaD-yrbLHwkwRt0*l%BNpT-VZ zBeGQP%?~8a;|I>J605v#&60~XwyX+uRn_QE4!mW^9=&ilwo zUl$aDnk4-HNvmeU)C+eHcLaw7D-eh27A2A*@!7G@G#8L#DkVh}BrV7VxL7I6xVSN@ zIVwq3`d~E<+eWL5sTKoWq7>!NYE+VK9c^&vbkNicas&?xxy4mkxZED<$2I}t*f!sm zPPl*gNA#`}&Q($Jp&_9tzFVxWVj@m!zR1_+?bgJElXBXVs$V zqeaQMANy%(ZUJ*mt;TJv?X1t(ce%Xz!9WMrN_i`yRjuYA3f-~jE*#_-D_5^le%Ff1 z3I+WX3h(Qt=1nLsFW2KRw~>VEcJ67Qn#^Umi`sa?+SR$v>GV~ZSq9LM}`}gsS5N96dqF-xOzxg zDX}1%B+hqExh5-Aaqif;LoLs#MxJQ<9&RT!Ab`LJ^zK589{0AI7_#FBN`?YF2*>FDn^izEJ z#}74;KQSQ@%!3^49aMmhx3@RK!oxuKvUS|4*I?co32z%>_$YcV8cGqM+>JJW|H z0Zwv?Ruu)wXY+%%Bs23fCt(7Z2IY^9AgMa?7{|#5KUB#YVdlYEno9R1dXhP0(*Av zMZF~Dzjyp7!Ww&!BFcKAiDGxZSqM)lgLUA!1EP4dbfLq(|LOn!Cor`mMbNBoy!HlS zg|qc%Z~Y7`o3&xX2E6i$AYHShl$HVBOo-FGm@EO#qa2sSB#foW-46py-tyt!8Rhu! zGW>E6VkNTb09WU%%0V7LCRJ4k z0)mu>l*-UW6qb)zSMFk2Ik`HGxguqpQAV`7NIK4ERV>qZDLNztqr6mNe3GU?UeY~J z?ZI;got(YZfIagl^+)*BrcB^rObO$R8%yf92p|;^7fLrXb@T?7I{O4?bX5F z$;weabF6QH!-pTjD=k$kCy>pAyslo7xKGNs-Me-x7cA3O4j(y;($Z1|2<_Ru$NUhC z1ZI=~QS9`TuyA*EO*LYoV`RMBPleg9=NT{Y$@qdUFQP76J6lm(SF1|WD973FJ*^ey zziryM384|8Po#3ByC^L=4Z{bA5fT)lii@C@VnLWDBqwTdV~!&#K`OH7*l6tCw^tQv zqI}Pk5cNinD@a=7okA+k*dG^Zbk~yLov!P!urPI}G9U5O*;5MC;i{bUeLN3Z@l=pj zWBo-c?BPMFt0xq3MH0I_I^2i7BVGs-;Lk+s>Bq>~3mAQ^9L{3>(tVqpn2bX&A3{!k z4&q|s6a`CKI0AuurN}ZD13Vww<4yEuUKk081n5yAuu$|7h|$GCv;BI%Wa~hVj{qWu2U+vF>c7o zVjv(XCMsH~-n{+2Q7i6A7R+vIZ$n#ao2Gg&G2dz)o*qiW*4)yJp<6>*xgszmP_0PH zk&2M@@80{(d%EK0e(WbdHy?R7@-+T;^7Kh9Qam&=qzadH9toVGa_p7ZqSd%~3Gxp@ zUw0qw$$7O(8c3mdweASFYN(UM3T-@G4y831`nMlrSgcexu|$Jt4QHg{%C##vdFrI* zKhnMW{qKKYW31b@ZAZMIYI)yHGZL6i0(AFlwHf(+kOq-}$5Ht$*{d1lXb;KCBtcga zU8}(X!HA8HH6^R&Dd*)nITBGy+B7D|Gq*4^D-#)+8Nv}NmY&sQ+%SjBKQKV5VEAcX zBVDCTsUToxLDtX-qZk=yk3^x@XcTUzwE zyt14hDZq!x|A#+6tmz?{t1>m#$a;$eLQy$ds8uR*ZL-*-qAV&aQcnnpz=!4d`7&X> z=Q5&%5Xz z>5m=M{BI<1UjkH)3CRiAy?eKkRme(CejBD_)qM#qfme#M#x6#u#hl#CWvwz_gr$^FzKGFW5yMkn!)%VKO?IQV|MQD z?i1HT%i6=$1MxBO$Xb=9N&9rOx=W2jHvL{=l;L6Fny$fW8MIufRO=h-m7#`pAhS1Q zYrh{#oUpNJEC+HzDOyL9@k|AM@zO=OIJ%%ys&z<57!nJ(N>V{8WEJn<*kx_4&(4Be zb^5RW1EU+)0&ji;0aD9xW!g%$PKi{F43C7b5Ud*j&Lpv!H?v59q!NKafn$qG`Q40& zcf(%ISdMm(EMr0ZV{-Gr(16As?Qj^=h$tl%0dDPRMSE8}y864&KhiJiaGZNr zu7%2su2!N#)uk*$$jQSAkwUbsFEY#}`IMc)uWG9}X%XKL zYxYw)W~$UKbsw@Z9|e%+P}d5azY0jYNXB1o#rOa2e~~=LCPaipAT}}9EE;VEZC=ky z0vvyuf2$t&@s;Jg_FULTMma7_Uh~?Tla&5hK^V>#Hgm?jIx!n9D+#zuY%nux72bIL z4RrN%Vf*&&2$Fn3uAwG1d9RAm=0jSL{F|=P)kHG!h^PofM^7l$@r`MfQTe_2!iyLl z7}j`ULra4eN8Y=CFCro%qzXqBO7E7c+tl)KSPGEmLW`C3Z&dCzH8twywa#Tk05$cE z4LB<7K8M_$k=!+whGTut=h2QH3=7$~kDv`#X061i0D1^mTL{ySZGYzVlPdvhZe{pk zrr*S3NyjM1#ge2=KWa6~d*Lh5hy?MF(B|z8unzgGXQ9nWB(LR1Y@bs{W zH$H?2sKC@UIlcZ=%P&1M9e?KcXG#>nGF4Q{^$qoS>lbg~R{kxVJ9kcNNsuY1C37pH!m}sMb&#HEALekkwa1do^+Z>oCQdlfjWE~s> z10_Fm=4prhF$Icg zvLD68#W;QHG_K`dQ+FzXI;4?XnYvPQC7CkP+1-hvJ4I?Ol7N6#qt$3Vl0bk=C9JwJ zoRNXh(kiS0tFl8YaPrw#@_WB@>%>xYyLJ^$-oK7wL(mi)$1H#ayuvlq_a z`4hwn%g?h1pG9&?5~3rbmCKc68uM+OFiBn>8x@O``<|x1%p8-*dvW;%p)j#&z*tQW4fAMEZ4L=^N-XN~rOT+Os=$`bTd-Qtor=PoV?Xot zeF=1Rb)i;Vm!y*;cWF&s4UQZ=BBbR$=;`m#iYEl9L`Oy=HCYM|d--ZYb&$mW$ks!y zQvz*fYK%=*R#hr;_1f(Ml*$U;B{me!Zr<2j)c_Y^#+gskpF@~G9Nu^Z4&VDO5EG-j zaYAB!Nj@I5k-$DJBMmFkR_Nl&N>6#v{>*-lmjo<8j=j&yC`UU=m|z@&asAXl3lRe2r4Q;k z;C^OdH6hkz^MZy4@2x)6;;`SuI@=gtHUj-BE<|sl+&pyy&~h|wP6<$13=R(}GLpG& z%em3zStH6NHzybUQpI9LY6_C&K_(iGod<2K)wprvMkO34=PKiM%v~f)4%u_)8fDSp z6Q@oHQ%#Fh`zS_qbhK9OAOOeL$5+Z?xoe3va=+Qgu^ekF?5) z3yV-CAe-ajhP^DHpa1OQgAGzi3F_ql=U3P#>Gsd?BOriD94AF;g@>g4J3mDpYP}6d}%ZD z!4wH_HR$H-1`l_MU(FM`Kc$N$^LC(b09UVE#gG2=M;hBZc;F!3_{JMZOi6sGQeDhL z%wCtRaYWL^aSSq++uqiWJCaJl?-|F72#wJCju$UpRAoqOjg}fYPZQ!3K;&v(ULLx8 zyC=z%u3A2Rwe1hjGQo{a8=(PH_o-{qC=E=Ij}D ziTeJXuPR4=Z`-J($yLij%sg*De?L{~96zQle+h7I<)6KqQI2+yuw^wWAV< z*DfPN5T*$U35bb}QGiZmb){N?R5)bDq2grnJ%Kr-qFYE~CStsUBNCikMMcis9GEkC z@hV1t{SF+2kerS8yIbT?Ra2$bEM38@48oZG)Xr$J=H=$${XQ369HKInsr>N>U6WWm4y4?-%F~ zKT#5kjjZHk5*8MUJ$v`SKfqtBdr%p(N(Ygt+qZ7l5WK5uvc?_mHZ2BeuP3p}sNTxFEw zeGxCKSDX__d3fpSC6ttvD8S6wj@SgF9PKoG_`{|Pt3%-Jr0n7ZWR&B~!ln|i{xpxt z#x*zdUQ7R*=@cW!O0@u1hybPgm30?GLqi`pHG%9f;Su2~EGpbKp?-^riovadTS^;8 zW}JJq_a?F7EL5_LH*OWh=q<|l)KD+}yW((^4O(>WNzD8_$x;OFCq$goJG9OsZTtw#Fe z97ZHJbZ|_5whD8O-IwOqw))5>#L6@U<|yVC=pV$$=f`m?CfS-by9)w7N*ViT~E(HZQ!5mNK zgRV$jq3&6pnrV-h1Q=_Mj)}&WEn7g8HOK3aLdYU#@M;wb_Q!(lYdPc7t?oQE^dVL1g~mnE;=ZlBA#$#taEQ=ohkX#^D~O zQR!Y2H|EJNPO5^m7I3t@*f-;iJU0S$=-Oora6XMXzJU)>jAK)k^dZ2Bi6;G4OMS_A zgkT`S%N45zKT^|-J8!>@8vK-}~LL)*E>>rG@ z)HHbccqv+yysR9*3=1&EGhgd*uJwDL)Qvn|bO#v@E{GbHdXF~9Z6{HbJ48YL7JcXo ziI5UnSxShmitIrzczi$7=#`h1Yy8$tDu5)fNJel_uqsL_$2MX7p&Ps8Zi%LlbaZs8 z2V=R8y@wR%SHHW=qspQsp1HB{VZTY$C`UWoZcg<4V_E`NHbcL9*h|-Dx#ii_R|2%2-1M)!Ndk6m!=1 z5Aw|8wzqa@9%DyWhgzmz|N7UlZp}JLA@S4m$XZEX=POwu#LIPfR_6206XCZTSCc?wR%p!J9!G84{kVJ#*WAq7V=Dxljb|_-lK|#2v{n|#P~#I z&|w^sh*k2YT7W3JUFX|)uUIN7Fenh+-QAkLM8(eEf|Zg%mu;CW8hv}I3-wh29o!X6g{}@R?%??>;$*r|}Gs@AH31oJUAt2=?vY2PWtBQssFt4wSVf3t6kOP;#dP$4?yBa6(i>6q1vZ^)-tuw|91;IwB0sE*|i2p3K|o z*3yZv!=Ir;(mG0tizWB6Qx^qvGyC}Z=rMRLbcd2BmW7);#SOZ7^JZ+@xozCdHd!jP z7B_F)jA4m$GPcTdA?nd;jPoWWCg`=QA{IHB_IOLcl&pHZ@6Wu>jwP%3(Dn#cI`cXy zv(Z;70ir>J1A>u}nt`;mH0;>EL*ePRRx&4PDuZ-MZ(zLIvb^SV;;i&>^2AA19%(6Q z*tut?#xmIlt?|Uv76jI#SLFnq( zD94bH5PajCZ{lk&d`%Z!blp=9wv7u1%iCl7xq1EgNkBaj;&IT0jNCPQnvj!6$>S%B zC3{Bta}#%}0&?gB82i00+3PVUzBm#Hl9UCyGg&!sg__^L^K)%iQ2F}6QSpFCUx!D z+=2d2K0}dEFBaXaRSs1aVP3ysJ;Fl6z!)JFJ@baC2m^{1(#41jVW!LxW@KAar$p`^|4_9P+K7zlBq0PmQ^0#gTI5+EpA8 z_vm^dAo$ME0MeZAD{g1`ouqdUVVhGwYDF13iQ=a6rmNZ0!&5B=D#oqbw(9AzHs$Fv zr}4oDLLVo}lB_92JDawACBS)=U`GSUS%UX?Y(*mhe*xn-vSbz8B20i|9hv`^vIJ-i z5^Tc9Vm2x>7B4OCt=YU5QRv0agA)9>F9w}QI6K( z_#7?2nQ!<6!f*Eu^hwNcSmLKUckj}a6I!>FVRURX4*DO|@>;$9z4-W(k8$?gS!~*} z2~YVx1uyT1%L&yBG5+y_-6P^{xvC-nIjy1O14Kih{4d zk6sJUzfXWfgJPvJ2Dx|7Ua;@mcW&d|ci+_n@pbFg!CzddQx^uda0&2!;t0RH&sKXsI#9f+$vJNflw5hP$gfe7t;=gq*Z#R0wom zK5V0l_2kKu%DVHNzxWRJ?c0aynrhs>eOtjaOxYm_hAcWolCM@cDsI#%Ict6mZSa;d zTFzg81(KjRmJ>Oyj`~%c#K6>OR282zhva%9;pOS?_eB6W# zrn@f6rR;7QE?&F{f|*h?(j;|e3s_szD9Gs~_SJsIxs<6!^g!6V*;P5x)x*K3pcLk& zNTasr1zOKjKhyW}Bjrk%57}_ZwTYFD0pu*Xd$*KNn5CRZD4+{5{psBQ@pMT7{`s@# zaXsg{mii$p4goA{*RE9sLJr`@rbbN4%zr>(Q1RB**W%3CGYF3gM|?s&+B@2nD>Wo2 z1SzR0=7!b!4qCKMu3ATPUnI`IEvdB;!?F5tvoW`eDv{0V7$@S z&lfQ zzj_I9ZlyjMk_8okWA;=Kc2kc1ef?;ZQZ;n1bPH!93;tTBFxd_GS}iKQJh|ZU&-gii zxOZN;hPEUA@xAQK{?@S7mrexB`RL zZdfbGPY(g+4B=k=J$21ml{y~ge5u6BD$DTR`|pW6)EA8njat0;nf=dT&z?O(_FbTK zcFm%Y^ZeaVA%;N4R1Ui0N{s&Q_i)&}338HpI_<(JbX5R7r%s*{$2D3+kg6Pq^(R_vhEF{sm4|}6PIdU%pw8u zdD10Dz=oTFYG3Q1OE?>H=3r`;(A2hWzDTz71qZiXRz;{v_$@=W| zk}H@#0qUXb`CHcC>nz8b=_^v=-M)2uOwq{iJux8>G4V0TTAPK2rUp$PahLo^PeHc! z$HW3hP6I*&Fwul8eB{_kjC^(&&M&_N30Ml(Y>lE*$#}z5nCA{YheL-BDGgt5U$0hc zAZm5zj-8+t=;rD+(cN?}nDe-8>o$10c;cRrqm#CfIjHKjnr;X4*;guoN2M5fk#oHET?uq_hOA&YhT)sL8ox$LC6o%8?gpHOtM~(9j@7Pj6uK+9;lR<{6|(3}C6P z;wG+3R`3(-IQK8rx@7Y_MFL#4=UmT0RZW$$tFCPwe3Qf zs8})sF}0-VR+0X$nG5;aq1O={7lYxOg>bS}j?$~cy%zNT^k=A+w2ojQP4JR*j|&A8nr^1@b4J77n9W@Ha->yq+&M* zBK`ZkFb4fOSjR4IOiAi%xz_sndK^D`Tz;$)kQdIxrQC!cM_27j`5GSCxy#~#RA7Ys z=jP_Bry(UJW!fCQM|Mt2;6Pl6s&&nI!lvo(NvuOhS4U0ACu()~?%hJH9U%(DMe{3l zKiQ|hzaM!b^LKyqF7B4xRq}x64?d6loB613sDCKsXmd(hV43M7MYoGEFgO4v_wU%Y z9ea1~LYufjPx*P_fc#>DCA2cp^qQujl>y)|#31=FM8Orq=2=T~%FOuIh3qmvh1-lXFf2B!Pq^ z6aWQKL_&aOfA-}ku4E(x=*kH05to~O_ZQCZoU_w+f46-8t6xd%>eVuP@+8Swn4>(g z!v$)(N&249OURHAt>!V#Ksbr;l zL#0udjpD83U`0m{(*ZqE{Qd4F{BHk_XFWI3lo3jIC>d!dUwYd z^ejY_Qo2^JRVXxOZ3}$we*SE2rHTZIP2%~rTBJ8BJkkIplw_jP1VV2}=n$DZf1V8X zS6)?pKSL?oQd3inZ?$V@f%c^MF=e!vqs&2sBKwOR8Y%vl{7sm-IeNP8qF3*Ufnv2a zD8DMg1x!I*U7Zw{T$I5ourKR;uM9dP(Kqf=F5ca1RO@ZYR4e#{%aw9L1^iUyZ=Izi z00{~4Ruq}dhQ|^t$%?1F{0V%J%{E94JzT8z(t()I?KlWS?uqF@_9=L!U9Yhcw11+Z!M8_Hc z-VO0DEEZ9b_ZNFNFvN(40?zx?7$b9=@Njj<$tVtG);g@%V(0pJNr1fHTwDncnDBEl%w=o!2=B>K1A zY7?l|pn8KPCnYIG&gGqx1BVVsgOYv|lLP}mA>`Zj>Ic!|_C@3P?5nD(N;YrZEY;Vl zH9zw?3Doe*!HO#~;^0XM)9{Pa{B&F-H@1o*apYsgG91>LjAKWSk%{9cDh=NxMc-yg zkaDZ?pg!Z)@3+cWEf<%Trm{N|a9>h0y?b>Ch zGj{Y?S-4=KS2#L1r=Oo$SDimkAKD|9BPY#5=Lk1nXsmSL0_Q$<^q6uko-m$82Cc;( zb$hH$wt*UIpa;Xbd9?n@$FYMA@c&E@st$omo&~$VCcr@KHo_C7Wu>xh=Qab}&|g@4 zB*Rl_BQqq^EVIA>W#SpGKsZ7eIv;7grfk+(MT=fMf6)pkk5i$Vl9D2`XU&#<2lrV@ z$KC^bB{U?|JUj@~|a z#4Hh(4{8D0ha)pa%FG!vt?wWm@DF(WT+jy{*ZY0D5uzdAUDV2;d-r>BNx*TH*+BOnWIoxe|f=6 zJ>E(bNf!U9Q>Tik5Gg4uk%s05Q$E{nDiXCz|2cw@onl4eI(`5B_hpA7L2*Yuzxa89 zQ6@Gq)_`*)@e_xn$TA8ZW0&9cbu+6~Jq4g=Ve0V<@|VCtzH+_greq8Xkwks%G+1+{ zXo2K;(OQ^UV}7?=n&r}^ONNN&++KVAHM0&Oa-TVErny@a;uAU)ZTcWmD{@SqKHaXx z@~Ab|_@EZ1)lrr_zr<2T*hiLHsUeE|^|l|c2UsJZ=Ja&CH~KtzB%N2d$wnlPkm{?| zhGac{?6_*Pnq#B``_9cfh8{~yOf*61$y4dieFMnhuj^vfpXV^pj)g0ln1Z8V47Bs_ zkMqUj0zxw>E=fvOm&mEJr=+T;N}zyCNmVXY_0)9Nh~=MAW*O=?<`?G6po@d7vPF)9 zT%LdKd6_yUadS&G>SR{ZlTU1vBzq?hQ^x>vQ6*)Y(F3Q>%j0% zhfP%r`9H@dNcr2pkZNBa*|_05191J@@BhupQT_bQpUa!;-jwHZ7U_FmE7ip@oQ7~C z*7-1C8ny+56Q88`2NvZX`qnv)_t|qjz`Ef4xsKwQvB|#sML04*)6&u`2C#DFN)vz< zcTjpY23))HDv}48tZo%w|9&|o&)vPdd*%ij(Sb6^)5}auZ|k`SScm~I@i3*L=gptp zZ*?dUf=Eo!a#YGdlRYk5TH9JR%^_H=n(h(al%*nmhLwiZMZ@YMVIJ0*vP)$KghH9a zvLeKRm3rgm4Y{SY7MZh;(j0+g_fyP(soGWf*-X;K}OqewaDr_Arhm< zcUpiRe(H@D8J(FX`6^V8D}YF+nWbnnH#S@D=CHV7W)1T>*Wr}o!mWx@VV1D7!(Ki! zcd>H4?Fr}sy|06O)#5jY1~=JrtzYgq+7?`eQA49F@fSC$<3@9ynS>23G#0Y@8T@v?^^eZBp4|GsknlsUt^>P@qHj|UIRo;`aMxN^PY zC(Osvl2WzAHX2&E=30&Am!hzS1cr!jv#-?Ms(U0r4)Ym+6;y73a7fW|VwgO09z&ys z%FNj_%~ibNyA85w(1c02Ts}nBLZN4PRa#nJDy>=#1BNGvJ08{ZK^`W@ z;`azG_x&(Guw26&H{dYx2Us*pyF^+ZK^h2w*60Iq2Fh5JFr?*Vf)aMl zvTEfjNlQtSU}dNw9b(VEJ%%9VevoWUGmEpE(;;jE;7+kr<{@gk-TB_JpPQg)@6&9- zE4nCu_|qTEy8=Nu1Q3YXQe6yp`QDUO`Z~hRdh}5tmsoaLUe~$R_7DF_hUoi23Y>9o zxN`ACt$lf|@yS}{jrab;1U=Mv(C4{ZvF^Y1zJ79hz(?ba0l@)QZq4v2YE62o^@}8e zfdkhf6AZ}s+O=zCcAFSdjYTZRA=<%esKZdI*tmD5>U9oN`~xh-S>c5 z8>&CB&|*zsW!Puk|HS)EFM5D+SXogi8#iv0&%gX!E?>Fq3T3EfIx2mXagZh@CaGtm zQOYXI%xXMv@PO5Rbl-hX_X4XCrIx>z_7<}ad)nT8zpM>4H8n=jh7fgcZR!R-7#6Go zQe^cFw{LVa-?}DgS1P)5YVEe_f;mOOe9@^Y@PdMDL%=ubY3Y_Ch5)X)USnmfa37PV z;%x)32MD*Nr>DsREnx<85l*I?>Sp&;^QdrSu=4<|7O50hxK2US1?d3h;oiDV4EOH_ z+-se@hPKq3M|Fwdkl?4rBKFk1KuHQwCYGtHJVixENlHp;CpVd=jysU|Yqe6*oN;Rs zPt>?x*T%de>Ho~RGg4GsWELUYzf-{Q65dn|Ic@ZHdo;8bzS=s_7vKn_wB< z^11Z`w`p(ofdIc>v+&Evk>WQZMP&C8g{7*C*J&+n(z&L#=i~!r4x(EHALC=v9KU0f0#U^`(4zN z@EImQZYCZqVnz_{b**-PYqYzdD0PaOtx$^^tCv`7P;h5u-TA%u`3dU* z9dCqOAdm4e#HtP^4>gYoMC>l8IO4Sl4+%E~Bt9-)MlKj>wGpvE0qwx8 z3h;r(Tm)sxZ*ZN00!7*F&f2pdJ>WkC68j^)10mdSy}{hLSOQLi`fjw=mRvAzzQibx zYKc?CDUdo&D;a<4)i;DlMtEIUavI(VN6VnDfwK7xAjjCa36RW zc#oUvq2>|c$hlgAuWD*k*d~qyyMIh-bg})l zTU>-Rbuw8zwZD$*JW~H4f77N z4LCV_%!8HpX>f^@ke3cq5bV#VJ z4Q=WoruzEpax^zrw&?kcYP%sXDQ#Ggn;?o%t2O+#rvKc&DeVUji_c&E zRBkI8{%XZ#$vu&4vBqpIm_9Ny(-5k7aOxZD<wOirr%Y;#8rxy2GZ;a<0r_JNmFF@yxAt;Ky_lJ!PR=T>Z%l7EV5Eq09rCLGG)&E zInsKg)m)Nze*n)o2yEsoLYnyG!&s7Ri_%Q(RupGaJy-|a8>tt^j~};v4^eNzF|Ek4 zpt)Y2_YGI!cu(>VvY+XH>VcBH0+FI3X&XD%(DA=hTDkKo$X{Ojvi#!bzmVkAWIKf4 zU_Xh_iX3tAae|N@uGU{~7;w1Oii!%^v15l3oRgag^Vfv&*BhiMVx1v%!Hr1&pn+XzGV#`uGwYR%d;TH`&#g3o5UQ}OK>+z7>88u3p zRp6HC?@N^u@2a{{Z|b=tf2;I$?#WzJCUWNH$k;JsWy*}H;@68x8>~}96kHdtbtJK< z>1!unyUUq)-+HJAoOQL`oi@os$MTGDL{nAaN5NxIo0rQk8^b?ffXd2B1p?%o6$!h= z@L|Kvr31g>)6%$swEn7C{j~I(_d0st0|+lr(3x48GExzpj5#dEu7c6oWAKn*nWXN& zi4!Lp0O#Uo7vm5@{QY;A)J?=CncpNW;NnQ<(LRDtV$YI zCjtZBQgT!84twX24}9(_5WD`MT`kPp8slqIkSa5(M%}DCzI_&;b(tWvXmpwY$Yc)QoV!|XPCs~}arMbm86-n?V z$(Y)0rA4Kx3AS6!xagQ@8))P{qQPQO4&>Hx^K?cVYL$z5@Z1~7m+U?FAE^ge)B!R% z%`|KE(%`y8P~rl0#-44f+XIH7M&Z(BOQo@?(O7aeZ{IANH*U66kI~s$PEI{P#2uNl zju3O6EpJf0L6C;yj)aNkeu9zX8K6f6D5z~vhK}OsobUaf`5o@g0R35-#uPJk9{K7; zv}wGsS>30NzPBaD=RQjpF5aUjr1n?;uLQQX$qW9(TH_^2XmfqD=2Kl!-otV$+*+>B&M_CU_Q)TcF>{8D9Xn1#b!}2~ zzR2o3!koig%}mcUl5SG5_Uzpw#U;g^05}{6CZpDBmo>??IfB#uI3w#T{`_f8EYk1@O#UgXCvQAs3(mQk|m`tOD%5O@(Ms<#ieTm+vG? zw++w=KmH(4^?XI$rhY3H%YeSHx8C~arI%hZ z%MjOf*Tyx`hdjKk|9b$#gFhEi)w9RzdRV!@y(q)#wzvX+Sn9DtFLXFyvq=l?szh2IqJ=0N5!~LS2`Rx9g`)kSz z1%!O;yPbL4P0e#Gy<|zt6&fhV z-Q!S%k>`k}$Rouk#qC!E^CdSAO1wKh%K1nf2!XGY+uOW7;OQP{Xljt+(qa>4RJ({! z0f=k##EBDTwSicjHFK6#si2523M<>poHI+^q&MZz;X@W{ynOkxj2JP(s^na~a@A@* zLcR7d%}}Wg>LI#w)vQE7HWW6VJbAL6!^I01<%_SskW!8Rxi^Gk%gq)U)aEKZm9LZM zf81)4v&zBzPeGBAp~Acy+tGbDE_d>XSn>I<|0F&umWxD2iob3Vs~|!57U-vF-Kb%b zn2>0mE>QD>{dyL{?!WiG?!O)|V?)Dn0~V0ewW~m;T~I&&7hilKJGbxDVEIjR-xzVM z4t$WTR0SBSWoX7v9Pe?BpzHa0;ynTp%?9(|grg@8@)YjVDA9Cr>&nVz5#zKl`pEQsw}O8+()nhxH_*?U9tLz)LW!#$DFxy48#I} zjNZ!Mg1#tk4_k>i4?SX)8Zf>?z5NChx&&JZD zf|~-)xM3UA1$$8QE_bLaI7*pqB8w|!a8JCNfm-cj)?~T$_RpkR*Ob=!I*CvPH8Mge z%yqvs3OK_Mboj_&yT&zZ))-3{>|G&4yhIf4_v1-=jezWr)-RSLlZ#17K31I$(m8YH zSkT+z4!RIB5#Y>=iBk;P-GSR57w@TKbO=MehmHb(@#t+m_W*IJ(&ADhsRt@glKRsy z9(um&zWWwoH6nS0%%449wr|~T!VV7&WdEbbj5Z66)D4iS&^59>4dHc6*=0Wc{8JN> zFTVJqJh$jMy${#qFCTv-hc&sLR1NM0zd^|H40kES0N@DVR_!Vr*|%x>3Z!vbQ&W>1 zK5$shpF6Jr8&}?>^PT%M$`Rl^&YN7qApanHo~P#(c&%F6|M&k>umcGn_8wvAxzl^i4~3W-i#$xwc4Gw~oI=Aw&B9%{aG_*njxxHrp-LJa zT%kI>t|dLTYR${kbI;RLd-o6jAvIc!Wc3THE#?{?6>b*qO|@dn%FB$SHnt_!&WS$s z3dSCL_DBB`#mNeyo5kU|h4ld=tZ(`uKq1v=t0c@4i(^s*_yx!vKYgvibA$<>!MMSD zyXL+*^pCO^$8zLaZYz_63CrHEA3w@D|JVm*(QQ-sJ@M$mi-pF=+s(T9W1s31aePWW zQ9*+u;*7V<%uEB%u&^g2CCD3Zydm>*=9|DHzmdFSVvM9!;Y#Ju=d7VYw3^zs~%I107liLG~ zb;cugMqPj$&n>L|A{=qyq>f0H(BM$nzkk2@2l-3($ZQjaOb{j*5OUZmMrMt)7{il$ zdwPFn2t{wqvG@Ijf`l887!xi$#{%#D9tQ4~Sb@;AF&7Y0pgQS~?i#Vd{d@Nt&nHUQ zD=)ty%a$)Q%MsAaECtxGPZoQ}62fx>u{+HXOdJCXkaA(9TOsiH4MZoiu6Q zW>!YJBqS(<(A|E8y=%s-88R$(m>QyflA-`4azMT9$?XAWO>mw)d8Yj$9GOUHf(?xg z1~Eq?1PO;Lh&gY%iT)S*Ceni0CZc_nMTW6^f2tc%L1lkov zpORxtOpkI-xKvMQ=_^t|uGd|c7nZ-Ebv38TE3dp_d6W5h`S&{w6EY~i5C)L<_&C)% zIAs^9VKFWmyq?X_PJ8vfc}9AmUxXuo9GLz=$&E}O zDYItH5?FDZfqF+>AmLieFD@~z6Whl?zX!Mg`a{DR=>7DA^CyhpxlqCn4)|HfV_WcNLII zDOdk5|0){_w9<&4*2FPcy8g`8{6@`vbhhmxQ}5U35AzxOg=oRC*dOM%-fesC0oGLa zzn-^#yl?wOIO3{7BW1wMUoc;O`Sveu65~2C?NBX7CWlSB2L;+6?|S>?*GzJo=t`2@ zk&p8XE%uMn$qaZJ{l%XlBkz9pDEk{ozd>*j1H{dTC5F}K^hbBs5w0%Jc{%eWBP&C$ zT)yH;{(tX1L#EEu5>(Zyh<@_fC-U{zU%Sdd(YFXK4Yx5L5oWaN>MBKwhfDFrVxxFO zNevGTmn)T5tSSbTI@}v`6k$k+1Y!Z);NS_cOpA(&T(M&Pfg>P-0)tH8-nez6V>bxc ztc)y+_aUqy0>7+)8D1kyZ{1d2DHW2$2dSU|!uEQ2olMTkmgS925_##W97$j3HQzXXMoyMql=b@dvX+>lLQuFe_jCwH_w66! zHA(>e3Kbnng44&3u}kkyyYv8S1IiV|6|UyFh1EGims9B5w@iE{P;`_g*Xm@#Z3ai7 z1^VwEip2o;$q7X(f-5^jw`EJ{_P4?{CBP&*{kd%}ZbGw#TmRo9u#TwO81Mrp*lVFI{ zfFS{9Ia1pZVMW!BtgI{%2BS=k7X&A{;R^LT1mIEpc&ivORXYeE8=NrCHskfcIDf*d{DE%z!`?7N(8Y zl3eq2UNtCT_?grZ;**>r$wQ-Ma*GlKoINeSR^H~Rca%s(ty=ds^yY1uQFcYPg$IeB z7Cy!j?Q6lvbwb^@d;4xVdi{Ahf5MmgvJ;`=-jXIx%HR!nJU!=aR=s3j_91(b4>72$QXec91v`^ z3rUCYRe^|Wk+MsKH5SZYAYq|lk~K0*#*7^!&8^K=hczxX&b&TYa?I6MMT!IM zxsRbvU-ac0v?{bgCOm_9+m3Bk8plsrESQ)8atMsGNI-8j(1oMZce-o|pd1!`Z|hwT zuxPP3b|(yax0ivp71!$^C7CbvN`_sa)?1y1BVepaNlme^MAs|BDumD<@XVCSQw;G< zb(`R@U|F?#m7+0cs)ZS8fH%^oI1V5eM>sGx0mzZ$UteEuwHb%0FpZDXbdWdS5ON-| zh-zzVrRG|V2}J}OIg^@tSNTje%nRQe^pHR|*5~axt3uu*ZH8jtEA0 z9_P)UCnM5E*o3mliL$HIaZD^Kb3ZMND2_11`mwxCy4@=ue=zvmKX3*-h-DtmqU*lR zv+^2?>D;+I`O|xUvRL5ri=US_-g?8_pNV?E$ajb2p8|fNfTwLPsXfsIwP027 zkZwYOXOyYSx0S$L_i;)s)en@1^}qRri=Ufy=%Y$_;MoH4Iet>^Bqk|c+zqu<+bqV5 z*UG(NB&CnAL;BE z3kXDbcbi+9ZG1Qa^G7dI8oj6AQ65n;5^(L z3pR=;f`yukeri>*jk~a<&u{BCD6jxxicS`(#abXcckPs4{OlJ({1Yq4m}H6yb^bOO zQWc;~*9Ow{il&HgT&&9bS&dzPgX@)t)382qsdC> zv9=B0-O;*@*EC&Yn+o2Xc0YMu-N>CM6zhRxA zuL&i%E-`Xw>P)YMeTS&$=XDQUJC{P9nJG%w54sZ-^r zKmV!a1NXF8(=}LU6=fB&d(Uno{!dqAC#fGpV}^FPRn0A%nkMk6!fgvM2KOqdAUbfR zrmEUvgCBhOfx0nEY`*e6=~-PH_sm_;b^ZQ9@0l~K2?%i%X1q$Q8wg$cBrGz_aw$oD z0aXhUwy31Y2+VQ8l4r>{Dp3-JZ90Z#=xd7Lbu<;&viFEw@&CPisX{zY-PY5zKO1j0 zN_tAVx{~7!%aixT78Z43jZ)AAi(_(P@-r8Abov)h3*4s>e;py!SF7dVfrIkz@BX`7EWT** z!qqRX={!$#Y+yduP;u(`Y#^RM& zmVjxZBBN{{)H&R_bElQEg0Y6}J*l|B5X7Q~TbN29SkWlZ8R;1YSmJyrp#|`Vbds`5 zWd`gcHH3Ahp}9c@YyTB1gHTOfn+nIy;67hv)`>WLTtd@FXitfpIhQL}s;@}ckT5HV z@XAkKQOnieENK*5tYBZY%-vTw_F%yeBGP69V;5_bldt!bMS`v8w`0?XAVo6WT z$@TMzSUzD!hQ$p7RoIblSW;3V)22+**nH>eH8(VVMy}wYLx+?}#!s!GX)zSHSYBguqY1^sM-NNkg+dcd zaS4iCMd&Di=W#5=?z)nN4~vlp?p0j92u6S|q2Zy5v>h(3&8<3>^mDZ;uhm>L>kRJL z7gxV%N>$0F5;>{yzH>@`@a~Q4^1lT}N~pTvI+_ZsjBAbZcS>%M{?ngo>cv*OZmn+k-~Q#>k~|{Wh&D)g2XT7(^l7Y?p6-ddUc=H2!aJci;$?iTq&2zF4=0y%wcO|2qXLtH5! zN+y>%D$_uHxw&VgTw{-g(GgN7ffCx}B0O-;WysB2GDX2VEow!dRkSRgE9fi9^Ndg{ z8U_COrO!)FPL3%XT$i^!IX%EwBNM>WtzU#AU>meADs0zQ*V-gSOXMOgCZ~%blZt_k zO9&x3kQ>)V^Omf7_`5jJ@BPDHapzx>tamkX(0cfVGwn}a{-AnawwtJXo z$NIw6iclsFI)2=E$w#wkwpJGO=`ZT1i>T|7oIOt z1X`;F{0X8n@Nt!-DQb=h{X{nvicI*cm#>=J3AY!EP1nib2+000|DWjo@}As7^#IBi zY&ql_LYR@EamS%*DPj>#96!+%vH1A-P6`>`mZ{UG8uc53BqAchV)uAyjvqTNP{Dx) zU!m+U@S?(QQ(RJPf^qW1$@25Jel8OyOpr}mHe0?Ud55r7t$J~lOqw`JD$6Qm$BrGc zaq~uteVPzf^r*Q$)vBX$ToU=)tJMpn@j_B79Luk32QXK<`_6q^+YT>`{v&mS>q>}C zkg=LxLXm=2Mb}n%d-V+S}wqt?4*g^E%moU$w65L0|3nS>F#{IsWi|xIA?C43WO>n|=|F4NVPl zuHc-xhNjJ!CTmu&F>RK(gkGTuL^vW@2#9w)u}#mF9L?h=k6RuS!hY>5Yb8+u4qYb$ zH*Rpdn*aK+=DB*boV&5&DMqnxB? z&zzHsg%{=e_3O6iL`Fu+_%RdAN<)wl_ry9obmWl5GLK3tsj6qna)VahN!?|tQxlnIAeAr>~*`u&dY&FxFv zuvV|DLF1H1Rq0+lZ@L8UJ|xN%;GC`msgR!IKSV+_RU>uM6eT+Eo7f`jT3ub80i8My z=6%t3J)r9_a>LWDUxcHLY?Tq=L&Ifc#zPo6Kaj921ih6-*ayu2Nix~eFP+gHwYJPMP-Evgzf|$ z!VEVqba9|V-RFPT{s54L17(8y6_S*^!!m?@25Xt$lkfQ2PhOMP*1cxHBT_w3 z3Q9{$ZSKVY4g=0;pLq)2iYL2Fi_-Ya8LE4v(+wgpmYH~jRyj2r< z-2Hif-?;}E56)lbZ~FdSzX-=b)yU9(BSIsj_HwNu@eBc`W08qOyn+QFNdK5XJf6hH zO(7ODX4Dv|x>{vP(Qv1-2*FqBGz21lFyuf!&TIa8o3{sg(*p=NM<_bmGbfr97_)2F zF8NdmwvaDINM$$*7+rq(bu+T=19BE#fY>n@yj7YIkR9}AmrPXf4146sf zdc}~dSgMqh8##KUy!WT~%-Vz{XVR2O5~7rH*Ay9At5^ZRHq>}bO-{AE$Q8?0Sgevt z6rX(hiHj&e=k)y=bDbDyn{uCajahcxp6_Ay;Wx}Ln@{@Lt!7s_E3V&3CuzFTBw=A; zvTWHhX=!eeU;pOUa^~zA0|;d*I)1{G$?96wzPWTs+W+V8MOyAL^7tqK%Kw}1#Ao(w zQLa2Cpt!sC=p{gkP+e1PDI=g*sX>bZ(o;h?R%?v5w7Arik)F2oe)sS_z&J3)NlR9- z9(!_O?HA#Qwn<@Apx7YGt~Xvc3zFCcC_C6K2%u9%0GRoY1)XLRGWkuTWq#k2cP6lL z^$ZCeBAMBlQr}oFOiG))T_hhj4UHY`*wDCq@3yap9}?bQczZxy`gIL*`h;?JDm5A7 z&lE~^J>ssMK7G2m7M+}Tgz50O;j&m$5@yYrWk3^BImkE0J?S*YJfz-OV|(}SHDC?} zj2XA5wG7mTO&hE%7H&f7JPrvQVpb(-ARt(Yg@&lrMVyqxe0R&$IR?+53ppoBUXeOs z06xBX1RmIrXsSTmne^~XA`FQi;Fcmblc^H}HjzNB3CFkM_dj@F_U_wj;5p)*xLm*Z>I;iCCMj9>9i= zT7`_tOO^8efBZ?^$R{LCh5Pf$$vROF)(P35ame=1zZIY7pBK^M2w0B@UqzR^HNe$x>eSgYlebV?oimN zV10o!VE69bmiUi*5+EF&9nh@^QoJ`*!~pTSb?a8w{9Urb<|vFhg++xXTuJ{xh?wwg zy$=~rsy&aZzfgVY5pp`kYC z5yaCbPm}hxcA21{o#?w|_1sSDzAtgTMutZ|&;@(nAA3LSu?JXNo%OZH4g26rj|fKw zJO28H2K6bZUX{bDE1`8p-5>{>mi;5_KE2F&*; z8@T-NDiA}0TeGV*G+-{q11HM(L=aNi&E^b~OB>@9EAm0jH^5i2#%Oh%kEJKu2xJg@@S`2gpWgE;iCr+J^OP4OmzJvRW!HDA}CnZ}hrPYE|j|)~N))w>Q zehuM?5MynKR7$r&0jf4O>p61?-TcOVKmNY{5*-z7=a`<6ArmJ~G^^H&!cqdPulJknVJ=c0$Qq^PI$tkDvTu$W5?L$f!uxO!z zjWqu;I!4}F_omF7Jy!uy%Ali_g|G~n_ptM@zF`ehOd6r@ZT-^&1G;1tlLSN^kZ}U% zFi)V_(y$cWYaBY0+!2x_AaCEk-F~-b&5N36HPHm8{kWI^5!0x@UT@S-#2>o4Khe4= zv|DR_GURl0NH1SpzgA~?cIOMv%hKnT%G8-tdvsy-a<@;_W{gwDUT+(7q46%TWr(_E zSV$UT*7 z<*g9p)Q1d6SIbS$KP@v&ViRKxLCZ0xC|dR4m@(3*g1+smO)^+X$UC(w*QM$I`IQuC zALXls$@P#2O5BzhrXv^&@(SeB&pwr-M~|8ie&?^>k&#&=JFPQZtGD%i4T2xNzYQ z1kZymmkC>tUm&TvQ$W8vyfI5=LVhq(?Dq>5C993A1u{7OqpGbW&a z_=kUxOQo00iu~mBPs}p~6VNcV=9s5gj67&m@kk%3xzx%<>&qPf_rG*L4J_YN=Oq9C z`XBN?weJEIaQE`7ud1b;;8Kir>v{!69Y22Dn1op0NH1BrVx@th2KhhOdhdKd@4H9o z0mcyH%eC%$ZejI^aAYu(t3}c>?ihmoB+TRXut}pA=c9sf&>fAL@Ha@Mi2fr+M+NRc zUnM$Lp*1u@>(1%lgBmUygkrr;+LJn9zxwJcJLapey(*I@X$;|RW8XWr?huf601`MZ z<$%yQ*REM>NHna%2Q?-gLNPjes7{)|P8uV>wQJ&kz1|KDN3YM@y6*w*GlQP{_%Iel z_j~ky)7a2tamC-g`#TdFO>ZSX|^* zGIyAYm8zgDYomnBiN;4+zMEVx)DRLV=sjkNsA>0CV&Du3meXUw{?c61Y z_8&5)9LU&ldlJGqdFrIBdSR8k@x~iQ=g4_*JgxzS7f>DJ3*ru2QpSvy_MExWo>!t_ zo_oUEPhU>(@ss~W1%IJ>uI6Z12VfEnmoTIUhmRb#9L5RbCkT0-DXI4?ZQIcMpJ#i3 z+jZ}jdF)so5spkWCI}?QnOT{gv_}Rg!jb2W3*_b90qPpS8q-sakpbPC2Ed0rEE0Cv z52!xs;UT11bZL~>L3pAW&zwC|-hTUSbGMMZ{DNDr1a!B(_j7g0=^x5PcWyavAN9Tm0J9NRcvW44^y!Q_Gt>&w3Kv?(u}Q5;+@V-n z2uKu?+4E*wC<2!%-WZr(C{BJR_l!^=VCKx3vTofvA$0?kX=+NUL};1_tToI%rkdpm zs|yt6c*%2$HAqe|VX}V1dh^zR{_fOt?i2IG8g=HXeXpOBl0iBIas9z6)UrlqS(-`S zxjZQ;D=}pk#wyUVwRN>dgNG1CaAUoeUn)0Y79JUHRxTv!+6}fwRH?FD7#}Bb!^0%` za$ToW3U9k3D-;0Kws?_*Do80nm33P4jb=M${`q`E_rmEqW7Z4<4R+dr_l?JTfY2LA zYQUR}>3c$??+@8K>GKH3MaUr(`byCBbP7PH$v=X@f|53yHf%EV8rGsS;i_w^1NP)HK2GD9{86%sSPVI71{6?hlNgRE29I-qr|`F~ zfv!VcT_!xdZmP$>$;=D#{Zi9XZD(O2;aV`cScVN9X7r8CEzKqj7cX3F>^k5AsNg|E z$RTucPv;uF90~s8#*Z^XbSzB-W=Uy@T)uKy&YeAHl{@$y=x*GwpgHjZIpGmd$d}45 zNkd!btauhV9=I+I#jeUN3NDH<)NtfNQ-hLtC`1F->$TQpd6_McfqsD|5J8PbhD2I^ z^1uD&-(<|_F*0WS7&)d?d7pj$nZ&6Oe0|;PCfq^J(HZ&*l~ygbO4JahVtz_AGX4i*TV+oUlQtV`T9!*oESfzSZo4Ab-t ztjy}FYIQLw$?;=0gdh9EopYs1%K&ZJAh+6Y$poED)Qx)(;O8+9KcIgOfQkFYLg{Uf z*8_}0JUBc^kGYU{-hgVYw^{`joa;r`1@!5p36o@A{5+$0bmj$PmsA=m&fq>AI&7%S zo;}-g3DKO4< zd!mFRLd7|zp$xZAY zma9$QZIa*p+wUYVKhMygRSY?ia9&q`cOoXnj+SN`#z{)-epw^)3>+aPkbM6JPl>yK(^BKr=@oh@6W{jE1m znChV{UpqN98K8u%8RpsRxN`3cPxJtwvC9>g<;cM!Qczf6T(^ujP|3bJ);-nwML2?Z zBSt|S(eeWCb2SJxD65zVOqxe+ECdL_u8m2Az`Wh2L3$N}PD2>te#QOSXK^l0K`kGE zM$wVcmJ79H=@QA#9`#t)=A84>_{{xr8Um8${+aWg_qlTqFwQ7OOj-fJ7hHbh)H@Lw zh!78 z7Q-tkDY2>;fMEd7QNrzhmOgPr1RsyC4MB*{d59HSzmtRJfD zs?8lcclIphW}PdSv=6V8{Yhf#S~|kkoSYmPHD;9LozcoGxn~WZKn&ee&7;B*ZI(&JfTlPw0dbOy3D(2!h=$ju z3B=7>Bo)96rFSN1(NzTG<1{9g?;saCjRh7>H9$L<0ex9rEVxgdhD!#w3k)CRLy^1n zxQ$~v?m^s9C~5sRDq=eYNNxTW_K_Z~pm!_D;J`ya}I!v|#b z3#*OlEnF=+$S&whlv0q`OBOFN)+urXvofvhU0Z%AsjEi%$qCH<-_o~fl;(A*)ZLxZ-?&sFsYeymFUPDCA`Nb*&4fBur zf+fl^K)K`1Va^Z^p}I(HOso_Y7Fph9lTVYmUQvh%TL8p^=56elv09xf*XA@XdiYI= zyRKfd+G4OgH=$! z^;d7XQ0)p7^0xlz0oG(F4`UOw#;Gbm2jUJ`-B4R+Rq63m^Vmv_tLJ>dc}tzxv15mk zi>IcfN@-cCRpdb1w78%O#~Y0|%oVh9YG3=^LCOkXunc(`i;0QBX4`|A9j#QiXCuoh4*yzRj~fOXc| z+-jB(ifGBD5-Be)mum)Gxn#m?tb$62F)mW{Wk%*mMRN|Zn0VFYDic5`qqs*ANC+d8 z$DK-&fp*UL1k3O(`=Qmz|L!yU9TOM?NUcMBZFOaf|av7$ybl0_9RaD(q5?NVm=j8n7 zr+u5bd52tYx+b-Hd}>$H=ib(TJz#El6_5x?(rQ>sF?8_E88XU4r{Xc;2tXcE|ZysVg9`NvU=reD}VDi z$L{o7y>GBMu)f>EuUd{1OY5|q_f1C+u!wT+D5Oh$PuJk@_}cs8ZVxy@h5li_#Ky7V!8rIaP^ifu3Y0TI$ zrm(_e`qejI8L2l`9;rwO7z7sM7_x8DI1o+%WUw{?-Z0-ycn;QFRkiwVG~Y1ch;YS~ zivR-z1cx#%VYGjgBEULaOX0;rDK0Ix{Z5!P!7N3Xe4x8Sh{C#q0)Q))@q%DPU>o#R$ms-PjX6%R8O5MCDGxM z-qg9w)DZ3GnYwL|rm{@Y)R^wbKddvo|9QLzFg8%W@Hh-O%Ms}g|00twK0aQ?Xzm~b z6pagn(TIc*#;QM8gW-IxGr$(YzKAn138zh)YPn6gdak+g3W-mOH%L1R z27c^mQ>Pg$_;CfZGb(UFaZPByFq9DUxY=^k5|f>6yw9C`fQ246_pDj74Di4>>5K8u z`6vVX9q#7J%avxap#-wvlb47PLU>hQt~Q|qi8#WNsuEMCO;H};SnEr;MblE!%sokt z7#3u?x)ph5j7DFHmXPoe6JlTkzyxqSP_1}(u(l9t%o`M77^k>zEK~?=U;Vq~bIa%- zagp8{30otw;kwt>og!^`OvXAkfUAs#GVTfU8Ko17Mp8aN zw*t&TXp(aX(+=N5uSU3pDjf(hlw{@?!V}?3wUvy)8OG;|HOkt+10|Yc82CoLIrfx>EP|Z#;`miptIXAFO2mj1SCtX9d^1ur zBqb%qknvcNDDf!oEt>cE)py^DzwUEfu%9febESegz3-z|uJ4(A8FZmgWV$N!-q!Cu zz*wUg{l2~X%v+J3lCB`f0VW&~f`CzQTi*7)t$Bp5)C@F8G(~&(>GNZ{Q15qlI5z0E zZc(AS-m>sME(^~6j@|JYhNEhl{yzSe3x;(Zq`(1h>$wNGcPKRcdD{+Jfaq(a(1{Y-om8=)?*d*69q^-B-1Hl(OxGkxlG^L8-4ZfZt^ zrdUWM?a@h-Ct0j5C?H4{Em~w{)KEx4 zry}s&8^9Q}?!SEW7bEGWAi&?g^Ea9kInEOO5lox6Y_?b*tT+JJYSs0*d)IEOK!HUF zNXO!HBa%%JGrrBus_sn$B32?XNs9xjrNw=B1Rv+ZF>a`ZhGzvb4lIH8o9!mt88epi zsP5DD+d6*qJ#z>wLZE-3fpz#T^N8P(?g5~0RMsfNGazt>MGaHy@`^I&)LRi}z6ar2 zSWswjO04LBU`6JJhS|CU(iMby&f*+tQw89T4%0!ZSf@{#BC>Ilh`Vs)0u;I0zH_hm ztSj*fNBX0m8}eaz+;EvNae@E>V|*c3Jk>lS99awX!6ZRr`}mWO4VsNsdg|0EOC&~s zqS@i{A!Y)_6eV!rMeNq<^HeYN@qQfu&h0_EK=`_>A#Uum&{zzwYc0>pvI}l%5e@-(m!%<;FpWz>AGt||8o8USJtzr)yY?U2ZxuZlhX`>Hx>OBW`{G)Q zMMBQbaTAgf_1NtauNJny5)jCa-6FM(op0R5a%q3>0~hD2TI}A|zdgXX$5TQ0jHW7- z$4MIF~6&E3nwYYKHc z4Pgaq&Y=T`By32SS$dbNE?ZoWiWQ`G438ad`HQgW0FL7~LX9_V`ZO7;`HBE;K2M!K20gCGwS8#-0 zCv|0u&KFtQ*veI_WRlY5u^%kd%u$(kPJnZK)S|pIS$S2rYt2WUza6bbQ;ZHA7N29s zMOg$oKK8!opB}&?W#dD~3yPIlVIDfPN2CzK5tQl+%U+NXDI<)51C5r(WFUDL*D7ul zG)9C6TIL81oFgm;dPDd#IaOabt==I680gp4tMkWl(Rfnx&1OSF!h{qP8)J)EuYT{{ z=z%@pE)=`l7(usV`wsc-?|y4;Ntf^#YUxVMF_7cr7Lw}V8lQtKPtvSB6+XBmhYcHM zu|rU#^B2rFR5w;C2yE&n9yxr(;&})hYbx)k%ZlJaaAIMCm_?wm4+NKcL+H}X)vCV% z5laIV%bH*)TveuxI6&74+_F>vAv}YCg>(S+9t14_AW}+5`+!ysxN&36#cL;_)OoiQ*)GRUi*Hx!@qDSY>wbLH zy{BfcZSMWAe|mti#ri@Thpn?Lv>s|6kwgU5!y?0E($qp%XqL+bl^5iM9yS z7c8K}##k`1DjD$J*0()?D-}d1))uiwas%Vy;*1O*c9}i9_ZWHO-p@-Pw&ol*$J)@uqtQos%tDVPQj zw?O+5@Bn_GzY7WuGIT1))*5vkC#t)YkPg>Jbr5nO5snDbJ$v_<0t;|wR904paBR^b znXhBEJ$;0XuRYWG<|rDrebaVj2iPD!YhUX8o%fwbdjJIoU>f7r6{_;w+Tju5Nbj&n zGDvwmYYmNt1>f=V1Zq{ zc(KKnp0zRJ>FW&*3z5ZIaRMRq?fP$J|K9ypo{IP$_Xjo|%KjkGXecVUG!x?!W#x*M zvhMYDW|8ebyx(G!7fUb7EM<|QY6k)r&rgIB49uUiKs9-P*}HGA6;XDs3*m-9Y-?Pou%qSZFQ~n&00~< z002M$NklCAQ-P` zolPUzFS{hk3JmLw7v)jU#$&?qQBUZp_?;>aj5>h^ z+gErzmFH<#jwlT*Kv)+p*GLaL^nUe7J%A^M>KcSKD9ZcUC!fj2jT_}`{#lD1PMtQ@ z@)^ko+_rt2k?-UFoHuKpQ16h!!W*}2l&#yg8vPoU<=}RW@u>1saIQdp^V{FZ*>h)& zU5AQ0>I~?%F(wew2w+@d)QQA8tgq2BSIJ`W!Xd#!j7%J!SX{ou2XT+GAW~o$OafM4 z^)+S3Aug$285Ty|zX(gJa9q7|)#9V1vj8|kaAu}uN^*R%6c-iS`Eq>72zKt=X;x-% zSg@p|DtnHCbbkHoUkl)zi4!JjsjXx3`IlcQLbpI>3=WYMenafqJ1$b0dfL}-7Ag}RJ>2trNaK^U4FU02uu?U$rDb+uYh{aNUl{=G)xaLoeW<7#%kB^PFx{=kQ6m~k#Nb|sT3~>P5vgF4>GEQt1YXkQ#*Fanr1%f=} z(`QZ_7c^EauH|D2xGBiXmph6`J(`>#b1v6OxTcwOYS$X1U1OF$N`t9Vy3<$QH+|m& ztf!$0oQhA3mx`+u7P`817uePJM*}nBZGGMYOm5sx$~`fV_{JflV#CzkHZ=|Qn#gy843k1KqiE@b?yN)Xlg7X*bp)!Ge_D2 z?~1{wJW+Qf71I%5SWH&Ef zmb<7aA>40LP}rXFz%}6lzBA~KkpVynNgTi6LV@uzKfmaCMVwBuR2Bpt=SBJ$%Gk*4 zk*@lG`Z?@6oNrP>k_lhj`;ZGv7(2lf2rLp%s|ZfUXT7G2h;k!mXdY#vDi${m9g)!8 zM`h4mH?&<}tJ32gIU(%|O!CpH9(pr6UAFg4-}V5CPkKg%g$qz%h%*^u3!H0m$qP#qCq3AqEfB2O`A8#&K)}i zKGo^drdtXGJil7oN!+NH z%P-6J?c0Tvtf7%ZO@V=VXZ+~#5*`&UhYlT-BO0sYdjK(xfWu>eLWHnG5ITrdzOQPj zvM~T4hulUy3UaxTM=oOE=U|m7+hA5wVOB--`jvncm0kl&SifT3z zqha#%FqaXl!!yuW$SxFJkPYiM$d(PRBDgS_ptVE#fYyIZD@5QDTfTg`fi18;pdX{E z#L2TKC1Pl#WMyY{jS7z6TB*u-NYT^XFyutl6EodwrE~AIlrG=dqK= zKZJW-;k?np#jz* zE{f8Kpwt^}RXvR3Smh`L<|s|1bAW0Gc{^_GI6Fq|^;#<)06Be(B3?-dA09B=QaKQO z>^m(z&D^!5oFE_(j9DYIOi=^X%5QNiFU(n}Zn^{`P+;Ch4T~~%9jx)OEl0 zo8J7yYdQ9&mmXmo790MUaQr<>?b`KgY5^X$BGMGE1r&lcU^#Vat$;p+T_0C7?z17j zE-erxqM^CL+-$8HGeV*8wjcHY)(Z{ep!AdM{@uJ06bo^Z2 zIb*!R<%!!B_a+T1Z10}E^0}sDP;hwZlBM#Tx(G?LIIY&=U;g|T*|1@Qi}w^4x84%& z3xCA+h})4S!K1RW($K7F$!QW69A-e6$}5!yv^m>!)~r9HkJNKSC}RmS7Ep?C$zmTRbx%PC-7y8Bb?Es&WSGk^W{*Cjy( zC+Dh3pW-uRigK%d^F!90Qss<2q{INK6e#M*`qlfNXL^8fXX#+7Fp*N^$>tS~9_U?e zAh~?EeQulU3K;scA|DZOEY2ik6XSVh-77};ym#+jTTroPaOLqGXv9_pY9J(WncylT zCID_hk-ixmr~oFlW}Y>rqPIgaGE!40)QvaTPhIu_{)RdQtU_zl=qGs$D*J`%@6x?)id6EcV z%4+4G%QshhW@eVfTmQK2k0vB*Yicd#2oo1**7US=nL2r@ELprnGBYx*J|xt5#9%?^ z!bOY4x<}uiQKla}6et6Sj~r>bNjjG7K z_mTK4%2DX83P^ABSPyVt825M`Jl#Bh1W#YV6S{wwz34*TAtbq}&q8C7vqeyI(jZ-j zC>XaGi#XLI7}U4)Juw{?+fH66?IOp`_pJ2Sql^jSE)yqBl+^T88&{DLk>;{wUzA28 z#=B?#9-&?#s8doGh}8jTC@CwE4O=#tFdz>SDmoJ;n%aRI^w^PO5+4_D@i>GQCEgGy zSa-N9@7K7GJWzHJlB7kD3rXq*^8i$;6GL$zbhP-aSSsx$mt3Ue#8I7AtroeK z6Z27GcyIG;5BMlUJg8>=Ogrq7cJ*y51Uyb%hq$<_YpboI!LNSxD@%X)<=elMoP{}(G$KjaZoZJ; z{q}eAFaO`a*zec8v_}5vfBh%<@WT&ehXQ*5*#P3f3gnNJ9nJx3kYj^B2JML;1WgEX z)POkm>2CxtUIvsUlqPC0A|y%f$JI()v$4L>z&10K82wzqIXQ9cgymQk7Zw`@9Eexq zoCxjQW4VT^rF0kW-uFLz-{RM=yz+|Vp^7AjHRasA{R9}0o)+psJUbrZr1GBTUJMuqSEctWd2`s+6_qN{k0D=Zr zHWhGo?Al@cr&c$0&>$=3`_ngnD&r@Omp!{Q4MVM`{PX!{*`c^ipE2F)B7$W7;?pmz z-XltRa#FI6USQ&>$~s1v#JSzacZh+ES8j#oMNC43h6qUxywnS|Ff|0 zufuKftn}LBT_;KfB=1L$9W`NMu{;Id5IdZvaj?Zp78~Ld1Tpcui0}w2WE@9KP5T=` z0D$G4zj?>veDibW8zS)3$x~8LSYYwMq}U`wxrWq+n5%Yd_E=f7=0yqCxFSNcsJO_y z1R-f5CWMMhi$yeDu)Buxh)}VR#>knWH9NFa)Rr0Nazr=L~kg#i`XkxY}Mr|i;V^c1-}|sVYZ~ z91{TKW@B@b7X>Cz1Rdo{^L4gV^Xx~aM zmDu}~j1(giFFapp<*)$eSlmzx8bcC6#Sbh;*l;-aWy_XH_NZ(-Z>(5ik1*bR^Uc?S zTN!V~jvYG;lte82r59f^<$?4e(7Y(LFTAkQEa4Uv%)uHny)W=X6<(j^%cT9_A(2lu z+`Xu~PfZHW`D(q~Q81LEk~)9qefL;BfT59wGXi(ac!~>;)pcBJo^splfC=* znl*@$gM0jZ;d!HgLxBMei{QJmP+4)5Xdd7UL!S_W39R@;@gMAOF+My8xJ$7T$x$PI z+lo7LywxjL8&N`jUcPMGvCYU0Mvfe5*H%_mrn|UfF5ZiUMN*i5!7NW)tmHf5 z`gIzX%1z}}ZB#}CL7Yy5sDUbRO&sa5C4Dm-u$b|bKCQssHiB4h}cUHDz*qHpeSPBrZJsK zw!1maKDAF%_l{9D?if|S+&|#fxHV4I-Fs(uNlvn3cA|+U8v71GK|lpmY>-AokVa5I z5K->@OtJ_d#wILd4}x5`%ThvUqLWBT+So60Si%A zLI|MhdX>>NkiFaR>ITz%P0vU-&<#;9JV=aMWlg2kIiZapHh^IUVaxTFtx7$lg^3t3 z;*>X#l$$$ut~spKThUx?Y-*J0k<+b3SMKRt*?(Zaz5cDY-x5E6zjmXqpO5bkP$)Aa zQ|Te45~#qTxzQSt9?9&|5V?QD9T|D%g7^(k6s|fPZ7Pc4jNX|6_65!@dcIbI>7B#& zcofGt_Bbs+>`vE4&qiRiM+=dD*fD=fug1GZ`!gjaMS#cG)z-C3#A#GP^g-((qRO=^ z*IN4^HbYzVq}lXwQg<$6`cwMeKjvq}_+hjLYaMR-wCQFXsWoEsDk>{X?-X^SDPfaM zL>v-5hKLQ{RB1YWc+#a%K`<;hGh{xf>oFkXQ$MHi@ZI}&h33eoa!wgF2QhQ{BvSJ$ zFH>T?I)#AHs11(sA7cU!blouB;cws1Ksj3Pxbk<-2#@fN=`bH)6-??p`KksMfTuTpp7E{jA?|~ua7(}QTb-0iL69W`YJJnLCdFS#> zSb%ge8zho)&@@2CQfr0tNIelS&ggNY?YU9WbBrEB(`UMJkm@Ie{HH(vNs5Y!1SIdO z6|1a6hnJ@ONe=_yp?@XOw`)-2vO3qj7NwcgYxJwmp4ND8=jdn3Jfk48?^1j|dUKgl zxwh%=Vm*M8K%~rdAm{f}&w$H$!sT%H{@@tLr#?-Oej#2f7a`tpXAktzul(sggJ_|) zx>gDc3axtr9UtQ2;;b7yo0-e=BkhMs0Q2J-Y`74%>F5!r>icX&&Uo|;K&1dQKhLm?(|N~EPr z>HA1aEBK4ljR*SS_Gy?ghXF~$f3@M>ylGC=^=5{43L2DMe{ zrvQTZ+5G8dL+g^F#pv<8Xr*hg<`yO{l%Sv>Yl$^WQP!bhAy(%^yZ`_blok|!K+mG_ zO8pXmPe@3(gsb7bf9{Oj&$}S~mFwsltlUTyQeV)|QzCTT574>T>co()>3QnktSOHH z`lHkvTT4%Uq({HdF^-R(qbGg_Mv;H!+2|&KQNSbTz88J4;qkqZ01F8TG2U2UNZ@0A zZKB5b_;>?Dpu5>U-S=1r>4Q&VZ6WrK>JT+Ij2hat2r$gj$Obt#s0l%#K_=;j5ki4x z%a>c^TE#U3*{pwgy#aWLn)rF+jW=Y$`~_wxsqX=NiJTrO$jlu}J0>+XHBx>@TS;kJ zmLCRbT2hfvIA}9fS5s%73nPOwL_`RX215z5mA~O8QY$1SOs54>wt#c^PIPPu4h}XU zbT4nMQL6!KJJe>iNCXLdhWl9L%6H&9I~Gk(;20jm(@#45o*VP1l?Xew}sMp_d!(kdz}lD+%)%IVzG zCh`uc|BOaIMEGyN{k8-L1)F1oG2+~CPBA=0Zx|BlhiJ3{zQKrf9)KmR#;j(7*K$rV zp7&Z*sYiiAq+*FAxjry%JcoXcM4TL#NRr5uwSg`xH9m~-?3uHTu%DNkXZ36h7!fYQ z63E*T${o?r&h@h!VjW{s0?-^b7DNME9cM^Id*(MwU-!XG+GIz&^;xZB_gcVe;81Bi4(?7Fs>xL zNInNTssMce?C_m1dON<}VXe95#j5DHzAo!zmZf0fFaq|W4ob9|xFFGv0Ya4sk7HC+ zRmeQ=c@_mj?--KM;$9Uv)soAcm|C!YbL zcEDa=@A%qUqRn48Uuibqoy#Xb;`hJ8F^=CqKTrKA7cyy704X#(cBhB))F0AKFGQV$ zO|G!0Q0S*eG!$MYWUG14TJ;+(bh(stm0&e&7rc-T96jVG1G~$`#SMqBqy! z@9ErAJ0k@O*knP%0*k1q7b4ufdGlt;)D&T`Mp{H?6UI+4Kup=SGLw~Cv~ZE7zBj(L z(F`Z`KVHZC!3X5rGN6sb#m8Ct3tEV!K9w>-mkoG|gZj18I#9SF70+t{;keXpC`Hf$ z3nN@wR%&V8)@IE_XjBa97Dp3`2&V)%5+Ec;T z%H?kJT^TiIlzmo|cy{mEE&1nEs6y!@RaI5CW}$dc(?qo=Iwsm20E{ZYAyBPkL%Ix2 zwR-&9Z=~)2_;04O+T}6*!$*NfGu1$zB+^mi=orZEGxX@c*-t%n4q2D17r>64vr&&e z!jnD2F^*3*Uyt`}^_=mhF^HscX!1+pzb_0nNm>Ze%$T%W^5SG`EX#t1Xw72Aap3RC zQxpWE5rQ*%Zw4Oags~0*qP+9YJ61niv|y101qVr1R+eo4db^~gr3lTFsaLXw0oOo* zppJ*y49$wE3xjwCag1@gP;kM%0FfM^8=NEC{PlDLzzPluwsTFy1;7RH4YfW%JjQKQ zgM-E?&t;%0MU;SeIU6GNK#o^YU13xXT5XLSp-qYNE6l*rFOxn z+N7y0Z8ZDsKbr$JkZj^?V%F=jFHFpH@*UaKXGYJINkNm$uuxNjJ~4FoP(y2SKT$ss z6}3sgRe)zu&;cMrFG$pl_yOQUZ5abYvwYI2+k!TNv9R$!J{-e}Gdo4CMWEJV< zNK{B`D~uq6+9A;|gnhI#>EJ@Pf#>@U_ifiE)^&pcM(hBtEYT(WM~pSmB$4B=p~J*W zK{93KWk&GF`GV|EpUM*|_ePWpcxU>I>1O=<59}`+-`;3Ok5nwRRMsRY*hCc=PfSYG z6mffPl)36M^m}T^%wo1^P=bQQ;~#z{Z8`s!=m+oeR9wLE9s^`V?M)LWh)@J?AQoR_jN=xIuFbbgQ&o9o!xWlnR^@+>Vy~wHheY{en@k> zfKRB~SVxV*%N7a#(?9-`NzEbly?gg=*|~G4iGPnCJK9jMq%2FdpWy&Sl>&~y@p19(Zdi= z^qXj^JI&ha4f+TjUZC~_sR80WNZFH>K|K7;H{UcvPc(@j0TJZ+bLWjG373|%EL}dJ zyO@F2_do<;%ip#bP;TSKjfQT`I*}!}8*WQzP^i&eUVZIVGyZ%B2H%VMmGV4I`^s3w7F?}<;KYvAbMSIagIxOSr*idJhWJjOCccv+^n0msRarcR z35$nvFg1jI;I+;j-^~D>Sq7-1;qKx7cX0PNcn*)xrf(a++5o&;ODDEpU(eyE?cI;W z1~yDli69dpYJc?MN7k4ZdH{ygWzZDi~9=WYJU&4h}X1Dzb6G;lc9$U*4C~r%nre&sj5P z*&2iE31x)TC@9&qqiK?HBEz`0Nm@r8JaDk}vqUi`EF?^$(Kwl=#tS`I26I(hTx{SV ze7jk*^|LD|$W!SdZTk+0TvP*zapXs}S9==6bp0>UT5J3*by&`5d#_8S;^B2r+Axk& zl-K*qOFK4;eXbe!c2Bhoghkly+gKgr=$iCi{OyX2NUIVVxeR45zQuEUC^qIh zT0;VzNZsn_;iE!JAdDmPfTkuJ9(5&Z2V=*KH2}qP`-OgjAB@yy;pHOPx@D_i6cAPz zGiHo|Sh{~5BD0#x8abbTUM^g?AayrxN>p@|_A{Jg2+a}0N67dw?FOx&puk>EPdyAB z2u_UXyt(rfd=qbx93UUigrr&FxhBLbjYQL(8JQV|KBb;X6JzKUh@`Jsv&IZ;rTCsN;mP)zp8m%+j)5G;4W6dJAeD;}iH;PHfBq-y z6X|sF=xOG<-sj59k)C(waEzlHXBT6@h1i#dIR<+1qq-73J6fu0tE}z>V%LVIm`O>o zQIYO*ITC$oj@m&&%;AYI<_8s?-pPl1AopQUfKU0c8cmDI(?|Q!f`?wmLaA zR2n!lFRpYd&IYn{MAt;5a6W5Q;NV7OwG?P;to`aNgiMfCJ^t2a z%^n+8i^t#nQnV{GD(pQz&AIct8DK3xt3AUpj^E9DuidgpQIFQYP3scCjTv~0ePEC} z9pyJlmMvXsO?Htsv+u4(kzq?)H*e}nY)<_>yLx|YL~OuB78p@yJoyaZbijKArAb>V z5SZJ(+-9mp@rm(P<0I`&YMWH#>UC>mu8IYaW_<5Y@5!0mGm@K^YmI^-{S&nToZ(!N zqNPpn)~8012&y%B){hVdHWC3h7`Sgi&mI3U;r3W!qqEYKxL(?at(nRQYU z)EM2Ut&yY0k4kEKs-|}Xjhaz#vA_u50Jo5EBmK_n;1H8CB~40$Wwd&;Pi326J?Uis zk^YjDoTLQ)k=EOh_a(Z;K$c%Gm+YKut5HVJiI&MK#C|;OxSYy6Wz-EcR*~2nJ8o>p z#8bQF7$9IV`p{HDr-T}&AYEU(`HL@Q+LS30_{LkJ;j#?*bgTF_wmdwpA@w@mPdwh* zARhne*P5ua0S31V=(R1{~&v1D*0CMPGXXD}7mM1>` z^Y{Wb5Yk}$F!~Q1U>cV=3e1P=H;-|fe;CLPppM?((%d3Nnhqq|3fU`|w+V?SB_>(=6qOlYMWE7Q9U?x6(=WDtA%{~B zTXYYVgGR~FFo>k+x&fgcfp2nYcIfIv5@ZrJOssj>oT z4j(#fuL%ndGf{igskVH!#p;UmdSnn4*HqQm`a(DWBhH)m_G(dHfHA(Uhx7)=3TWU(jfm}CyhKR?e zx0Dz8uc8*&b+7aLF=l{$0|%U}0=L`q(~t4Or+A8E9G_y+9_J-?;`H3HQP~FnZ2>HGlYhn{Ke}$L(TI`MCdP^l2jhq#B=yK^ z;141x2fe}+XVlOk25__fri6xvO3Bp{Ij#l}+C~2Pe7RDjqU72g1Q|H82Sj-Yo1-)X z4Fc3D=QBJc+{peIO9Tf1aS=`O`N$k#h>sjSV$UH;rNtDyNc3Pq*AiKJDr%O`fpLSV z5C8De#Y<)|TPL>Kd*xrqw}^6X>|Co)LJa}TLtn=kn#M$B2gEGKnHo6Y9?;eN4F_?U zf^CRW`58Z{J^dUT7i(!^$|biOZ=0hqZo)VL&Fi6AqQm?4il=@T>949e>P+-F^m@^- zU6kY1rfW)V5f0)Y z&vq~h=}OX(I5l)pId}e?@dT%68WHI>)^&q+|A1^y?T(0W*|KHw+AFV_LB;rhnnfjt zlqMhCgmUdbQnxprM zu_N;2K8zeKwx}WI6WoT^@i>v2lgM3KmYO1 zRxe%u(t2|i*o;Bc60!1rhy-lgwoU7fwH8fo*swtcc@44_V0W)97M}~3#Q##+!W zle8Vr5RX@iMS_DL{ygWA9%sO{eg^jY7RS)zvwrxUj&c0qbNJv9um$Q3Gw6+1UQup} z8^}?;r~~~?+V~6}Fj#Ii-ZJlw)Q6>1)ktC}`Nt;9eQdPA_^FS%29E>s7&2&xxO?Hd z-t$HLje$bX^m@g0t1pH}gv;91Yi0iY`BGF+WV*H>FIktn_U*E@N^2+_7aSA7F3VRe zH)EN0EX@Eo0B#} zBoQKLR=9}(bchIf4`?BPaS%pFL>xjt1`R`upa#7iQLn*(BWQq14}B@&Uh+4`1TaH? zNvJ2JPFJj0VQE$()j4zKNKkN)so{{ibL8F0&&g57M8qs!uIj#XEg$Q}; z=Ue6TEuTwMbCVhFRjXH71UpgzObZY;uhUjx-#64DQ0pyiDp}{@7{~9MsV*p&qsx(qhq6G`buX3sn?QNHZ}Ag3+t1I(B$C4@?)qkzWM^ed zP(YBZU%y_KBrlPP0V?)ANzy2|b@Y1Uvk<95V{9p14% zIm7k!4VFg!dgs?tT3Tx9XbgHktur$EUnv#u|NT2HqTaN>UH{XoK`v-JvE0@>vTl&K z4AJXFu4}#Y>^aeic0JAc{fHR=&v3Qms-c=`=0M$fphooW8jf*v)6C+9(|!l_4=x}O zcQ5k5$YK0DI{?(F*re_#(56)vHh;tYgr9WJQ&Ux%dSwH1MU~7CMv{Njz?|{qGk{}q z^~zNP$)ImbPezFF)XXqAoS&GO80$;{vHs%ui&9cvBE==e-#Rhv?+IlBDn@d0vI&e6 zL6%-Cwb~z`8jeFlWxy*}uU(b8`Z`nO;nmdas6|4V@bl4HWBC;`oTEpLwrhcii|BOR zm~p0F!{_iB=3@v{(y;I%r%jzE!GXcDb=y|sMUM0tX{mUG#R1QdYK3Y7fCy>{YlzlT zpl68)i7Y|1@;7UYA5ymHr`o#H=*?PvDdC@M6UP7t0B{doWoT#RHONcqYwHEcGSaGT zI=9qOsefW@lNTn-(&VM;M0jdTuDjAtyLm{C>Z-Q;e;p_9w!U}D-P`i#`^qWpH$dL; z^cEkDzT0wg#X~uqIw>8`b#6R-1~^BYKcattTFf)iyt{^D9NjRpu8R?a0f`!-J1L>Q zG}y$bK^-}KM6Q)yvs4)KLc~Em7Fn+a3l~UIQj&ppm>Y~D^~lz?_PS(Wny=pat{4e6 z5ex&M7$Pk{f4?q53m7&!S5-N+67Mp>&w*8uN zGVhA#P*1B>Un#p{ln_1-^+V99=n?}8Vlzachf>AZ31ck^r0z%U5a14vpUpihM8uWV zl_qybv~lp@L5uQ;G)SS+B1^xJ1cd}yG@W@Y)0_z$gt!H9GAnA9rGHU(qF%mi)pAwD znJGht4KXz9^;g^5bR}wJ3?1f>qHO&dn`G+$^FL)sV{?~NiJdG_s>vT)Z%d9kCj-a& z%e1+3Wzoe#Rn<{Z1x*(_#<9zkJ@gOu(+L3+1W;7b71jM!2f9_)pu2`+9NjgunmHl0 zO3H=JsxL)CY@BpIpxXQt2$Iu-cBZ~0^q(f?Psy6He{YlM@x*E|J#CKF;@Xk3e zFRgjWB;9In)k?`_HGFFPNZpcBh3lA@n5f{EJ5s5wpD=DXNTf`gZZ{b}kS;BxZ5J?d=V+d&4R=x7_D`p&_oB;Y+yMC>uaZ^%L+VCZ-4(=tFdAfy}gH;0j5s=uS&td=-$*Qa`%C~vVZ4J`GrP;)5=s&6>HdOG-!?e z!#g)cn|i5}&?ZfauD$irOVUpxpf(jSXe%rd51o4@_I7%ebMs*{fPn;|>^Z0%@Q1_g zuHl>!cg?JxGdpqorU380bLg&b@Knd;JCk|>5J9bp?gv4QLE56H#RR8GRUswD=1jVo z->%^@j6{~)cE(f8fKD6r--QboT4ZO=nWnG141JEjQV(8Q_mZ_`q85p9q+7*Mul5KM z01Ocxsx;6nhyb|M1=)R&$&^Yqm8N=KS8Oy=4Lqq(5^s)o2J< zMXJ&ci{p^K1Qj}Lgles7Wc%*B@5)zSeZx|HPq)V1Au?P%#xWt4+>!Jbp z1b!s-V!CahliPf^S*}-Kw{$8|U6Q89i5!jgq3xRBxsqN5eah>1?cF80=X2%0K8BI` zYUfub2mpX)-I{gc=j$ioVd0i;higcGNz`sePabV)RRjT0w!D~n}BY%g}cD?GlwxJqsoJcxxkmUe?gT!5MP_X@-ot-oGYulco z*N6>Nc(mP@qLI43(E01(Gw|&k)0xBF!!eF-m|@pO-|C^YGgZhjW7+M(al_j_7l$;Z z9QDSL&9j=961efo=?&P}+-P+sq`;0JJuYP>WhTo-J+^ZMiDAS*x}1#X;)}fiAA)%$ z^0Il=y~XBS_i63}CQo`ZCN{?Se29Z{{zi=+B@=@tO7XQ~`SS;VmgC2c8z2I89Qb~u zxT0o9sTxm`Aw!7_TQsds24RTz5EBqb;tk{}Qf(Mv^iqqj6t@e9tAbBexys2k)R~Am z#uT9e>XSqVXuD!ui9it>m@#vPtszpZ0KCvpB_afX12+;hEm1HI0?}epa+0A`5mn#3 zd9#U-L;pyammpEIqKtn@sun{xM-3g(EIeJx03cXF`2rkj(wZWqe?UBgmD5OKW4ylR zb)|c>DXw5dKaBu8UE|!$Xl<5#T4V28h3vMF)G>6%k1!Tg-)E5Su(oiLhQ>$vYp}+^t7ezBO4kU zOvwhKKkceWLlVUSjF~=dx-46=%nTc8*<)$Ptj>(O(JVDC1*&TE+1Ag@xDj!JbcI5} zc_&iD@E~|zSz9U4G7t&RJCkQoBhq#la8jjk8$pP|sjR+UZAe&JSP>nft$Hf=lznax zwjseGaw7AD?Ar5XkBP+!#4{<3)pK=NHoZ}!{cHn*U`@IVqWI`> zqYd7lmy;*Wx0_AydTONd+_bAZ!)8h6$|6Sf+HKzSZ)fz*3;>QvKb|h1{Phz%Ach9T znY{cwYv}7e+}q^(a7u7ue)s#|8Mz+eanW6Z_G6q|1h~(hJ!|zzBCx3uQ?0WGT{&v% zYApTu(SLkoH9%+%q+U^~p@s?Ng6I@_4}ch`B~U=1at!Q0P-@l4q*kU{Q(~Mfj5dZ3 zP!3#0RFmMqrk_i<&K&$bZ{9o;E2ln4dN*!voYkV>TJoMg8rAV#X|4>l1Vk-eJ8%}Z zZ`&?4DtNwHxrWdKF#Lbq`A0dCenOTmTWaFxMa4z(`4^uXP>Aj&bPPcQ_LQ#UNt!xd zp$@~On))s$2|=if{qM^G6+CFUtInSSnw-&lGeCO(p2t0{;kq{+?HI@2J7*n7az#9x zJW>E=96KI;@o#vm$4^QMFoS7MdU^=L&qRbE65*aLUb5IWHdo}RlVs6M#MJiYw-B?r z&l$Zl1E4FZ`(|cmT6B)SDTa==Pj|Ji;9YIdOL`UO1Qi^>QUG!C&gNMiC&?lgE97;JPO)X7!zDdQBqP(eEy9W*(Fy$N^e2#~KzJ2qyWfkD7VJL|dK{peD zLVM!a{0$I@mK?IFgjukjjQNOAgi@?H`FSkmnqIx%} zlGBL0xEO0 zGnRd1qbL1^2abXTfQ-9})T6InLR^BiE~1virbkqO!b<1C-%A!NASA9)J$zLj(T&;} zy)y%-5kZ0{HOQD8KG~ut#J-VhiwKP{qkzGh7dOw^Q|;NeNA~XBD|OfF%rLB6u~Mc^ zo2vZBQx@I9FDxi7FqNJ3v~+p>jn}RI_u7WnEc!$^fCw!pILLr8q|?z?9Xo!keGYFg z)ofLO4v{1chB1mr%aLy7HEN&?t|3Jm9kUXU1pa~IBa zoC`x{D%v3^F)SE4qCg@;&La^gA_E{$8KhGY1_x0}w~g@= z#!E|6i`7FR_)nTR$+8X*|B=8$m>_bhwup+2wbom3WJ!$z>T+>rF~GyMHOh|~e0H1zqIP8X__1r_Q7`PH zkFzh}G#em?J%qG`n}%Z?-88WrmPPK-zh^_>#<%@Z4$Z}F{59PWPMtg@ep+_~h(j86 z*UnwmJQnU9>8nQ#XLESe3_bbdfN-e2@ng=1Z7d?e`p@OCxQ@z(jecp~>2_cY#)yau zzM+pQ%=oBLLBxTUR-_uk0>cc*f?OS`*c){>453UK6RHk<7a{i}`Gt@;hVS&r({g>n zbxUcI#-)yTI`6be){#L#fS|NY#l*F4M?H|b;Qsyl4Gct+Y&J=1h-50zcg3*+ty-c6 z7CAUx!)MIO$THypju|;U($cX_+7$!ij7a&~HERv^N`0Kjl1P%snKW*~-2_WFGhYb{ z5-j84p>@(lq2a3H)Fxiv&Y^4G_#E^Fsz}9Os0{JtHkcg%c{R zWmarljLq>wUgq4b_K;e&o6C(h&yI0)<8pJQQz;<7=o>!XFZCcG_6w613aK>!8<4&C z9oT0zpII|z88yI-Q|=u4F=n9qTEx(F9?&sRwjo7HO%6qyw>G{dK|w(s(LTnAXmgRK zX_27I&dD}zBWPo|glzUuEgOgTFCyyidxp6qyt-Nfsok z)LZ{S^1%lm$eElo){k=2rcD;%{{9cYH)SA112%5lC^7S5jQ1E386m-{HUzB$MHWl* zD=lfD0(m?S9P2z~cKg0+uvR4}${~%w4}AT#p>iL1Ql~p`D08xN0>R@9+x(l=- z@Ow6=De66wo{LY2Hxwb!2&pY+JpVI5bRQNPX8b_9bI|Gvpbf^Z^B^+3RB%~RkEL2I zkaNrr3OVosF`lui1T!UaiqH@k>IKIpx`g`*r2`Pm@wDTHWF@L4)k@lzpUB8anHM|H zp7)mz{vx?5)D3k5!E=zWAZr2L(4q?CNhC=ZjwCpjzM~{9HO-tdSf>F zeR8Sjl4%{I@5{Bx^9oA}W$5ss2KpiO%fJC39Zl{0`nBsC5!Xqp0&?2+>=Vrwcb*En zeSd_vR4OPaJ2hP?GnX|o{Qi_5`vmVriks*hxjX8aTu;t;a0XagMEEDOPMWwrju7X_ zUBihS-88dY+?+f%0SL+<^+3tJsDq6P4NhuRa62)CG<(KDAPquuTX=9FBnea~sH397 zJavy`Uer1IseCVp?lIBPX8h+RCIA3H07*naRCq33x+MAe`BwkC(|AY1BEqyT=Bf0Y zq1M7FJ>$56VgOnpsm8gy)u22^(zwugbn|CDObnbT0B|@K{79|^lxv`1T)leL+GCLh z9W+pz23OS>tpr0je$05|8KPv<+T3cuE(8TCDl0k+3td2C4(ICu^AGLO*Yyq^0{{q!FYBS*ReFvPKA$2y4S z7gPb|Ox_vWr2I$vOTdHxQJTLD9ynNngM-aecc=IF^xvrOz7hjBoXuUMKhoqocI>b; z>BWl|1>U2d3WigI#K_PCvAU{S{73lY-~?0I%#^-Z_gfZrrG~jTHk}T~Td<0Mw<}6xfj11Rdk(jz#zbj;U)G1(-ue z4$0@AeQpS3j19=v6t5H+F>-_?E=V+E0-urIixBXmHQKy$_l^N%Fj#bKC)LS@&pF1R zRa8}2)Hre6L<8HPcS_xGO2ibsWZFz@fT$3<#gSu2czS-Mfd|&!*laeoF5!&()`r40p+x6s?}Y? zF^+DUS<;L5``xz%PpXK>>O~&35t=f2igheFfBt+&-Dv!T3E~;$Y0ztGRMrGqYgcrL zALi385B4I@%TMvUkqW$~`li(4vQK4OdXUTqyhBo$7%%!ZlFEc@7!(*}yh%%$Y8rCd zjA;tgStQr4UNdKjS|d^5`3vW*=7@^TjOjD%^%z}f7^K~aQsFWJ0wN+Hm3qDWy4B-Q zS)wZkJja$hEfP0BPTt-4uA!hwVG_*}5dtRKwOc758ubDIqqE4_GiRmznjTlb1C$Wx zMHduJ3U!2>sa#%l z!DR)Zd28><(Z=EJo-M+OWZ+Qj-LpsD|KNR#prLOdWydw-jPIWT=tjPNzB1T*unFPg z6uE0S#?cKkiwDd<3?wO%4#H~twc&<${P7QIUDefd_t$2w)PDHtpmcEx@c2l7(X|~p zFaQSt4@liXI(Npip8@n!F?4LyM0TUcj5edhCn192e8Nwp;{|C)j3Bi{96fl7q%7ea zq8Nig;(VVxebS!OaJ#`GF=!qhGd=9N@CpG`ApS5valY03ic5A{T^pwO9vWB1p<=@Vi%8E)m9s=nYFpTDkecP)HJ@)W;Q-QaL%oMu^J9bz zs3n46rIB&dohFMmO>$17OY~R~s~{Z=Mqv8%>6YfLs;QFx^`5eLZoI6})UnT3`=o#O zs8K&>Wn#SS(DZP+B2>dQvU&B@SFQHSy6-+*pe0HWJPs0;2H>Pwo$=@yAeG8+{eJW- zp8gpRp1r3(mh;MQXTWvh=uBZoqWcB)g3c6egZM!Qv-2Qg1dzn0i+B9J=_5_);aJ!l zzQE2z=lOZow{cFW34Xryb88I+MPgCXB9m4l3WJLXauPvt1jOm9h$I`vkJ=yYpk~dS zC3)xatdTH)7NpkdZq-?I22G==pvVxefNEMaElKJVBMQl$I%C1b0yEB}M*V#JFEl(DK`G&l7&mGX8Aw< z=l@WivZwqkVS&usxmN}#AnAeO?;}?gm3>HM=8o*$FO@T*Oqs{!7^Um5QN}WA( zwhZJOjEGYj4&H(rCMP@3!-iawNrmPna~p zv~O`@P^+OHhcRos*=X`^0B?wXh`LbRfh@oC>z$H)GF!qz!h|j!^i@22?yRLR0mL9a zPB)Mtszpj&5A-Mcs2E-(-bg=^W$_vAV+I;SK^hb}IVdHlCV`qIBM}r7Bz|N3Oq2DS zZ@y_)mr)72`kVFQGJ2#~g93wXEgeodY`_;%x%21FH>o)QH#n}bb7E!o^x1*|MJf+~ z%sX$rBX7R(rtICfSHApmyLhVz!TK{=Cb(3hj&8S$c$k+oEl!j|b`7`qU9 ze7RZRwih5TAfOpJjasL@eVrb%#4ZjPKhby8yE zV`bP-MTa)l%LrA@K_ZZJD~*j6l4Tt?&YeGJy%`aS80Iz1>V_bid4GCEwzRg$>9ePe z;sdCMR$7P;U|{|H{mj^sRz-Z=qAmq;)m7J7q*_y5V-X?BOxw0^v&fd~ZLBsC1`UnM z4!t2szrwfl7~o;YuCA=M8YOzEVVc4v?MjL`JUrZ}730Q_SHbia<0g+(g`Y9`m!y9W z6x}ARdu3{U^sD^`q)J~O6B8?|)~qt+AP~1kTk3X}*xYdh5EU3XNS!}tJkboWuac7f z&hb$1!cD_5j&7RR0E0n%zRrg=L)rO`K6IOnfD{N3Bz2YV7IoK2VAEg&1=KzYa3vET)dI~5ei`a3>z{`5KzbH@fl34K%-UaqZr}J z>PiznkDL}MwYO@`5K^;5XO$+&)HF|IpD<7u=vc(X$7zpAj50OHnNc(CGi7SaD*8cs zX#~4QTWL+}A)DGdpr4#pnnXXG)4njEjfBz{3XT!UfQI*mIow zd!7OI3KVikhr4q)#?cM4%gM8$PR#(1Z^M80MgMO22EBJkzCY?8sG6XGIY5zsJ&i67 z1lR-zpU~4Z{h<3u>0wkp`ScUXIFVsd9>`6iM*~rPdvu-$(1l0}BqzWeC>fI@6wsoz zM!;2|Mm@D2hhZEsY=n#&Im$#HFjQ;StT8$Rl#8ufw_0CFv`vv;!)Wn3njE*?YqPo~ zk*nWGKSQ=+ED;c=ZVmbr`8mKi)J08GRkeysuaz2dmd}pBIqkLp+>n-~h6tbs%EzV4 zmy9+N92{&LDMlVNEOd^zd2t3bBEmz)ZuXqn`dy>sw(72a@Yx4)`0!x~8$3{!4;m_7 zDt_K&=ylyPdV~}PPLPwDKE9>3*08Wp6B0m82ej;0JHC2=#?j>%&L2-T1GcvkEV?gX z?D$-caqO6i-n-%2=n(+`soHTud+#lNGDjkPWb$F7#~HWGN7HgW4VOa!56rqlD2mS+ zy*mTc3UA!JAtj|Ha#`igNTZUn1Tkq!Hu^ZvfddGC5ELiTTk@i0^VEq7p*J8vj^Tsk zj#>>g1W5hcwrw+A)wS!^%J_-nB{MVA(w<3+k_>vEb~MdYYXZgxSZ_#DsHAHV0Y@f| z$o1rvlNJdg30HN!N@&Q8L4ym(ef#$BGawJf6e9?i_+rULi#TV-&a^Zzs9KCRDSZqh zXk6M>9ZflE(Pv^}qIHPbvwx55*|Wz|#XtM`&m<%?R4$&sC=KYnD!n4nqrc3pQ^J3D z$9AAfye(QFelM?+*?;{=0@UeSy=t|@#l_iY%gxKR7FiF=lJxFb?R!VFdF_5q+%OG} zadg9^x;A>$LIC90cm^la4PWK44@tCPJVu558C&J@=f;y$v zmzGqjeiL!46Wn6`}aylR))Q|(NXj}AyWQ|ismm+9&Yl! z12W=%x2TaXJ~>#te)DUIo-k4Qy1tesCc6ruhH8!Om6u=9NNuk8sv0vTq}IAJFyNZPu07=rLc7y{3Fe>*w%SItc5(s=P`* z+x?kE)6_N*GQh!b8QpG2asK=PGvEq7e!w9f>!siAN{{t)=Shz<19&&C@vKgy>-~PL z-zbt?F1TzR;1PEQ(80!IZ2ojp>ML{C`TM*3w)b#v ztFHk*VV+%4;QWLHOFtsoO~(sbNYS{OmQv6>hy*um*r1e!2HC!2yIj0{(NuAM_Rb~~ z^WL&`i{!TEnpgnoRH8rXhG?;p=Ay_7yUx~ng*B~!j2L}%xl!luPLSt+q zNqRF@R8&Y%P>{fVq^^iaI6~l%`DxIM;l5sTU6wCjF3CyB2Ef_!5GQF~c6Ru`qE$$(qkqDIzpWT<%j z@)x3TUY$L)>6(@%Q$o!Xg`KQZS!VPxxM;$nJL`QwnZV_&s?~E+kr89x|zVEn>=;$1N<%w zDv?TuVSVCHnDFTdIXJ$ckkLQ z)pga@UJ730>=Co=d{Wb+mt+2!e9IPKbU?SlE5v!46h6re$BpwhEY*oB4_N{@k$_k* zB#q6D29QBuTo;Z-gLK+Jy#~ZA(IzQgBGOMk`_!V$H(%Fo7%D4PdbQMmLo_=^D1cNa z=-A-UVENUrer1YGjcS0;ojYd+8v4oHn7K02XQb)CZr|~>4A$s+YVH|HE-vppJ?*!L zdx^)o)tY;q)a5be)5q6GrB$a{go;Bj+;_MkgB|18WvY7R5B8I1F&yLQhFNxVeg@)z&L<`}Xa!c+p}>oS$f*99mc9<>kp3zcD7> zU2>(w06=64=z2jt6QGQ**6K*9QsV=y3Lpq)33)+i6z~pB!cOTXplPY&AqoJvXYH!B zCPMJdoo_7SE4xxAn?K!b1{N^@v|XcTMq97Q4?p_QqSe=4ea-5bAFAlV{=@stDO;4d zNLDXjEd|8|vhUD7m8L6~SdB<$p1UOdy3;qPvrf^dQI&W!#O^pB$m+qHq_zr`Wq!O$ z<0(xAY6-#@&TzvF=vLv{C){xKjzc=ev12NF?*ug4!KCQOp(D>XW! z?ao@q)T(HKhxW3R;NXtCs5K&J@V8I@X0mk=lOyDnS6(qBYoxA0mJ>M8$ zDmo@wX3m&t=~H-u0l@*Le6(}dPO0BlZ#6<9JL+simvow_xL#p~k@W!u1VL}41IH@y z9wQ2kgLEpK$+>gp%8jZUa<$~D)YjCR(}XT7^=VSI90Q&uhLKt|of+PK`)vaV(Me<9 z;e8S?DL`gSn_>LO{EPXfmr4pBKu=kDnOwMV!GJ`RIwq;%g(C?sY1+i^ng2t|=1lj)(Y6eAXkXtD2IMB2x>eT0Ix43wt(?JENCpfb9gU zMZ(F=)7y^8?&Z(l*AIt5-~#lxuTn>JqEPSmMc(Y$1c>xVm6{TYa?hw6k}`Gua6gh^ z+)p*&Y&{?rGvGO|oxl(tj|erIN9%F)9|tphv8 zZ|d}^2A&}`85|rew;FFr{`q`MeIibdhAM&sh>;^P2jB$*f>A`uZTd{D&uL4mix)21 zxu(vEo+-u{lqX^XsLhbB1UU;A66G62&JUUC5rYc^+1{(7nfd<(Tdz%rUpFlP7nP773Jy?J4aL%q01@ZbK?8a zk}D!2!s@H24q?zi^>W>JA6z3`D^5+l`^-Gv-|P=$9&WeXHq^77fX9336FqxyIWA&moJmx|tG9VH};F+|lUHs~L8OfXoTK|~=Wct(yf@bwmkKWbR zhsWVOf?x~`3~U!C?-X=C-mE*%>Wvv78aj6Tn4HQzW!)*DQS98gQ}T22<>i-OmS6t; zFRef0+BIuUnvE19sZSFxS6~*kM8GkuebjIu?}J|b_kaI)NnVmH8#Ur9QQE}0{ByQW zsBO|bnPc25x@QPi(59D*E=$(wECX;wMn+m)`_nC-N<)2vYh+_sg20?^}T6cQv+bD|_7BtpiH8Y`!=P8qEUj%fG6K0s!L zv@(W}ra)897q7l>Eu_&zn#>Nad-&Um&nfI|l#@zzZ> zZ0f+EI~q7C(2UL1@~Z~Kp+Pa+)Ie?W3pJ!Ir_H)(tX;j<(w?a0kZLR~Ewv~qG(6PO ztDsg<=E*&kBXAGVQ1uz+VBmGUZoJbEt4aXAU0JKVt!>C<2&R;xl z>DhgI_gSrRuy)3v)>)}Ek=&eIiwbG5OzM<$@1?>^W~>1K#V5p@p*^Ij*dhh`M1+LO z+QCC*d`l08k$U*br5YYi>^KoPe<~-Qd8_ZFJHD?f;AeYtg!i$&1!Vhtp?xm zBE4bGvKmIBTI#TY0fCNj>^wn_xP7qB&|Ki1q zO_vvAd8_u8WfoAl+40Q|IdtTZb@o`9w9+_>Sy@@uii@=af;J{P#`IgMYtl#Yjo02# zUgKQJNINPOM~+C6rts%znsw>b3i0aRuTihxyORT@?aepDQ~O(*tEQj1Oe4-Mf7>D- zefW{!Fi<~l(ljc~k@p?kC);;!H)Wxo&K{!d@HtzWS{%dJ(*%9beUxHwcAy-AN+vyh zR~;314aYdTVP=VrFan+)o58n8s6fNuCq!NI|% zpo8(HZ{@AJTc*U5pkfE$ZBDDxHmRycHjElAgKwxnz>Qmkc3mc&naS6Pv_OseY!xdA z2@251Ju}CI6R2T19WWFXwqH7F^=wVFXND=R8Z$25L^yl~$D z7406Xh|gD5ZD&>Us`j<8xgCf_6JU_1H)?KJO=+axNHem0*5k*Ho6!TYis2*0N(9Fs zJvp%dKr>7T7C;eNv22AkQ%*mgZc=rm{XxqP8aPO`SC2`#)(e;1^N=Lf6>q*)C4puKoul9WR(}2SU&`3g8%#wAKvG~xptZpY3JQ|->()z9P@sPH3kJji zkOXhD@_ME9uXG)kJpd5Vq`*nK?)wQkwzT&0_xHCxmPFD3khngos;bn&WW7*!XTYmrL+#f4{SuQ zsfaV11fKi+g-VcCRTPkrq`6q&%#Smk{S4GAs3rYax*0QgfAR70GJpPji^>q}hRna^ zv(IJgwyoAlgXoMpBpRwbA7ex95dweYwhTRjcMN+dWdYL*Q38ft3;kPXL16dl7$#K?L9z%o5@x}i-0?*M8UGir=> z(+Dv+JL-@0j$E>MiS>b`uj1FLdQ*3^&XBG|prm#W?%ped)d0`&^pb(9^*gYK>A$N+ zyvTQ$;pt z!z{OZG#VMvvP$V3W*GHXUl^p4*eIH`2Ob3fDcWe3+5k021fM}Bs?T6(#)`5Eiz?{E z;EZQD1G=}gYV8YN;T5GZkfOR?eO=Oyr5Rdye!_gKDME7~or$h0Bz(}P)Xad=XJ=(z5n6+2H5)7 zfBjdh%>!tm=OfW6qV#~cPUW1k^+Sr4v?R4pj4sX>TCfoLp>t3drLQE&R*Vp@gLmoY zt7<>We?(#~Gb__5C(E=}HDjn(k4|fwzV?crw`5ESlL3|0vQ)nxDPb>-ssZ=l7=TWl zHhr2I#Pes)Tm6$}%RCRkbKaZoAl(O!@{Q^nMq$~yWvk71P;ijVAxKOj^OR#LCYBJO z5oTj!gX2JUnnVjW*if}>)lC7h)3bW#rehp?XCAv8r6Y1wg&aB%Smgg~oSiP8qBi6R9$u-`yAk$u7_ zAEa0(hfX$wO!pT)BPmuQHLf>mjX0$MhT;<9EIo+^jAky~`vMgG|z|nviZsE1EYZhe!u0a^!c=~bc>qxqG_KexO zrqsx4y|h&M#pARVn6NNOMyioZRYQA4ReK^8{-2=Kjh-$|5z2>7A&7 z)=FQt=t7o0D#A)Rm|WIpfEh0p@?$kYT1vNWL^LSa#%0eomiOjMMS zt^|3FRH;QK%uBFniP|S17P@tCY%@X%>H@w$C31?aTE5CaF+^)9?vPUDvmaLF8;lAH zO%X~Txu*&@sam%jeW^hHWzcX5%eyE;ipnHF0Z3D|7v=qa!(@~KfrhG~>S=iD-E*4n z%m1y;zz}_J|5InBEg(he6dV*793-n(uF*7Yq&X26&R;NDJ-|Z<6)ao2%;t>sPVK#? zh>vT7%nINjP^*Y2+|r0~*EhS2>xpBsX6+hN65=~C--xph_8cr>S_1_D#GLfy(K$2c z&UtW*qZ?+|b@IBjtm;EHfK7|~k?4QM^-|9l@n^)VNssl{TI0~6L+m2Qn|2JO8y4YX z9+KXNadB}*yr&z+C!0Sp@;w;<3|4AJs?gDbh%e(rhMfHPq^aQ$*#U?lMflCmZw$FP zFJYeKp3Rl=s&W$&7~wO*s2Lzcsr?bvp^1tC1*n5$9GyE(=bbji7}B)Elm|)b5x@_K zO?Yk86(gob7{?MmN~s%41I z$5^dX@n83duJcsk%8pitcC^+z+ceT`oHki@>hBY&M-^#3R{rkqe`V-V0A^oo`9gN= z*kOR5*Is_jnkzFeMAbc^OIha_cBmg@Qi4K)jiv#81N~Z3%7K~&rX+#5I`zrzUv8JL zzW&P2&pSVRM^-FfsS)Rh&L6q&-Bt(2X<79XJ?*YkYL}K(Jv*vD(Qo+Zk4+i~R36>i zx#+pjA$3!OZN1kj!@Y*fjOjBBK;hCyCp=1^|6VUmz7(DNNu>XtWv@>MH(Ee!VL=K0rkmg0h|Jl5xr0VGN4oW8Lh;6 zc!qEv4<9^i&x6ZH)I+@)u>j6B5f^DjB0r1`Fy7-$6(_)%pg$%mTb1RN8X33R zd?TJfQVMP;P725FD+7fsr)AYo^lZB}bfO|^H)bsR&f2vLo>UM#u7g@%X;i{E0@Pg0 zEp08vOMo;W2;-2D5ZUzZCYdpH zhV0(8TMnfhG6x5WLQ_k#Q5QD6w!zS?7){cOb+vU?SLSoVPXvVtdKEq*oXEnGLgTZN zW(REcC8Df6AEwRRsw zltVOY;-!*$I0R5v($dllZ}JyQ-IIcW9z zq@<+wR${6I)E5SOEBh)x?ZbT=tCLoB(~5E#NDl9cB;E8@&(&f1t`MeEQ&UY!3@JDe zg{0Vcto44YrCK3Bqq<@eS?Y-WksE=;6j0s`iUeF2|!C2P9f=9M8dCED9=&PKLP`w zF-d_^R|H_gbC0E}T8&0}fVbw%o@1itL{l_Rh6X~jrX;pZX3@^=|EMKwQl!h>tI1^B0 z_8;Ca@BQIDyQZk&qF4K(cKqo+fBbFPCk5nq>OXf5$2huSb}<4*;m{3(6o45@m!so` z_j{fWNxF;;42~O$Cp4s`)=2tJr^O5;hLHLaH7HW84D$%}(Ytr)T z5QBn(BsnQrRxMj)a>!bKMOZrlE)cqnyaqOL^{sBM~- zd|0e;S0A{cNNaCJQTr>3mzG(z+IEU{JbUJBNtmBt1{2jCdRw-%v{*D96BA?7c4SKS zAJ}gWAkN<%)s*dNu-0)Dpu-$Ka@bUT5O~J`x{N2UBT6J4O-hy5;7Af}(%Ox5DqU<4 zXn5!s>gmmY;`dpg!3liWN$kb%=NQLcoXpOLVlktT16q~aePyu0QcEEvL=B5pMEri7 z!8{=;2V&0^Q9jP=oaglJ3}A>R1WYg^Nu+nP{-#O6fi5O;#IYGOZj3BkywK`@=$8^D z64}jBng)@gkM=%9VvQOmN;2FR92RVCov0UPp3IbECytrw&h(knt(Hl~VE3NgmNf_t z3YMDdHIkl@ZW3&80+SMxWSGw|xl(q;j1<%fI)BjZ<@}}dmX@EYicGYm0vSu{u~}1_ z{9Wh^)Av*o=JQ!bDk;yu>0nqFf9%y&9Ph zB5jNsz?_}m>@@Wtga|Nd%o~w+=YhdveyPDDbq6XKF@bq;^JL1@DTdVT{CsZn8rOiA znw*?$X;xCRfR#WJ_oabz?ErFq;%D3dIqk91PyCxa`s1@;A%PR^`6=2C2`_Xup$7Q* z)3U2ws>?h-J)8ju)Mx0@fde0ceL#Qul0)(6*?soUut;CeL-y%x`Eu)*X5?Of?R8nX zLeY|%79B8HBYy?w@RK+o(WKR`D)4H=$Pp&=Fsf;kEYJw@w$=_oow61pRZWMMWHbZL z&de4%TOb+^O(P*bL8`7-S^5(GWK+FrlkVOva385hzWmb5GG|tllJNIhggAVdrrlMM z2XG9HnXg{CY6wpZBZ%k$g9a$iGECOL`kKsA1Hbm7W-^+-zk@@6UBlzGKCXItvQ;~5 zeDU!ocFbS>>Q`pGK$^mBYal z;46dPrc=pF>s~S^+usxJyE zl$LDC%a<6{V(0Fi@~Ik%z@Q*mx_GHYhNK!H&2QSY$;9Ue4;WJVLU*hOVas7Ux0dwON!;|onK46 zHW**2b?wDp?UXU4RjPB`bxqw@bnA`4v2v%fTE^BiN`HO0wW3A}Kl@C!-)R!4Ep!qA zNs7T{K(%<|jW=Z3vgL}#^|uJwrI15}M<){MtE7m@pmZMqh@i1FYswW$3bYLxH4`b5 zE`6Lq8XBjh&kj9Lu6@Lv8>?d+-MPXri27q2eb?*Ko$vai9J{XWrku<^X&vBeZ`La0 z{GM^n0BlfOA{|73OXdQ_4>pCib#01_Y)7lQ910${e|Xr=_|ay7O+5d6zIBgiyxnLK z9lEFVUZkG(@+&VJhy>$Ev;)0^P5)@hQAH>plJKx_qh#D}ye+6Af$&7`Enam`Ck0Qk z*GJA$pqADpD^${rR#ichf~-S@m!dh39Zj={aM*}pX7ms!IFfQiE*D=mE@YTWx{-B2 zNW7q+z&^{W6{{?2{Pfem$;W^FSmLz)xT(JaSxT!F#qr>JYSMaldeB5UH-5Av=bV#S zwHh_vz9Y@qs&CrbBp&Lt5t#yZA-zn4U67{1p_(4nGegA2S|(CmxooA}QDY1rbmD|b zMuQ=B+Ig^{S1UM(?jemg8%+cO9axMb(a@6)j)&8M(?DZ!Qn{2cUSx2N?F}Bfhp29~ zy9HJp|yc)qkMqWyx5&%^5SIUMxraqYd5~R(ToO2(Bo;x4awZ9fErMv7~ksJYU?OMsxxLzj8QrOK$7Jo(_dLbLX-fBma zYgxsW%J}wI`yVgX|JfWtIMUD-6e61yDJ4rQsl(1@OR980{{dE)#8C1W2GV5&xsSmH z!c8_hC+JMTFxfcutf`N%VemIHStZ3+ zGzB-nbXQ5WcApw^D|GX88O;}c-k!JbNBWXZ^zc-Rm0Jjp&&StCZfZ@rs;0`$FXtK6 z7C4AWi<0Ecjc;0d6hQ~-h4gz2m=s`YFBnY(!|fXAbQ#du<8=0Et1Dte0B}W2jxcGu z{rmS@#5i>5P@`|aT`Vgvv$aGA3rP3y8j-gHof;b(D^NPp(@)6JV<{4@DgJ*fE|UpO zJtI>~eTT|cHGXFf9MrYxp&|yOWq@WYQWc2v`_fVwe7{lNnU*LoYtKpV(PL!mmMzw0 z1mT0)$+hO-0T_al`t5K(_6qNavPM9cN|q7LSWbSn4-cMtc!gS)@M zb9j8$VsF#jIQ<;$?`PoYJP%XB#Y=|-c#c(7RWfbLG^;P7n1kv{x{6M-=`B@{JaJK? zZJc~=*T#TDfj4atBR;{vh<+dGPNp9*=E30@ECk8%mt z`gq9!O=IqZB2rf)Aqon@z~a=kwdm?oT1K@-$}NctBv_4gQE8d+EQ!d_I|YPsp1$;D1ji9eatge9rNff_f!v<^rHbGOmpnto}z3a&@$Zy+A@elN;ea~>;#_AYH zH!K=Xnw>a3Z_pcD#?lRM_1qnjItVSP4j(vdFm{^UQfJz=dzbxq4f2w^3aO_-EQSy{ zG8bBvloP5X@WVhy_N94y9!@0bzVs96a^S!LJBOn+qC%C0PAVA9O+VWt|L~9hV70U| zH5$|%8|oY6^S^yA-Xpv%f`eW`y;*l?1@35OK!ccy(h50o;)FH3hSSIoYBnHSQBxvC ziczh*S!d59TADmzvZc;2KnD&Uu;>+j-;Br^n)3a|2=oA1pfa?nAxSx&D*1{o{X69` z{$jB2gK0O7y6!~;%K0@bWSh#|6`st}sMyb_7*H}Ql)p$hAUSEVw$cjJh07B_+z5bRgU%Eo-s_SIOH#_93onILk4WLr@X5N$* za3YAlNi73n`{2V548XH&`7(K3^8zW{oe22GbaL3ga7{D{<|8-D68QkwMcCr zCjvka)DGV7MK+9FBkZd<&&YCmwt?>bE|Tu;YsfK0Mv3ziWnRoYi|FZk z$&qTrD&(|s5OJdDMTx{*fo3HNR6yVt&3ENDY8c0AH2c6%W8EAYB;}zR6{;lMIE~O^ z6^MhDD;lWVw{4eGr%%cB8Pk==7%!t0O?^<)uAeEbgZ5f6Q8BV!)2!qD$IITmd*$Tm zlU7To*12ZQ8VOQ^N;71H01#3~CQ-M6E`#-qI0ETs+PU#KfEpZ!LT%0rC1&yBWTTDn znV_uTu%Jvtx|&E42eSNHx$#7~rh+wcj8h5==~Z*cc}M8Rnzec%uOHnf5M5w>wtv5F zliX#-f7l<6ar|NP_r0%XvAUETY_Yo0%lY09@+=?3ky8&A@2*7!ps5!T9RRi<1r!w> zWtx9qvcmC$`B}>Ex<5HUUF$7qw^)~Z;o@aLd`JdWH z@s3fSk<)~h4z%f14PAm}eSOL6GA4P98A(U8y>#6ZdW<_ zK&n_Ylq7V#+tDoCOI4Swfh-H5tq-hQ*gx1zk7pm3Z@&G;LT}__A|oPgLjc^tra_*k zqXKrELAZ&HgWME9x1~kx++$1r4w4kQKe#*rpQLA`YeD}qLspW@qJRL(i>-~Uu0gKlrC&-0A zd?p7p&$)j6Po_}EO&ljCvpG~4CL~FK?BsA_MHmz-H}`ObNJO)Zy^x%o=^mYL25Kl z(YxC($@E`+f);uJHUKtPcrQUc5}G2kjP*Ne#3;+9kiTMs4el3gAtUEjkQpI2tV2)8 z#QBT+{dq_LnFodhN}r%UW}Q<|4!QN2(`SV84){<3)-k<`gQwPlWc|=}Qa8N4N0QhlQbIoQ9!*@$cBaL%L{P*&JmK85%d# zHc}9I(1Fp3!8kk{oyk>e?|5fDSS~{0d3mJlc%&$|IZUA16}|CKmbWZK~$Ds z95{HOHRYW!Zh~>2vRU&y2?^$$R$_1c_u6Z(*+#y5_ip*?mwz=+?Y(#3GgK&E&du95 zZNsjutF>bIfBu($Hq`4M|KX3aNJE`x&g2?+3&tJ7hVYfrD-va6%2~a*z`j9BF;^fR zHIzGAn`-xJf??*i=CH3#87tSdOytOcbSXHUFG<6b73lGJshFT!!x7kpIl?#puVzBY3T6EC`EejH}A>ZIm(8kq0S?Rj~F@|5^;VXH({I| zAFxp4!TncPRhuFum)k$IzbeOm(!0+uTQNohG(SbC5& zTAtRvn3q`b7;04Ov@rZzTSm0gVB`u=*@TJf^3o+k&1qZ{B?^ zbu4tMVJUaC0tsj;tGuk-LgTcPq9qj`BShSR%8nZ4J?u4IM0%T6WSUK3?{y56 z_?YGgGmm6iZWLnt=(uQOal%8T%!HgcsR2U8ernY5IvqmD_k{+9TDTL>Z|l}Ag3_e_ zD0$VHx^YKGMJq4tUW<}=Ul%`f&lm&{D$tpP@bi>uQ#?cost6hE6@)^aa3}y2I($$A z3P_FcGofYHlK0?u5WaA%GEg4;YfFQ@6mOgGJh$eAr+smcu5$E&RL$a5qt}Yr;dLZm zuHV|r08m4X)+G&h5#niY{pQ-tbJop=jTypi%8_8PL6H#3V`HMT3JPM|_HB}`b%Qh` z26+mKbNLU;O%XySj<93l`JFs0ojvyM1d0^;ay!nbB_bWo{G#Lo7cE*OBNU*Lmw#4? z%TJpU9Y1lrd1ch{5mJN)H8L{N(3v|`X%S|{6Jj1@9LX?%4_#gG4*3GHO6x32Kq9m@ zFkC;|L6vOCPaB$)SB+ltp3uJ1QI*bM_0mvkggpsEju|(`(72QqUAuA3ytZ+QSfy1K z^@oSj4q5(?%@<}TT4hmIv2*)QyADFkv9YlhR`u)J&1!e?00)N;HlqPx4ZtE$>g3W% zA$SiI9mWJ9W=cR7%wJ%QnfrzI^M2cXKjZD@<>eW()XAKast|jd_t~C|ZEt}Pl{4qV z`$Zr9eE-w)(Mj6vVRfNCuLs#uWQ+w&=m+2g?TsknPDo6Ui0}yM*0Gxz3-wxOMjmCn z7Gaa0>C{whT1&a1c77dwlvj1;teMu>7q4pR(xq15{>q|PbV>OZ5t%DFG3^nBP_}p1ltazY!XZ(#ko8{kz z57$zW2{Q7`Nr_sqMtYTBe&ESm)YbNVNDsNWzQ@vc&~F?QluiHeDOXvzg; zN;@tXf%YHVZ(-IsbLOZ_Co8hm-{aL^y{79;6!hf(fHH1;?zZqd`zhWddx*9+&|A`* z_t9{bqYnhzpb+)Bk%MVZgPbFI725e=IbW){WHn$w;K{+(-KjI0u24nj!Gr@4!c~qf zcZLuNpu_;s3S6IrBmqX8%04Mu1GZ{wr~sKXev%9fA87m3%9Sgv$0E<3+!v$(d_f5C z?z`_A$p9gD@@_;AtOZo+49Py4Z9PCi$KuJQ&Q6t(0b1zqmuz{*dIi|@QDqVIfBoO$ zUv{ZUft^>PffK{yQKTPHf=Buee4+Za@C6;rHY@B;u&o#mT@@4@@^@0q&AVM@>NS=;($p~#i|un_|I#UXn-;WY_o0KHuD-G z97st?v92O%X=$=+_bwwr7@j!Xlxd&fzLsO$tAHC2sc}Q&tosOITSyP~?b&CXtI#46 z67?QLRk$9A!WS)BWJ=%r@7_OybcJ4Vmr~uK1Sw&FoE`FYYALxt7<_*C;Ri#;lgot1 z*uTqzC|2*|wuzs~Qay)Em8%?mI9qJ7>r-@;r4LWlq7F@uzqny>5<5KBGl_K~15!W^ zj#ur3U%kNtgpu$(*&tD}-hXRRH`tCYhD{m;SXohN;Hrd#VfGBOG?zzPE0C#^r%bjk z6el(02|Esof`|ZQ*zk~^t2ieKbqPv{QKh-aQ*!e3Nr{Mvu)kC5x@Y$u^U^?~lE3Sr zMg8YW&q>$rU6m*zM7pZ2*>U-I()oYnQGrV|LZ5Ri^Mkl)@#8(x%L0 z%eF0+V+DymOy!ZR=VZQ~%{^M2J0By=Zz94z=00u$%z63c2 z@3Gf4@={h>W&{jGVn7IU4S3e96Hvq`P82vs$i?#-RBpm(u!FUs|FMT)WYe*hdO=wbZhRrX|v`P6^s%V8YaUN zh8taApI&_gFOY5*lr_Yt7X}g&geRLipd46rV4j&cX`;-SF~bz^=YRcNx^(IyfB5|$ ztcyJa;DCIBH7q-K;VTjaD)E1PDILlm45z}(yS1)HGKPf8r^=c$LUWUpl`LJp)X=XG z5)4zXFa1!OtX;R(xMJZx#eidzg$I^UF>?<^otm0z3{T&${9bnM+G*gU(Mh9a!h{LR z=NfD!N=Gx5`25;+88UE)brT5=(f*c4kI7GKf0E+jVxzlbUc)R@UQvGEGb7yWC_sQs zl#_r4ra^I3bd+5eAK*PuFp_`e=c$vYn&*fDN1^iB;-X?>(!tAyoB@8;wmxhx#eVSE z5I((KS2_AXyxyLoM;){;&4?1btOebfT1@@(`k&2$r?Wc~8XitM7674N_{u`dq39lE z9wr?h==pd&=eWH2`kOMZ|2%aWeDHwWLq3rNc#bH*P3t#V!ThY5vrKvM96db%JHf=FP>1V(F%sObmu7eVa8mgcg&GF?b>&<`v=l?DT_8+jECH0FmL?-+Q=!SDu zT&S@Ag(;F^50l=D3tn0v z$zzix@61_iNrh4ZWQ12r-m;*mK>qxfKMMrxj3rB!n0NSv0+<>rM@S@891%cBmT3 zMUp3N56Y3}M??+;yl0>FotAW!qfNJG`#-a8?j2HnB;DWJ*A5T-{Y2Jr`Ek{c1{kQS zuCfg=I560hWAV9StM{^w1zvL-5DzRVWhG_SrU=gy`MKl8NWi=o4Uxi1f=39m4Rmpo zCq)d2u(BMK;E~KD=4HW^`}^Ph-st400fa^nW+c9!I(^D`F$odEm_vPETwI(XFkf5p znkiP;T%eo-IeJx#@I&=$(9-Xu(}_F{D>Pz4>C#DV#79c`r13IHnQUfGouTz_w`I-R zHFDy_2`kMYKZ-ZDW$PBnNcXhEijIty1@p9oV&Wv@{OzL+j6eD4W2JPvY6^(_IN@SS zR#4a=S3%tN^y?`be%>H^ckeYKfDwr!WZ}Yv#;OB3Kv7wdk%5EAB|pjM0N*@pkUD^j zpD0Q7wQBPo>7?O!m3$`zJ4QKc@f7hmiLg+2%KD;1$)}(ER%?kbo1%=2jC_C;;9=)( z&96JohW8%ptNU@4qYotOc#Z&asClvn>7@jGaLN{QNb?$X!5%+$TnUsfYJa+!LRS*P zR@AM*Y(Ya^@-iR*v7#Bs2)Pk*rHxU0L-~57(DMFI>#Ez# zSI=GsKp}k2v!fP|M#$tI$*qB|gtY}?@A!mx3#ZfhBQhe=6hcs+AbIDVcjWTL%d%z5 z7R%?6#|#@VSjK9}NA#ggQ3inr1*6KMlZIxK{>vX_jLt1hdI~)ww{6*G3MX=Oq{PI> zNbRj!BdRVeDzs~0KF(3z(wj9mWyAiBs%+}alO*(tH%I;xb|<=$;7vlP4oHX3@6%8( zT_Na>F?QTo3v&{l?V;c@a*u>Z0nCgWJx;1?s!fqSc;PzN@8#4Zq9f$3x8JhR@{|cv z48`gwN9S`WMZOqT^Qd0%iOdtytw%RW8l9y4w{g;)6v$Eqg{{%zI_U+rP z$0G|Kz=IhSI^S93wD#)Kv5V)mmUMIN@LDinAdIK6@ai8{TX+(NmpQZNSbmNY4aza7 z^P_h4#`POk&Om)0-XlsRY(SXh)IR&{GpVesv}geQrR3;fm09@eLJPeD)FA{)EPaI5 z%FfDBB7vF*6(ix)gPm^6(cAShU&E(E72HCP!<B=NtdvGVe(t`-Aj*k@31v`m9x24K*PnKNX# z5}wocie|weT4|aLxCMYsR%Vt_+)MYWMtKv zRaWmfEPj~$?hn7ST1YO~a*Ov}x#t&@9$$EfFhrqf@g(`3JSjQZt=qSn0-!TT%FGlq z7+Fs!xbv0gCFe|zkfH!Vd<(DoF;vBTwz9m^DEp|31ROPc{%q^5iK1~w(-Lr%W7Bf^ zRj*>vn1w?~RVSux^!GOZUv=PC@L?7{8zJGgOBXMx570q+tECR}2nfW^9Xi|QSzKN$ z{RZ~ayo|?sZIF|0X#CvXjEa{2XbJ71c;0yZ4a*1j3+pHQ4(ziqcd5QpCb6~Q`k#0W)K)>zL$ygWkfgko!N-Z0OvsJKLWDQfjqh3U_~sUdcq z2aQK{puc1#CrVF6H4j#$NM4R(pb%eCWGj6a0ny+I?%1`%A{21_CPpV3O&$EGTQ_et zS~;Q=kc&s_^%oWv%G$MSEq}^638z9vz&&l=ve~#@c^!UMdXu7H=&XU!N63|Q0mtT; z%-@HFImsCsNroyq-eby%h^XEwULzjo(r=eq83;Wbr%s=0??ZWlRHa_?^*3I(R#x#! zc;MIb@m)7izUMVm4b#uspVk@=?4a;Lh9d5$0bX*dY@K1?Y7J^T&KL1+!I#qM27KCS;^qGBv(foZIm#2_Uzju>k8J{h7Nm9P)Lv#`1ds+3N6WK|3p8*AJ_b7 z$W{O_|Mj2#>%IJ$_8!!hRzv&)OsSQeE0%*t)8&ei2Q1KIy{YbD_eS^|yZb&pB;d0T zWwCm0qt920zbd4dxEKS-fbN9+J1#!Xq7i%d?vqtNtddh_P8pDB-kf>HAd_}5O}6jY zZu!As+KTG6MXzZy;V@aXdX@aN?k5Y&;?3c;kv~j3a7cby^OLpJ3JD6ayg5K3yy-px zeGJ$`0X_hwA%lk4Ws)j@-3Cw3d!RHi65)Ftp@sr^R|jE=0*6rt79yf3P}&iyh49@O zD96;9sa8IMvV?{YPFg7GsxDTU5so2hWh&ktp&qZBcKHYn3bw|{9Jg;TW#{pJk8_gN z@Llf*8ToqrB6(k*sU02P+2}jn)lFW#M;p)KVYUf%K zhy1ho*6xQzj&<%7`kQyn4X6=;{ICw)(Xu2!3nfD2fKm?ZJ0OJxg;x9cvX)UKjz}~w z3xElYtUGq;XlyxzP66?-*+Viuc!;7um4@x6)=zd){GrWwh^ z+f6K%K0T$wTgqtjH=jwodZj}(oCpy*JfU|PyFYkNg& zEr|64dIreHAAO>payrqZMjjSuv25x87M>u7Wi@o-s<6u!{!aMmZoVplCk5*T1vxt51$KFwknu;@cya6 z~`OY5U0&-f-rVX#nUvu^D=*{CD{SFc|+BPe-PvJ@8-OS#r5#>5P@ z%^6_Jp@WA^5dkboNKkSBE%iY8Ob?Hgk@{Nw2k%L)DwtIY%(}~3>OT1B10yMi^qX_zrA0(U2+ErV#dvrQ(s97R z0meAvuV9>IN=vs_Y2WY$LE##4fGWac$B#)yrj~$csRiJf+4E-0=&_@%Zud`r`jcd2 zWJvOeWcmAl_#x2x<$V5vdV!4w$_#PgG8_?P_ z424ejKnQpAbwC>AR|10q4Y|rfbqoqZuGR| zw-7~`R_Q%mGD2~T3^-Q3M`z8^@;V`G(5Dz6P1RSTAo*(TCD-h$wl(-pCpL(;>Dk!u zXZMF+BLN;Hn>`zUTOSlApFDBW>eL8B`E~U(N-#R7->Sc5iqa;w&TW(?N>4Ib4SaP0M8B2pS&1(Mj8Ppj~=6FPwl*-;YvDKfZBvE5Wvd31@kN? zn3$MoO7g3v-%3w?uCJdsCH=JoBJ0a9Wpm9n8FlQ0d{(C(VH3A|J0w7g=BCPb3hLSR z*Uu$BHb!|#BkY}&HP9A~d>y3;eU#L^q^QJ{W$C$6s~bcqlWRj+mX_&jn*08T|NIXE z*aby#F#Vu~RZ%D?(wQ?;O_8qqNlQJx|K1pGX6b8hyzz#_#l*>e^)UGx3J|m@Kp>PS zK$}Y!G%BK=@ziNkrMq8uIgxYXfwoo1jTT%}l)sgR${=KaSowny4{$vodTG~17#dG^ zpCW4a?cZnRCbMSFmXS##?7WVs{I%2rq%gUAJYPIyx_z|e!Jg{2tZJoC*inW6azJM` zSUausexBsAQEFJyba*GvWY+AUaPtna*im+DAh)$xn^Fya2T0&p*T@JE4jh|ZHFO5* z)g3KM0@R=4)y$nUSI%ENZ-A=Wt2dNZEl&b^_mU|}Ku+O5Xi>bPPd@&{YFR54JhN%j zW?A{;4>C-_Rtu`NyyHf_T-?1+1F7}$`t{oq)D)SFA}R0AN)h?=Q|a`t|5L+;U8GN7 zA1i%0dibazQBl;CSKuAO#zQH@v8-bzIIb1)^CInT@s%oKXbJIb-+%9YyFSWMC{H1m z3gUM5tl7%mGgxz^dB&=fot>@s6`-_oQ`HDawtQ=0L6Mb)aDw5(hg+Q?3iqs1%dOwM z-g2O0lE+A-hK{d%e#JabyBPf+o*PCXpCe?7GNY9n3La7nkh8N=v`j>c`?)4O(mgx( z7*8w;4=&<}sBl99JI4gj6CE3^ImP~Fgrh9U3%Au_d#f7QIFP;`uIK0j37az1o6Zw>Gf6c}VoIN?3Q&5MMT zo3e@u^|t0~E-dhlpC~1&48L?$`l_KcOc{|L7@d^3esqF#{qQ{*tj&=B=C{9<1?o|u z25Gr%#&9Sy<@T5}40C*=dQgfH85NVyZ zX3ZKas;5um;zf&%Cl!MHHCoa^3oCveHfWep-St(PIZ97JgF^HT**Kpe412livaI@X zmDNu2p7-8;Pd(gtQ{>+Fg>uBR#H;S3wZ3fhs9QTOxZ#8sf27TSA>UdBPBuu;f6YMs1@rZr9&YFHDi3+jlCr>S>A84j!|V`KWJ| z)&uJ97N=2_SoI{kc+CMmdslzI7BxWX|M>UPN0kN866OUPevOt$tXjF+CIvMm4bUb$*QZ`zf!}+G%Ti77syWt4LBA#Lvn?NGtj_CQ=l>wS@)jZ zJ*foU<0&Wk?9jTM)@AkK5j}eMsuQ2;t>&nIjHe4<{TU!^?r~ei0;t-q2}!||5+0N)&MWj<1ul> zaQh&wCpWj^W6!@!#Cv zTaE-!C`p=M9HMoKwbyHZr2n5;E=HCnc?Ve1A9(E`GuTgH1@4l*QS zi2S$z=fBCu4I8Zn@Xfd0lsOCL$dMyQWX;cOr1Em5L`Fo)l2@0Qf~4!lmtTEp^_t}W z@Jfkhq-UgCYc5FCXU&==AAS6h)#8#S*t~VKHE!(Qdw)O~cI>K_<-KuP!Ax+q!X~8@FdDjDq-$uzeQO0p&z=Gj zSQpEE0|ugkf&w{`bwsWy*lA?aNU2k>9D~nbJQU^^ns*5xC}L=&DNfd1YZ*ik@XkH^ zgzv7~RgONG5vB||u0A*1e`9-j#D3s|OL(D&B(zg=twt`KzaUx1v#fRtnNaIS8zFL& zO)16~deQF5nn5Uy%iyrcBjx$w$O1!L*=?)BHD zv*rsQJ?=_Zl*R|`{%(J4-5Sqiev*()kNxk6D>wY#QDxM{X(UF?}CVxk9 zKAfZ|BfL~tcp&dCSH({)B+8SV`=}A4%rm9OBHkal(dG=+O{E$bdv@)SW#2C|&oL?@ zN@8MTEmz6k&sUr`A`R9LulMfjq0e*91B(vV2oVE0Q&(mJD!ijkYmcycLt6R?%?STNq;&ztF!S?KgQ-kHw2J& zZ@%`X6>5hK3NyBj$AyQU?h4#by-*1#&_v$*jnt{qx&7z=C4MDz;837db1q8vyp9^) ztPJTR>w^O1@a;O8t$Dl~>hT;od_<0EeI&?eDC)+I8E0KUwr$@gxp}$fNxt)&cMRN; zr4((OH*YorjZps^Z@yt=CHoKTw_c6#n_{eu88^lv8K?G~G9vQgl48s8K}g=izo+F> zfB4}Co71tXj9z{9Rm)GJ3@=`|Xe>A&bD@;u+^{~OPzlXa!qn7wn3qP5o#R4q09qAF zJil&!4Y^A=YRPTFz1mCB!8Avv914`KGhojl7aFbkeUvFVQRw6tc&v0DIeq%H8Lf9T zC(J#l-P*c_Ua!lL)4Cp6!__*TBi2oOX<0=l4qE-JUbWilvRH8BQm|ZO)zXfSidFc0 zpygocdH`o6T%7(Ij(gZ<(I8Owht?qh^=9ryMM;GsICm+fSy1VEnQ^C!_%$bF*H=~P zYp+Pp1@mQ$HUf^-P;5e6tenX?W8q6Y!7v5(OrJhoq9dcN_u_ZUzSI2nY3s{4ZSpj0 ze+7#Vt*THEczV#K0SZGI(6E`BMe>isMYS1tcaXOg_rdDhAbW!9WQsJ37KepdTSTer?#JDc)$ z_*d)H13#O0R`%}SD|n|+#lczYJ@5b_*8p9MGW5>t^E1fUX;YN~Pn$PKL`GPhX5-MT z_wicV&o~~)i7$^6;ycamdX7GL`i|$=UI+jXAqC4=q(J7W+XBr80H^%CdXH*FXKMex zI`sljqOhl+7^hE}Zr~g%@$kWOa1Z(XCD4IKmRP1mnyYxafpQ(@f5dj+ioqXK&(>!fr15H$}uSS0R1{?!X$0t{D##b zlCxaDe!Y30Fw+biI8YU2kTF2*+PzCwtX^Sx%im4=ohcl=%}eJmS-z0cm8vUM4?FAT1yUeSJyv~Y`50|P>Jlo`2DC*(=Ulv>DFUwPHaI)*0OgBm}(`7eJp*Zw1=av0CD5&K~Q_Yjc&OkEF}PgLItaaeD}>5+%9y7JH8;InSPd<^<*{M=kTxbRM1;quH z|YlbZ&rf_9?^7{JHZLZMs0> z65}l#yYA<8mdixB5vH7=NLdudv17-KZ3o2)^Us7a6Ksytyc^aU+HTR{8PWrCoEU!D zr?X|-u5HGSL-^NwF#kcJ0!pJSBPue=(5EQMA|)3f7VVR(%RQZI2u^w!22g~r zbCGZ?G;e@<28Iok_=I?)qPwPmA}A11ei0E7rlcoNova>Ty>P4_!Zi@Uh26L z^4+dz-L%7L2K;H5@Ao9i`RK~AXU85%9+_+%NxF6FX5byVh1tdYl*iKK2pjfeXla(NCh$`Pt+NAC{Ds7!r=K zX>@e7Sz;_CXCm_e8F)m7RBd#ew)iUx4t`6%*dR?7_qt9sp2(I=*LBTebw}Hf0N&5} z^7B^TN;o|_N-51k`iUQg(bX#we63b*^p}!_`|etmM$N$t*{O4Avyzu%c#a%3QX(QF zY%WpEPS}*N;N}m8OYB4yZdV=m^clKRvNb| zNKb$+A^k(7vtMT;2S2#)pj4cz5G&D83Obl-Fy3GQLSX{tp{>^JIkT+>_hil~BO9R5 zo-i(9Sim@R+km=m+tzJHzE1%^=>+b@d*Jolx_!%149-5m+F^~<+^mu6nrdssg*j>4 zNE1uMLW)hi?tLETXZEYIvNEAV2>mA^1VE0?Ugf;6HGSv)O$I)`Xg93d3;|n{*WG(8 z)Iuo7vE)dKPZ&QzdiA-Vy#nR=JRV{*ZsEDSwL$6Ki$NMS2DCbtMk+U^dWRR9)y#40e zrtDU%S|Nwh4q3Pp!fyCaApqFBZ?EyTf?ECH{ST~6qfYahD44+m2V2Mz9LvOpu8aCt5-M{vG=*4~b%f31{(Zi-l-L_VH|^g4?-!r^Lm^Ssz4lfB??E z{OaH3=Z!yGKK-rN-ZF$L3O6k+O;)d7ZLO;MsZjvi&Z*Os|fi;RkRs4dZOz{mW6!2%B8o3Fny;1Vt4-u=zH8aAHLkjH$? zAzI|0aX4^1Jo}2r5%I-^y2|khrOHGjf0lJLOR6qcnPm#hngwu3yM+TVNg9)6i;jn8 z4^E$3{oQ-DPETm*J>liF$+rQvpcI5!G}uSzrqGE4e8^Ca}cp-@o6y6FjbN ziVE$h)N#Wzvvob_(EpY9@{=!=YbPM9!3N{UNl_s-o?d9l($x?{#B>)h#R zy$*j^^@E%(IBQ^(xv6uF|Mgn6rw=0Qmkt;xUUJ|Vy_>gfmQ|}(NnU=Qh5e1yMlT;l zM_nTxGGXJXQ>Pjl`?{7Zoy|RK$`im1(IkK~wDoGN9O)cFUViX^!Ipa`7g|zQVvVAa z8F@v@IlRF-Pdfz&<6_VgvL&C%y`{`Z@uW7M_Mk8LbI!i%aja2{zS~$`<@kgTn~8>} zNF&iPW5-x)7&i0TTeVWCmNAoj*oa}$y|bs_);TQJs}nwPUUR=UApxD|^myEtV&)~CG#-VwH z_R_NIo|t~sH;{&S37JPSZS&!IxXSTYiS)UB*oYq9d{aZI)6K})rrzBNRSx5e&&#cV zzH)W)Sh@XQ{wUWKso7asZU(7`G*PM1IxCoEx#r;_R zD^5&QjMXKQD+A;O$0%rL@{-gr0?Hu=dFs?Dt5f8r>u=SY(Mkhm4BN!`M42~xo|Z{O z>alY@-8&QoJ0NU;%uJbSt*vUbrZPJ#+mtCvZ}P;+vP3&?zybssJ2E0tXv0MlXTUOp z2M^ZLi(68nNYf4)DxN)iwiV}(n=oE3YR-~9pz+{Z_(vX<>&2_3rz6KksnTc}5`X?q zF0@j;&p_Qd0aYQ52lkT`78v1UFV8xd|5Rgh>;$BSpL|TIX;m z(_iA^&a3YCM@ax6k5lU5gt8v>e)n%JM*^_9K%$Kzp*7StMQwK1NIdCE zJL+9^F^_Q3;zgQ!3zHesW~c{PF5jFhm8!a{@{hfH%1a7lId{EUw(Qs@8R;43nb9K> zkBvsb@o}EK8FX*FM)*DLP?{l8$wduQvhtMaDHf)LQ76A3-^v!?S{*lOoHZZbymgB} zNKWYmIn2~qsiu&iZTn&M57v<*S;Mj)e5AQdMUHZBq*Z7)1^5O9hxf(j4=dTh=YRR! zn4l;F0T@IBv+9*xEKZe?tC@AuGaLsDahw=!LD-j67o&$AW&LVYIR80 zZd@}93+sTTHQl<%>VN%LLny;0lbSk9 z3+T_unje2Of{1SFiJf_KiPS5*j#dX-c|)%ry{xoifz~AAgsoA)PI*PS<@-jAQZjB; z42Kj5vuWcdxpeuGg)-^uIA!t_%m3{^xZj8XMvomWGiT0}frAHHWCCJt@|mDslSU=U zz##*rD8ES7u3IaBaPSfd>CaMxszyO2BQ3)e5(MWcFrpbK#+;Km^8L#1W%o%;DufG0D^0e_XoUy4h zQ?1<_$E68!fpVmxWTT=Z&5Lck_jpee=e*vpwbq~66L2~@>p#!_K;F?e!&Q!6as_n; zV?^!kT0v1_mEq0!>0}R7CXKR^GGo{{dFrGk+{bJ9B)DI&)jMJFQS0YDoR(GIuem=z zLIU@~CBWU?(fTC7#!b1z;q=1_GC3z9YB-KcnW6M=39?=b_Gv^+H~ZPCvz3~yMt1Mo zEt@uPGD7i5Qzpqs^}K@T%n|=9)w1~d4F#<27SfYBO+vLkHzZCj|{)fN&4;HN{ zE-03@tJcc)UE3|pmNYua@`|*II&koS<*o@OLLE1F$YASf7^EOCh{>m)oo?5{wN+iL zlKuPk8!Gm?k`_>}3yHX&8pSBaua%SlVBLJBw0l_z&?&sXs-A0ldb+XpkSh-i2sEXL za>L7{goE$i1CI}40D46dnmv3}bFD<4)B^_G6A~O^?X>VHjW70WuJqNAG)kRXPLv$` z5+3!MAJ>={{_?_?4XI1cw>^x;28S>2xlJlZ!WrZ$x@g`2iX&UQgZ^t^=W_# zaWC&-(kCc)Vsvb@S*mwCYWPHZ$dN>+=4s#VeUhJ_Zy^!Tc}FsjSm*?JHpR(MRqD{NdDadmr=ZvOp>-Mci@0OUDXdzN)3sEeq*RD3yGh_fSEzsVJ3YLNEwEmWcQZ+X? zO3|j>w1MydRltW2WytCuS9=h!x?jwiIm>ugYgNG!_5{7ko&l@OEd4C|#BJR>P}HDf zscD43eEh`mR-jK;4-_V!X*{Z{t7Z4@-PYWg5*6g};m03Z{*?EUbBC}10|SGb#>%fP zdCm3~j1TgwTPE+i=O_M#k-k;{;S6rN&Wu^r1iu1K^DLuXk{Q;%PiBM@#Z zzTJCv+vJUij4+PHp+kq7f`ky897E&LwO*UMYB4Zu7}O$xeq#aLu2cW;miAXu57TlH zsv4b*UVm&i3^|SE)!g45gMv_zwfWNTO%9Espghe4QA^q#&qe~wU7fg|)WB1S6)&kk z^LsSf1q9Q*TX(5bl`9y)vIOzz`NQ_(Yd2Xjg|!EknPsJ zn|YggXYvFj?YW9`hK!#xcaAAeQVl3~_AdIP8WDPMu+>fCeYUHi^RqFrh%fH{K`r2m zv-tR!Oga|l4Mm$#)3b8LO5;p?>+QE>{N3>lXQ#&+6L00Jm6DU4V*>7ZsHaq1sF2qd zzou*&@ef6E;aNs%d_N#Cz$WJ1Iz^l*FDQ!upa2BM4hqa!7__Y7%f?e|I1Lxx4t{7b zD0G8nlg2u1c+I(gef@@p+h{C{R}X=7Q-+N5cK7>}Nr1I;`O;;9` zaYaL+H2yt!=%7VpMokzcW0J;L7YRau(6o(C*67NhAyQmeY~CQoCB^j^umS!7vVPrq zE7k`9M?Qbj_(>Lm+_Y(v0cl{pdHe0R1x6e?Za{F)nx;@61>3V%PuaL-qof~7mpgTL z44i{v^Y7trAfz&rn*{_^pM zA8Y%n9=85Ty)aOY1_;uEe?Vm6QQ;Dz`BmKx%;UqmMDcqMQ;vGiXHK87&vR`rFL>EJ zQr^ekZ{4|NQ7UqmC|eXYo+;jF&WRk$ub#;}W6x;R=ur|kEUwx7s@~Vs8h=Jk>=E|m z!y9N5$`Nl7RGP8qYgmU|1~Gc`LhglB35#ZCWy-hTerw^7g$oyI3#GnR)W2uv9;L+> z`Tg&HZx&;d^43Yu;-g5Hhhq=u-W$mUSVH{Xe&THESU2#i+TU3K){=4r>P)LyTXZQP4N&uQOl+BThBQk&Xd>K1&taR%7OSI)l z4qIJ)#nu=6qSOOYY){vSufF-pN*2id#m2-c*KVBvlp(JM@FiS%Ps#hS@e^(YSVM#+ zuy>$Tp0BhLjU798749%Gi%Zbac0inS1nri7QVXWHlZAiuTT@+^g9DJh6UH9 za~IE~xu=up6i#cKQiY8JA*c2S1xiTc-~RM(wlM&->D{-tg+?AG@F$&!Tod(@3as)R z?;%mbhn?q1UuRAEu4(626_Prw6jBa}oQ z7o!311H>MK&vK1ydK6D{jgAa~w|%D!^T;y-VpPN^E%i3B&P$^0gDowBbzjvWm5xLRcom1vc4BGX*>k) z!QUyWCj>_rA5wQ`1IAF`9OS;)q#ZCAUW~ndz}GjTdi(-&eZ}m8=t4HV2Zmc9Bwt8YRu(HRb~$OuVP=UAr5N z8|#njqfa3nHj2xNjp3&HaR+z9Y!MEWBp3rc=o*zX?XQ^ojR#0xx?-fxN|hN3R_g7wmYDC{ z3lT5oeRsd^_S`uJ^AE2Tv@Fk*deZS@$J=@|3`Iqybne#K_CAjDqywjc^~HW=r6hWN zO%3G9y;oINnV0X~VA**;^X%fKi?-e&ad-Mq@^|(C3=`(5tqHwG&%CVGIj;MP?z_x? z&Qqm*JTbNcG$PkWU&m`ETEzYY!w~xjh6K%|?#EoYu3oz;Cyt%4a2D1+ zjaDH|Krutbb#VVd88Uc?6+m-tI(o3NU@5an!Bj$y1=#)cl<9UY*Hx+BQUyw{NP0m6 zta?_1`z2I&DC3ak%TAhXtbGuK>W_JLY+x7($BrH|_LZIiN|deqqHM5@Kg)U80Mibp znHqAbdieIna7Smq8PRh|jTg8qqkj*YL`xvr+ZqX+=M zz#zpa*7@-LitjB~=-0!~a(7(!K}C`B+*unGq=!d@OXl%R*|B?vZLH)6+4KRUP)khr z3vd8_UHmL-!a%J604w83L_t)Hy6?a~GZ3I)OX>WcN5lapi72^8b3S+lI27;Bt)S(sla z7*As-jFlVLZdhBf+`L>FrFmg!{n)qn?A>E^reoF9h8>A#LfMxuN1ITNSW2L^_#($= zU9{C|=fP=!&c4@Zt_lmhw_1F`N~z>{0$9uP$@vL8Vo?#EI*@+Am@vqrQX9s7H&$}q$7J!bc+Tdl;@N*lg8Bx@iIXR6 zgWzus6JCEtPUNHTDuB+Dm(4z@UIH!E79CEC&y$a#U-X#ela7q`su2#G1^WI&(_$^72eUkkch}&SsIDn`c(!vSrK6 z({R90-uL*lKjWDJzBrh6&^8^qHJm(s(!4V^cSkl&9iKUb=SKH$Ja+!P+1r)(kZ}~1_lNUJ6sGet0ICGWtdi=z3i5L=Lh9mPE z#v*5qSV@c`ijgnR8_yl@5rYw0KJw9&^1xBeHDcTzNArd-dL&wM= zOh_+3Hhc=cu@I31AsxI1Hcz|?HbOi~!mBJ^?t}9^Y&iGse0Sbwvbra8drc3)Iq;TI zP*vB|>q<{EufXQgy?NE-aWu!w2F&Kiy}-MhnVBhhr}ON2+;@%0)saot&bAp?AIwf3 zv@?ye>-70rNs`K%zu~=i*7vfR^6UspBY%_t9wRw!?s)cl6dt%eCxm6=qu6dpT zr2=@HpdFE8K~aGf%JXah;uMt>+3$G$+#~bIk&(B2`T4&2srSRP;QE-8Y-pr8XnGC5 zr`b=Eei%U&Ex+hltgN z<;4c(4Bk)dnuTHS{pC;2Tb}AWVMhx;>Lg%sF>xKG+%Q4!O+L=+Okih1IbNENY#j_r2fl>E0bMfgJ^GpVf&=NXlfO$_lx7pUXa`@_-+fO@K`bS>dsA z>GodTR2VEy7A19|{N3^ay2#jI_$=4SbE&;q>yf{1ro7IzV|^M>LGJAqP%s-4NJSQS30|pK-rN?<}p6K;4*x)%AN`>c+?D*YerpF=|&3&?2^Zfb3Q$oRk zTBbFWlPhPgAa6UnUIUvvKXVS0iW#PQPUZ|o2W1qt=_7ZY(>Ay@eJsd==g-e~>OIfU zjB0(M>|B{CWJt;>&c~4B*-)Gh_>TKPff1zw8M}JbY73ome7s$HO@cth5M?hSg2Qzn zSFV@u{9~OugWnnao&Rj;OWZHd8HLL;NB%@TY#pmC8Q#ZpeuiPj3^jcZiivwg_I#Fm z@tnry&Un-{+Z%qx|0q7^8FIgzS1;{}M`vWELSrr>3-0S-!?|A; zep7SAkx}F8uxF=o;u?|FZ8kL>jbG=Oo%B5&kgIOO&a-ju&-pCZ;T-Ex*ZZ*h;C1fT zHgNr!B6(AMdd{vWW>wnUqbV7#=iYU5etvdd_gs%BBEfU!Z`?ay4E~O1#|F(>WnOa6 z&NVyN;M|Y%JNM48=!PE3nM2O~+aK@!582p!WgpT1m}guEU!0pSlr4%MT|&Wp*<8S8;ArLOOtU+Dlb!sR)YIx7Z zrq1I%_mG+Q{dr%bvu?fL?>vWxz1FY?sG-ChV=qTx`f{{6<%p26Kx_f&19BD>Af5Q3 z@p2^nh~*T*Bf||CLL8j9H=qG%rpO;WtHEMo0rBMyR|2jCTE7H9?EWyx)oZJ?qJ$7?&7t=qQBjvYHpc@mNV z)k@ysB}G@k{_ksRN4jOj!1oNNwnSFFVP<&_e&RT8}$a>V!sD>~Gw@Q&Jbz?x>NkEfSPfkjfsHmuC zmT&aYt+|JFCE!ZHm4GXO=OlqPryL2V0_7$l4ul)zSYykLd?WxIlKMc3DW-Mv0MBX0 zxusO8)5ov377QCY_bJcOo<9cilmhrFm2G#W8w?2xF@Op3 zb;r{IpC4f0Nr3Vz&-z!sS8bXAB^^ch);JxAxI3C90m^AAN-LzYs#3xRgh^=sP+R|$ z5ZS(J+P=rl-8PqVY?d@%;G5ZOXit-oks+|`LwOZDEY_&Npc`{N+2%bQ zP|7g*P+OLjrQI58YE6a|6vM|jckWynKYqNc9GfRrdpG4y`MLSBbLUPgpa*q1Y~(O& z8Vn!j<2IS6IAxpv2qiTaDlS;>$?W6VMuyI24h19>X+*Q!@#GS~Fg|hogt8p%w7Ok- zi9!)dtt6~m5NJR}Nqs9-31h~OF%pMI?X#}g_vG?_X78jf3T{m3wdf@Wts11#(6ga1 z$%VS3c@iLWPT_Zm7KW2Q9vVB;+K63I!t|oTA}b!plXOS(B*0vyHhABjeP(?lTew6I zC`am%tRq&i-@GHb?-MvUlHJ z*|KGeIUCS`B4saKR7PwaYrpwM0kYA zAZ71R_77M;V7+ih^CW=x0<-_9Q6sgFUxJ0K;WvdQjSd3z@AEZLar3UYb-bG*dgklJ zs*BQpV1G$TNwIDg5O-H!sx}6h)^R5-=PC*FL1CA3T#3=U^|US_;o;%N%W52>+8~-{ z%OSzqAJQF9Bmu}6=!^oNtAB5QixA;8!sAQ#6}WI`OrK%hg?8@TAt!TA8nq{%d06Db zRgO<2`e*khHXFb|Sch2TcS7z6-4UQsiin6XZ^tDKcshBLPlUFQFLDeer6tm&-i&`)>9C0E5uY5!S=Q;U9az z&FeQ!aYB^tD#s_AE6h>C`_rdSmu{W9NkL(O)w$z+)2IOY%Y@hjiH(g_-qtFO&=nck z|JACi#(?y&v$)FfVUqFH>k7odqJfB)vJ+^kAku}QzOb~=cps-sovJmLeSLKWZT`3< z=FjHk%em5XR?0JU=uqRbZ1XqngBt|-2dbN}H5T~k+|w4C3hNhUuaP^4FV(d>o?Q6U zT$4(PjgPek&)c?dld%3_MnqmvTp$5~0Vd-oKcf3ij0|{gA-X4YsCyWW!^7`h zNVU5f&OQ8l7>yvr^!)8%!&QzClZ+2vcL;kyrqR2O2D5ZW*t~VKfl0{gfUJB}ve<{0 z*QyVV6;3OnQ`%;VZVj=~v4&P{)i?D5FaDZ#L!lQRT@z?bJScpSb!Rwr@|0ws%9f!1 zL1vM=DBvf5NEjNhbJ431;215gVCkZx1>r%O83P<~$CFEdbq~or9cajt6D8s`@{y3u z*WU8rIQSi>1P2AO^hXU>IX+4{KKdKslfXWKa$~AV?hp4#00l`qCp^ZmQ1!yQbddDJ3eM5a6<`pW!{K`0f!pyf?3sj8YwK$* z+5rhXon2@l$9x^GO{y33^srD3QCLZRB&gBD6` z7>*|hV2rRdXutyp4p@YPc2U=>uiNVb2Mv5EprNJ9bK?=n}e)>mBIVvkF<#^6PvfL4R*ogLSWl81>0edg4Jh9u{%a zIm-NO3VBYOFB+@^Xv8aI?-&|ARHCD!t>HCFvi3%;_1sLReY|IpFY zAKcd-F9DL~Sx2(u+_`fS(5JWNwfq`B#KwK;!X?Q_%aF7~Y1SZ=hs7d*xu<7$?E|O1 z;y|qd&S7E<8#YX)PM>N8tiP7sq2WSW*$?Enu=28wXW8VYjhHu@3_0bV&Xt4v4;ql^ zhSoRrQDcK%bGl}f2te77bmQ(7&`V+yVhzFes0Gl<#Pigb3kdAkvEy>Syh7+jNI8c0 zxS}2)jhSg=O$Zg{s9yfPOs)ZHV9=t8Ccn9Pxfb1E!vW|tIDBxs^~^DRK|@kkOX>=g zq%|YHCs-8c=~JgA?Z6>>4-LWl_U-GTsnog3TrMsuwnzt_IbLM)m}G1GOkT1*4MLq+ znORnLMF*v>e!sM%VlRc* zf4P3`x;-n5Kbp`_o;q2=28KOy?z#*)&6t5aBv58NND9uW{o1y5o7L65|Ka;GBw~mi zjSaq}phPzOyg@c@*(et-U9jGcQzlQ5MT-_S@V(Ocnvm5cb@f>cAOh){-rjPJjt73N z=9+;L)~;PEMa4z(H^2KEnKWsV$phKbVV=6MRX?oKjsBP=)gvP#WzoV#GGk_n%DAtE zORiqKrs0)33r(@fx5wekRf?l&ybIaHhV>gHE;>%$eeYcf9S~|_!Gi&~v~|l?S-)Yu zA$$QWuz4(5v_yu*53`2LHP>q_H%6!XZrV$4fHIKKehEXbJq=iGP-->mJ(p^y`YoHZ zt}geCyt?RBnK5IAbnn^S#9^EL(JcA;>#t2gBIo{t`pd$F3neu*Rf2i)3Pd}6{>(;HaIrWeK_>U6O-&4kd+)7JJW%K6EvVPNgQ*bD} z31cV7>q}mfxMA@PEdhBidjzBvem(s>b&aYt`MvUdrR}rKSCl4o<&WEE+tx-(M?Jd7)A^Y}g=c)~zuF)#OQ&bs?3?_HElOY5eZH?@DA; zq(S7#E!>ILSb>hmJ*;1O`7QI~YH<^mD$XyKtLf`9M@AARtVB#cP#$WKeT@ZRy_i6S|JHiQEPtDLo46T>1= zUVnGq*Z8}u92-mIQNOFu2~V9XJ|`uGB|?~l2MNH&3H@QIAJ0B6dk*d~>*cL?-ZDgL zwifn&|K0bJb}&s6;u6ey!QCh1*U9Ot^{8{V;lH8yDlb)9KI=l|1?#+yp}-g65*89h z$^L`;B`+^e#*7^!Z@>Arm1k_;v{~>pckkM5`5MA~W@J3UgB%c!JLHdouD zQOueKd{|amW}#FRB{^Agh7N{+eE~;g_nzGbw0UFk8|HNv78RP24AafX5hEo$I{bb_ z`a{;fw^8`G=gi+-<@h90y7wLwS#QlP#%W(j$gBhU2AEZTN3;`&T8j)qr6;pbYK;4u zj8iU8@-hPl43u74no*)*n6*Ey6<9Em#w3YZeC;sr?>og~wyO|u*#Wd>8GO|iKOU*-4-;|1mD z4$+WuH!~JSCyy3n8Wv+4PoGU*kxw*N<={sxoEE$zN%8chpw*BzxGzrezOj&i(p zztlWwc)r^z3(YLZlP>#rI(11aPAS)^< zvfLs$2`o%Pga8%@6B2>~xPTSd;cf@poCXgXY+-9k3qWML%Fz=#f;KNP(O=>;92(d+ zP;yS@*v11WfdO4%d3m`-KQQ2^uVe5$kST`X`Ag@e>Z;CFci83&@C&x3u&^+xj;+?* zV~t$ga?wK2%vJUQJWC=WFbjEO2zVak9nTh=wQd}g$+T15XtM03K(FD6!!^a^;p@d< zV6ET1OP6;$UHxnmx^?@OD^srtWph=HVgPhE{c25yDlU()#t%9#S^pr> zt&UEkP0ql$?xF3zI_hh;>Xe;D<=>tMYZkgUtH_pN#)!(6jT~!}+DI0YJ06q(VgEWMnLrUDQ+{^_wRIitcnlEdHNM*h zrEjyjs$T*-ovV&iJaVGGk@f98 zETy6{v`B|%OKAAB%~|y@&C`VG#!Jo(Z~B!#xI6Sy3J~Q+0-jA9tHrT)tii5YL|3j} zG1Q+aP(26lA?ZwiK`f=tURKakUP9aam@~j4n@ZwRg*Wex`z7G_TwsIp_ni#x?d3yQEWivv&YxnLyay$Qx zsitD}7{h9K=o)9P;t{c-8-MbRng$`!-Gne8-zh2R-0{Ie_l7sSKQu%?YOmEA_cY}( z45D*@&5WH%6(f0I=J>N7?oRS+B&voEmJ18P*>JjRZgKFC!Ip!7006cY9wy(9W*(KQ zYgLw14%K=lcRVNotZ%cxbt88|C4>k2YmSGUE%}LoNca$&yA-mYJ#*IbJ><;kD_CApZhr?P<&GvKpmUUUk1?U& zY}j1Yk^%DKkSQF?JSNrE)wUm;&DFVkG}9Ulgoj5o)aNyE#?;Z(Yydh6K8o*8ao!}9U)c&j^MvgEf>$0WG zte79*&W6n!q-Q`+nK*Hx0i+yk$Fr2Ds~n$Jn(A{y!3EPopWc0}K8HiGk;e>;k-4+y z8WNCB8@u;uosK5yL;8luyt(rvL7VY5#l!lvm(rF#2W=hA^muqXlxk!h%alV04_O@89|hzytG`1Wc2FY%jAXE$iVxls=6Ylm8m5CNV*gj7m9y(e@PylY!Q!s z{rj0W^pHch>zB!Q=bXqfLI8M?DerRfv&>a$Z};xmYb;I>>BG`O^aG|Lx7_HLsY8Uw z(oUK#p-f}y%&86apUh8c$Fp^x%}7hPT5-63DFGQhMr%zq-GUPJ#c-A5Q%aSG286iw zdaXf<;Z!6M?>z{+Qp|q!+EwxI;cqp0SV-=8xCB@zB-;sB;k^K|0p#Eea=iQ5*nZTX^;7$KgV1o{C`XL0Y4?4fGpd4t};I{_O7V$LF9{d{E0?RK z;A}qdWApF{iMhj-Kuec^n{#aGPsqJKR|2hA0&oo<){Y<>H*S>3m`E8gXn?rNu@yhi zc690Y#{t{Xjk~w%O2CzXZzTZgklZodD*&Ytvh`&c%(r*r9=*Luz*Uaz?TNeh>q_7` zNuWyeLjcz3cuxy55XcTv_BmaGdm2{)Pb~pAtoqcVb3f=xzy}gg@C-mM0361N+C>ZZ zz4$pfBj{5AHq?Z6>Z+yv%|Pop^^Pz%;l_8{AeHRe-xZ!bD1pOrJS%728%gQC|NS2(=J#8)5rcIeKekJVN*`p+%$a7czl;`}P?rJUuo+7ju4kaY6@n?D#QAiM8%; zw2ab1Z-~#`;Yy$-Nx=0SThh~Tuch5f0Od$M;-CKXCnJjZ{jJ{{`;XK24^Qp9HiU*; zf)-uB>HZr}LHQGCH_BwroIWEfe^_ZXjnsz@Pe_#Lr;vKBw!7k3X&Grkn>Lgpgxe4| z(4&v?rGkP2D_?*}o(8qR^I?UluBw(zn>NYCDo-1-sHjL+IX=ZRa6jT(3AoD9xAJw5 z?nA4}HINZe5mxjLA%+p|!*rrW+`*b#tWk1p z+A=}yXU%`l<{GEy$i$IC!F=V#O4+h?i_xh$gwl_@e)sRL1fHh^T;=#YrR|=}mB8a9 zpkY&TaG{~0rf3Qa3uVieEfNzGBZMb$5K&O%BfE9+^uj}NJqZfb$rJYM-ctsK4U`ch zMhFdOZ(P5j1OeBLK%cf&ph_WO;2J2luDMoYsMFfIS_$nRYFw)*LAtNQBYIcErF6C8 zy10%mow`^~G;~0yGDTgsM$|O=Wk8=685wB}fgz1Y0i(3t;Yy&TNx)T(E$xZ8*VC>g zKwggCcEQ2HM&X9{btd}-pb{RfbF48n0b9^lzQ+efGr>a+O^=F7OTAxc1rr8bV-O$ zu#PbRXwsF-67MuBDoR2^LgakKdCASqHDC=MQ_|`TyHH+n+YeD2$&$OMz0QFSxXW zQPN;tATcILfNH`F0cSQe`@0tZj>T_F{4SejpB57x(SVNagH+<6b1$@%H$B&(4{NY} z+ERFY60W-e%JX&}exWLq4UYBm#<`QZcgSG=H=lJ59RJRcde)9R-qu7 zCZ}_;9tlyb9ats-oc)fcgmIufpm`LUzcU+ z`y~s`S(yLa+DLV1ej~g<^B!HUd2$zmeh_qnHAr}lh>%4p1zN35PEATCn~}|zo01+$ zn`lnWObK!o3!4QQx-ulC-I98J+Q0CW17Zl<)+E?&zXiAVls0)93A9Rp;@B!N9!~=2 zNC3hC@jB24f@2P~8$t3)QgWZ`&t=}X9{6-o39DcS^~3J<(X4CE_f8;n>C{AlMuv;5P#F9R2o+@O~~l0i;p9*?uF% za?!*JQK?9)SX^Ax-hsPv=j%I`S}{F6ttk}h396?D5yPW8H?bDTT0#WDE0&59&|Z%y zTZe)EdhkvI9lA~TW0d#HvR&NPsMEdn(=SvH9nrOm^BW2Hi~v1HpS>WwoeNGt9Wpd= z?G5)zPpC(OZr*-=Ma1ar?5xa8&sd#Oc#ROR7h8YJ(5Yp^3|)2e8A+=;1M9hgcDhIM>C*wk=tM0mVv~845kJp8tK>07r)5L?<dri2Ud%!k)LClw)RX?$&`7o&78|) zNWe=1Tyyl2Hf@nW69gbU@aXCZkh9-8#->PB^i&zm)2n9!Q<<1{9U308V3_5fmL>m3 z-VVn#5!h30)3M`hvtt_ETRq#(c8KHZZ>zGlwq|RbR|l`!PiH@Wl7L?b&~x<5E5Z99 zfm0BGr-%quRGUG|D7OJ|!xZYxTQ_BVY+T-rXtf=!;R;dpVqkp{d6Foge(TFy=INsN zdAKj^g?ZW_ftCnR99zQ0gGsFp^VZHOtYCD8H5{byf z-oB+`NuK}pTnaA=$6|=;I+q77OaDNB+tqA*4}mvG0_Q-0;&={Fc}WuRnt&AyNBgSE zK=8}S)C^}If06(RG$ufCY|My9kN^pg00~?$0`7@X7YqjfToNDw5+DH*00D|4{|`uj u1W14cNZ9`z^}0$<})pY`ynhw{C0Eg@_V8Iw6SOyRG+Lf`o`JS|oZeA$l(%dWp_i zzVF=Mx%d2a|JcuZu+}oo`OY!lcZ~6h($rAG#-PAJLPElZE6ZymA%RkW4-y0o_>P3g zogHvNcGp&tMXDa9+6BHqcTqNUM?xYcc={mQwhbGP+*K`?;t&#M8IErmd(% zxe|_;Z%le2!{| zmgko)?|rRp4!bk?$J#$^i#lhuh=Ae)=~p5DbMb(grFl6jDD+&qF8u!g{wN-%j;~BO z7@cLZxg+|2J%%4-xDo#4IkM7sd>1g)|Gore%6v!P8ZOxW{Xeh&&l`2=RzqtEFjoH0 zolg&Bkb`qHN3q`e$Nj&@6AxnqX|S*t9%KLid^OL9tu$xg_rXHsVAocZi~Q4<&$6u2 z1|1wP?zP$;|E~d1kbnr8HR?MbZa$ey>PiMsKpt}3NA1o=#lMX3_EBBj*|pvN_Yo*C zW(>>~H!uYe$hqUXERI@o-a6Y+$i3>Nw{L?^nc7#zw3k0-jO;n>CyErj-wl3Pdzw`k zHJ*!X<}9!&YxVirETsz&9jMiJe2f5RsR z?{=)tbi4L?FWS9j4|u$9I$2cqwVuD($q#tzxa1~l`0D)L_y5dec{-%+-@N_5u4go} zCGcd>*KS4@0^WXNOTu-b72mTtr`7{&^(+C_UH8fSuNHmts@(0C*^Z5woDILUQ}3@2 znpXA?TaOy0AFh682|GK9@7II~+Rt#{$yJ9CDZUZ8Ty!@u=|ck(OW!`D@g28)7NlI= z{%^i<{_Ur^)}s#lPoHa5s*K%pG||ZJ6X?gi@FMFbde6E`y|t}xw+fb6My76GKMy*U zU;XyCx{f*DcT#BC%i`~NVTj+=T7>76x-jZ`{Xyfxd^CHt?U?jqTl>{|OygQO<)}bm z?EKibA|yj9v3KRU?}Nmb`@a=l@pY%I6nx&7qd9Z2@bB;QAfHeq%Or?}^(Q9`?tM~W@6*i! z(ehn0i&8s-*Y?D zX6CIdB*@ZNVQApO7WS&)tse6@)c;GzO=Yh8sAwU#`-q@{E$+caq7t>8TsYQOUW?w@ z^%!oaY^QG(9=nr0Brna77o0oq_fvE<(6f|!edYrLPt|N0Z!iAZw12q7K@J|1yv%8E zTxhJ#M@#^Jap&oCt?ZK_bSuW#jx~sYFPJBw-fpT_-^h+JCPe3Fz}}<;RO_ED)@f-4 z%ZSbuuukD&urDUGQX|_!7@KJL05vC@g(#T7&^ps9c#QcsLLvA8p#>ro z9TRa{Y~~>`mr`1Y3i$K<{UY!4%#z&Vcrmv6C?TSXk*lpxKG=4^|Gus^liV$R5GjF zdyXYF<8Yb~z0Zg)FUh^!?V^8@Feh8P=;XIsZvvcerZcUxv!e~=^L>q)!ya%kZQyx#(zjrdAV~r;j*JY?z<;d{d*Rq`(3nqR^di_+ z>hbQ(Y;@V~V=m}xC`&C~q6uLT9sz#Gh|ogll!Ys1Bv01hQRk!7)qBM^S#wM~+>Ntu zGFxq~=FqpWpr?fYvxI1&fsjoqZMPBD%T~iR7VJRH2XRL4GFgAsE7c-m28A(+vtdGI z@{T0PL;96T(fuclaiKRPFYHO6MOVrMsp{YIw$e?dz|UlmHd+=*>pa!Lvhdpy=|Q65 zrFw+`XbrEG_O>_w*>&gp>`eVT3IH2zi6A^=bgsR_LLsCmq;*DUY-pby_%Cd0*L=~o zMHaRxsxRkf3U=2aM99c?C$wgd4^6GT(m8Yb2u9jZmMdWALMyoycT0&{Ov`8^h5K-?i90paNj**fYP~b0GlOh4FDbv!0l$egrG*{$g5-u@v(s*AdSlayzqq{5`@LTSGln*~Ud^NS z%qbq>a{HX1-RCGp83rP`K7!tWa z_LVtb-h@6CCAo9w?O`iV8DBhKV{hn233D{aP=4GgNs+}rzRyt3cuZsi>%(5f$KW~2 z0~@ZO?jqNb8I5XtivAa@zc;S^f%WMp1>s5e)8dB%i0np&=SsHXe|r$J8zB>`OG@>3 zr89txtVI}Q%du%me-0Z>X3`9ihT^y-^Xxeh+Do+Yd5kD8=*Qdrx)&zu!VL!z`A3jn z%wTJsu#UL+FE1oV15C-sin^n?Lz7%t-aft&D`>_&^OPX@vh;q%FK#P>#=j;(>V|~@ z$}G$P|5=CH?$EN8)|;e09+>1H$!RN>S;KFqC^t~jYS9-DP09}40i*NwCYchj3r3G0GQsb+hB<;P*!gH*CFH5d<-T>r3x-m!{LYpk~ z5sVreSnsgvvEoaQ-9wFNSm^2VtSzgwO;CS1$cVd%m}@;8bdaBU<7=-f5+hkbJ(tg92Z zBgQh8(7Rq0 zCNIw&|C6}Tfns0F+v~7K*uL$hJB7B^7PyGpGF%UEqeGo>|wxHhWa zO5dOBY*j(K@O0+oUdeRYa_5Cu!Zrke)Odu=&wVc z$@_5BF1%1kaX{}9Sy1E~ML6gS-8~Qi#X*qOMmAMLQh0wdyK*sL%MQS>24bT8c;{ey zwDt%wW$FhQM`De+$&b6xZMV(-#2^8;B_LxV?BATT$$zf4o8e#Gb~8ybsH-NMkn;N+nN12h(vX{F)(DldsDvduAbq$|tnZqAH>vf;bZr~ssBtoXEhFaOl zhW^9*f%-M%eB?8X1pRZ+U7=oy`W+Lw3pBG>F%E+Qu1sCQLmQrha^edNLiX321ZqhT zaw%?x$?=xVZRB>X{qJfSIT73O0vFtPi$U{7jof))l?Cg6Hi#4uu7+?kgYn)(Cv5v& zE|F4=yP8FatYe}=mn@UjgFClKO?~mLFD0IheUAy56T4_~_54Vak@40(>EjE?7*#_- zqKMq*lQ2+>F+42!)BP79B2oyD9}LJ>$dq{T`I$a<-0V%MhpNtXy0takYNl;8t^2uw z_mDwLt?zL=lCat`+9%Lt%_?kS&=7%?Y9rvGf}n12oM`r)BSJb}K_(lLxhbY?S)jG( z+V}imH3S!j>0J>s5S}*$6Ww=lqGBrNbD<8h>*Er#@)Ha&wHFd6@*!;m*zh^t!ywQ4 zhDj=gLT9|OA?{9zjKc}dH@*3WeB=ukPYCks1^A6;^lQ&KMm$xfHgJ9Sfcd>|<&S?p z+j>M{2kA|Rz%p6IBh72v;Xs`-LV5g({eG&+pT1V68Qr`R;~VO8CKy>KEB!@Fk$6@F zqvF+}w>=u)FBIK04wcD4rjF`RUkiB{$NdLI7*hR(f9Sf0vxk!3*NsVG_Cd>RU!YT{ z>;x^CgLoi zJ2Gq&Ig`?AOC?i*$4OVhIy~M=+87la<&jh|P||af*DaYw0omPR-p(PI{f<3%>v)QRZTy3{O@nV3UbsQ)hCg(k{njQ2g$T5f5Ra- zHvtmupb|G%E*%{o>FrBptdkE#NvI{lc|X5qxO2TLCkn89_$`<8iosAm`1ODB?g-M1 zYvuQd*8Ug|!vV9EKrJ%|jdqzaptiKGx_xTur4Tyk1k(CWWC4B&fyQ6EhiF^62@>nU z*YB6CfYiJZD4lp1lp@O46QVqMIWwB@BQ1#f=@{^_S)~#(Dxsgxw{}0~<5;F`Txl!= zK?Dt8{9U4csP&0_fn%29wA_DSVCu88sg7kL>)U}8*5yr!w?4Lnu-OaD8C2)lr(!)w zmR8dXyHpKs9>^ho)UN)t9C3mDzd4MoiM_K*1Ho2vR_WNGd|9b*yc{6CgvLZX_sn?h z(uF#Oy3u_mb+sCTSO0UzmcoYeQ7N>5`i>SFr@Ik^R14#nQwn~gwv|G(0AQA!8Sb=i zI4%t}U5gz}r`ipuBFt?4k{mTzSoM4=_V%n}`vYwOM5m)t7wi@#l+Mu4{>6cbW9xgS zuRcS^>{s*}OMEzq&gh5qHktn%1gAl;H6>>3^TD58lu(-c3!$f+B^*+(1ykkEOoFCt z=;53^!>^FNI@EfI`SbRU8cvvE2*P)S?uM2_hs3h-rxIis7_S-NTPTITK!x?$eP^@_ z`jDi`g>H%WBZ4HwQ{T`kRdXn<;JG#^@hTnSIEiNN))#OJ{)Wr4UEGf;4R@cpon(dB(WxHY44!J^`VWDmaBblIQi~9BH6vP+I2P50$QEn6C_R z7HY}1_jPvEc+x(Nm)K!=h5jT=S%R!fxPNC=c;UJ7|QwWrc6D?5ibVKN0$m zDG%GaTqTzmWr#+Uq`o9pTQ);C^i6(s*oHTr;_x>3K1Kc*h0!XhzhSnvB9f~mq4Ef0 zB^Q*Ra>Qb&Eh_P;b38%piHOpq0%ORrlYA^=iiaWN7qF?vmOrRUy${10W?i)qSS;gh8X^_IQz+G`)K`W7^8I4MG+miI z5PlnT%*;*)vW)$HkBX_HX3;A}a#xPIrz#n;6YE!u%fAs!m>;r0bY=()nb(#7Wf}U` zzlH46h>W+DBSNv_I6UNyzMt)aNvy%6_iiLFnccc4)MwD#5WZh{8ba| zzqEN$`t7CK&)%QfOlci`#+`OZnshFbn3)`Sc?s?VPBLtQjZ+7uU%veHG>2FWF$JZu?1<8#*rDRw;GpePX*-zPL^I-eYpsWK{2g^M>qL2}ITUq%97PU2jr zJ}QgG!*A9qi-%=Le792V;#LXYi4BbL**vvOJmLgrAmr54+EOn;=R!;GrdHGMA8wBp zfV7NyGQO&QQboa=39<^*L*@X5^nyh%W=ypEy&$Sql4n&*@F~QJ!GL>5dpXS__Nf2r zWaA*{8MWqmB(p5snC~qtT3SEtx!cVX(FBb==_Y)EH9d%NqS-^A5^%pYpD61avRp=w zKna>tklog;?wR{aR@0oq45GMl{L(&*hD95orAJeo&ycmn@PI(xo zJ=a}L#ew*4fN*fqY$j`n4TyQ}lT9WhN;w>_c0o12q%W$Bt0cwmpHIEO%^G}5`DshW zZG(V?tf6Rk2%2D%=WWe03NQ)Gvp0XgIO9s+)qGWVSqC87Cf&rxuAE6xKL&uw-+7Z> zuu6gcP0^hk!u~&Lr$bT(nY8^$K?s~U&!GEk8q%O)l{>}L*6)lW-Bs~*m+W(Zw3L0TjV7xis z)qykZ((dR~#qPA<|67n_YkVti5)q=o@)s%3bnic~VS)#<5A4;-3Pt>(l7_qK5`@x^ z1UneQ?Rsqqn2+&K(dTqg>E=3zjhZ~w-FkNtkP75$?WrOkzOmyL0D^Gs9#?8V6MZz zkH2Rd60___6lj%7o-PR4O)_Nc^4b-fZ*^o0)NPS6;d1xTH{)(LXs(CWYWDlIK2ak` z5f{Vco<6kk@V2?WByT5_uu`Xl9#zE$$!AvxXHq{KpmCrxZEI=P#L}!$6mKMn=RM^D;NQ09jW5Oi7kLn47U8)N`eM zPb{-T&H5XnN!yC$U@N@`{7|l<`vON5mAL<8X#Y>~NaO5}^RkL>%S}{4Sm3fq&E=we ztsY#lam|-Vdg_8l-&{x~b@0&{Hz>hJ01JUx=2(ztU?|Aai?mCB9KmKX4Oe@e0%w@| z%@gj_alI{rIUqvC9?+Ab6#EIh+`VVIYd_cf-VNZR#ujsbk6~|pOfk@G<9*6u;*n6u zHTJJSiT)vzkyybZQST4t1x1qNSWeV`_?`h|WJI}~^#NA+6`E+_aC}wU$%xQ=zeBQm zZ9a_P9iLUXb&KSEJ)BrOwUvN>#{NrY5%%ym5B_8(dfn-P<)kCWO~|TAoZXdpVofyK z50LeAodCCS8+_ChD@&nQY;dfoP@b@P$#WrWK=2{vN_Iv*BgKGuVm_JNWAq-M=_Gb+ zQ95aOZ=SvTE83|J8(08Xx7F-K;e!y$bNpm^<=z~}&l8HW zv?nXx0FQJ4RO}>uhGKQ_#~ej7MPywcnSpJqaJyD#(`0@X)6-;XQ8!E49J@*M z%dz&SuU>Z{z{pLfgL^CLLlceL}xsZmmYBll9`*YK9FKgX;2s*dk=skPqOvQ z2yO516;K}QRUdeSp!odKPGZ{7Q-BhtOnvkCtMZF%HlwGGi7s)&mUkydKP~mXWS*80 z4TT+r7lke4A1<9nPJ*;%weQ>W2>Z+liyLT_qS%{cnN)Ds1V?w4u~WtoFS#rC=uU?f z`*~cy6GXzuw1rmrbq)e9#+ip(@yqm6bpjgz{tr_Cd>-kVL+!Mr0eVi5N35O zijhTfdxCmm4bZFF0hK^sPR5*#M67W5ANI8ru-D2-kkRypIpm4>AjPHKO$3j50R1Lp zJY)u0+h@w}5P<}+>2ORSxLMdTgOa-_Ci^)kJB$CAUIStbYLXa0>bv9^J76Wf7QQ}4AurI%;_j-=8#PEtUwP>ivr@Q0MCf*0dWp((|B*j@~xL&$BYKcSy)Na21I}lO#6mmjWH>^fU=(|6mPwEpUjaCg)B?ndI4)j_k-E7 zrO+r+f8aoYde5`^=vMY`nR8-wzGzn+SLiC^3_SgEOz^%ghk!t~A)XCpS_t&!&MVUk z8jW~qy^i;r{Yx9);?CXK7_O8WLSC80af+GbYK;sQu0-%*fYU zywYq-&9&ojnP)O&0lG>S`u9K#giVFq|2%QQ7CfPu#1v^%e}&9Tt22#!Kzm`GxmJuU zZxN+WNQn24Rwek#T0frYG|RsFD?l@i%{SPS-i48M-5O-m63DCwymLqVjNF{k`(pJlRz+B-~Ewf+G;cz${9&u*$@PxY{`$*Amj_dU8}XX8h*1Ov0u z%qjTj|4ARK@B?dPPRF^lO|bY0Ht{+c>eHUcB7RF{sI?=TmR9dB(G~@~ps7dMz&29W{ehxkR7y$CrjaSDqNhBq#%!6%;r8xeInT(g1?EVMO zGVoXgPH4qoB>l+YJ4EJY+*gKpxtGQnvwV3(+GMTA)1OsAr^W*#m~+nap0b9vq3wPE zqf8$-M`@}|HRy`LtcPZ#RMa{_O^1~PlpGKWg?r|voY?fkA(-Tf@}{D=?tmGU|_Tfi4h`Zm)}hFx!8p8B*&k_d^k z+au>J{ET0ufz)Hi4fNxG@Xg$!Qo(dl_Be!Q!KN;q1A_hnp5udy8*N_$Bp>eLVb}C9 zJ6@2X3#?BqgbC5r1kmwQ9(fk>?>9Ew4_kJ^yRwjd6#b(S{q-f%#RKv@6(27@jwLK0 zhW{ATT=sY{6r8xXn+}D3!Rljr_L;%C)EM3JcmBiI^5&_J3Gk(C`QVR{H|NYZ%t{3( z&_Gq(YQd|}5-OJ&U`=hSC!ufd+wX79EWupmLxJ`M=6Ou`C%y13jJq zk%{Im+!33C^RtOJNfd3*A;iOnX2F(`-n$z&+AkyGjg#OEuNWmK3TE&%hBV!10+Z{% zGts=U9W+K;_To+k^s!RAidfK&Ohsb|Q*!8^K~o#ujgy>I>^550jaBkS?F1 z;4JT(?bQJvz1|eTzoH#e{~>&GAh7<(dL~%JTYOvg0j*4uBKoNE?!~x*3WhjT{J4qD z5#GV{d#b5rHT%FWs(hvTya@yTtgi_vG_+vCx?8{&KvG|_`Rb=Ip$_qZd3c12=k6pU z2SRK31hTLw?Vsm46yEd$T>XwtB{m&=R1)HPtjAb|K0mnN#IHc7oBGbdOZkdW6x5*j zeZX>r)*ahw#O1W^X|^c9$L1we^b=vfu9%(~8I2P-)r|;sy^}98xno8ThiclyPTt{_ zV)HU0BDyzAC{-}!Prvq2V{V`PO>uS&Bi4sp7PEmJlf}6dZHpNh-y2gZ@Fu@}e%f-> zacgw6+%A{s z1p1$AtzPjJ=`qNN{!RozIFU+{Aqw>|TC*#adY=&N@plgLmdVkPe@^SoM#FWrAF!$z zY9|yaD^%9Hx*nr+VUX@r_X>D?AU8v@M+m9fYIGZJmzaUE`KhS#ppXWpk9Is`vU4!& z;NWJy*`Sa!hNI(g%@qnjgTR*X0YddXRy(RvK>-BzuDm9YDZabm*Sj9`wncCpjejCX z3&SfS!A%4sr=44$ko6IH!^j0QGe$S$Z~XRchKQxht*4jms+G*Ih zY30svd9a4x-6?GfW-hHh)}F(B zMsXR-kyv_4{x^Eo4-Boi6)i*7BNZzb^bLD(y5v}$P4eq17TM?C~T`59yJpj5z zCm{LmoDOm03Ny7+bXyef9fDwNsrGjP%k9ZH2 z)Vn{L9{_pb;P@wQQ^SmrsW`=p*df+Nsk-B z`?~#$Yq002_?h6`45lU(-5Xi}uvo<)O}7BHj4HE}uDD2aj_#O~RW(BPEf71i?{R<;wvHBgQL6vkjpR4_}yV_C^7*+Nty(}y0Y8G8IcR*1GoEK72Z}{;-XGe`_B1dFkACs8W=h8j1 z)5G`6KkL5@d7c`D26*zrD*&J6_Dhi7xzxlfRrbJ{u^hKVds`?Kn&hLW2CNW^1^7@a zivxqY`+M)0)GfzVQF6A>H_Z0xl1IxK+CN`2LX(QH0CLQwnR^iF^zwn#fG`D|5*W)m z2e3$lku=i-EJVm_C29<;6a6Q*5f8!}%`f7YE>pVJ00kU7G}*Wlp*{+@%Wgp=x}?Q> zWQOuNnq~fNf%x_}Wu6hBBkYOLG=IevCt%@aiZHOjyxBZM);x2%6|a@aI=)usAQmaz zAzhqYTOmlH1n~)JwLhaV#^2mUo$}&%4C3DPD{2&BZ&DXd%&xf0m4JYk9a=K3m=O9I8Y)d$VwM2ax9|&5EA7U! zj`JKjR-(QAe31*1?mU%}_Z*T$;z0~hrvp=!O==qsAFC!5LY zcHm)M9mx{HXd`!ptZ){WK_P9Dvp|&1b5^u{ZBGc#K=((kczmnhU77oM8+7wcd%Y5B z3tHooYfPkqJ`VK8G^!1~?i&=G+pHgR2qLL1s~YNaY;XE&z8-%2J2NkjW4_r6vyTp7 zHWdGZ%jbW0#iL)F>(6u(XNDFa>%QSRhpML8DqPrzBV#||1+A-~J?;InmTJ!lM)UvI`vYkeFsBNv^K_F5Q6U8cn22v@s6#WM{RXejCPiIrd4kEg0S--0Zm{e7hl zc;9ypk?{ej_(Uc+$C?O*P@@4|O9{mGz)Z1e1qppGy^v_tlijaS%T5n&)uxW$Ia7X6`p zCfYAidduZnTOT8uV0fukfUx{5>}pOSAxk}@L`||*f}25=%DB$5Xr(x3B#B6luVL<> z>63djbyk^S;+cMulQMp3;h@IlAxTk>>Wq1(D+Tfc4V)hhYRB^9B`7gwzFk(zp#F2g z(odo|cqVG{*^~L>jvGBm6maZ?bXqlb;HibIFi2%zxxYD#2dttVZ)9q|!SLMCnQlbF z%jmy}N*_kB$T}F5_ZlI-1mnkrYi{4j`gYQ5(%_k)p;vTEhj$fr;K6GY>IShMZ1s$~ z?t;C;b|O(sC<1c&Gwq6_dL(}GTZF$!Qy-s*4L#$PHc$M{j834Dbm`WE$$pxIneA9C zlD200XSe1Ze4wcSvJo5&el(KjL#V|4T4Bo_ZwN`XRv!EwGCy>~5oa|K?CysAg2?M= z8SVpBX1w@bs*W3My_Njp*RDNr*@F`SC)YtdV4_AshB}+`LSFLbWt=dq1o83j2^%Ru zC}omuDKm!&u+Yi7le(Kz;q&ARWC_RK-FNZ-5dQ8a0-gN3)f)Vw#s022jkM*yowg;{ z)%JYhGbIPcJ0gX{VX;T=!GmCAG!f9)MOO@Vbw3NqN0DmhXp#`Tc3!~mCj`x*B})jt9=G-~=cNTKLdk1Vws$4bla{_65L=x!`r)#AzD>Su}O`6e)l37KkWx>ZabP8XYa zm;c-Ivs&`rxhI$LakizlT7}%A1B=IOi~A1VK^$w&Sga(T{Ab3@EJbY`83w?xO#!mY zfKAyzr0kZjhPx?Mi7>$_mRq|!>poz6+!ZS!L)RYSpWRut?Y0`wt}qhjlrY8Fh4)|z zUeItJIZNhqC3Cd+xo2x4M)LIttnHLodCHjHq@bkDA6R*FlkdC#)mGW1happ}F!`no zrfN<;UMo;tE`R?#LTBABri;4#?&b1+t>lOXX@#%iVPwGitBT7$8on6ZL=W%J0$H6g zgbrV3i%Urd!{zZW%{!G;z1O44%Gq^V_@>i+N6r=1#h{#ZtP!S>IOzeOsEm`(Wfk^| zR@h_$AEn(W74zG}gE1`>#VC7Y^J2~{I^eyTYRN7+cvCn#L6n3`GZ+stA0oFhlkGjQS=DEVYZUcbHVn9rOyY%S3n_LiddU95G}q9 zjI|A#n|_nq%F{WURVhNuzwXmI4NJ{H>DwZ<{OFrqP1@Tkq)G)ZAuxgy&Ti7$)>=H+ zGGyC=CX_(u;-rs;1_W{K=^{<~8Y+FX3cDVjBa@!ryVsVoleFb-S0PWuP z+4Fbf@2rm<{E9k%T`)li)Y-OuD%a)DgpGbvp9XA;Fw}{;WmVk|`)RQ7iTa=}mh>EseDVR4XhD zpsQC&kBLpbE!zm9Hns}97u=Tnu>4noMO31%4ag&}8Uib~03n2uu< z{QJk`r6{*|6EL$u!YRY~Q{&*v2^^d3@MG5Q`w z&Z3}eIizGhrnNnAoYnbS?{7TQ0b{9{=?0x-3q0k>H(WtPvSK#+Ch~HP+svt;Byo3Li8Sf*o34>hnfG(7-O_XZ}O=eD8(FklxlAL~W zD)N0ezC434lRMRTrlb1{>*dez?HIJ+$i8s867s!96M{Lv$G>ow(fmoZtl=&2-?ode zIaZWm{~X)Km2j)mUpF1+Lb}~rU*unT4=^&_zS7%qaUOsF$xxo4x$d_Kyk6ut(7wh9 z3*-%@Bglwib?ldKvKh;haVO(sW&ERWxH9?pYUt+g$*3skf(E%hv}Bq#7?IVGq8Rg# zNL76Jui|4K1y!FbUZ=bzN&us;KW)67Obnc1GYVrn(AX`91?X++5YH$PNl&uS-Rhdi zGnAwloX?1uyk!6Fn3VV4&c^ffpY>}6u55O*zK3zTW@Ya4hxF4H-~Rndn+rq#G%IM9 z8VfE)i^gzu$Gk(n-@`%`uLY6SyB3FAW=8z=Q+Ib)uu2e;j97YQJl)?9<`?SX#*Bgg10B7)^BG7Pyggnh z$NnL(0^P=gjsTt%k4rR>W;~R2=VZ&s+M?{FI;i*8)7o5ipswB6IR|$WdsmkMCXif5(598mY#h zKK|4x(og3xKwi(w`BgKR1EV{MDoLbViIXuz^darnAdp=<%I#rMja1ZxgcGVWPzb#lf)eyOzkgVsYq_tkc zkd#+*UUa10fmb$sQD*6HO$tys83x2P#Yb9o;S4XIRh1eu>GpS=-~Xc)5Cdm?{`Lzi zX!igv*xEY=IAQ=IP#*$An_w}aU9b6xBOY4Pkx_QyH_RmRLyix>TH!3RMlreN)8OTr zjrUJ%Vekq(DJ>Z-RDgzFDIV)@xCRpntr?wDW2D;hhnR%?X$7O9t$M;U;jUlWAJQX#1O4^NgEI_<`o=zb))hPU!Q8@69&`ZAW zcRXzFsr7KbgWw23KkkD6ox|_pdgqz6GTSDeXcP$_=ccKgc$5%f7x@Dq!$GduuGKVg zSq1QXIe}7V2qyImhl*_SO-`xpn@X925eKzNU88|qtEJ9&xT&tjhA(go@=1_2_|Aj0 zubzMCBnsLXE>pwxwlk-bj6Qt;jGv4ZA(`F zrX#)^zBcxF7%v`dh;*dCr`dE{GV;c{izZ2cJkw8x9!>!*`u3hVq7ZE3MR2+<4fny` zTOeqYTh$P-BTSqFy2=nUAwnvgTAz%D{fC9qD-V?Ayray-4IYvc+ACT&vdR-5oD=&$ zuIORA*l~{~X}ehD3fmN2aaxnQuc%g(mVDDlDoi$tWH~PHvX0xmO?#y#g)_M7AH1uC zXyufC@>D7)0lwb}=q05Xs8kLqNiNr+-ajK%m2o2Wx&36>Z5J z(arGyG(v>?N#N>nzX^+~sS6D_Mp1}Xcd|)evdf);V;?h38ZAqzOzHnn2qF(1g6szzGO2^XEShOy%#&;b2+=cSwI7=SIebE3fhnMY5U@;r^J1{RfJOy5?bv&Xb-k)q8R%<>6pV`$aHK;nvR#Q^ZYwwExhvCwz#kITi?;EsC__*R?}!?qj~2h3mc;4`Ba(Qp~nS5eDa(u zfoH|2)ej^yN6>a!tC)t}V%^rnYQ79|ARtmwzI7$tAb0uO#kgx=x3O#BanW9P@ocNh z0PyyyOx4Coiya_dB#%j$7VagA1E!3)D=EOzMT_K04kV<*0~5e8{?kmn+#zp0A3!BsOBZ zaovr$rUu=8iznz|o{>*B_7dXaL6Yvc?^4Pnh77ccx(mU^Nzo1!bT>N$x?Ud_MNBk# zC_>Yu-W|+O{{tGXj@xB?OnpxjvU$v9%Ry;yPoUw}sugI>J@|0X4P!Wwd)&@;{!s_? zw<~L})2nT=o zaw7&R*s|`|(?|AufA7>XZr@DL3p`HgzcvmtOUe5fCg5KeNqAq(^Y@zM<#-m?%PbZ$ z*VhXwgB=ZNOr1Ld9KYUglXJN5UHNV~@G8EV({~`{+{D1p>O38k7bowWS<$o6zE}+j zVANXug=x_4MXE$g2aA8jG`m^(I^g~y4unZ0V>?%CMQf+KPp4q$jQT<5I9h>aphJe3 zr#>cE{5?+U&pf~frul-ZiE*%h*?p|XR;Av*r0(YbEW`$o2YiVnqJcqOdErhrkh}HttV7FfU!XqZ~5PXGY!*G1AM4=R$WB^ zFwieLHqI%2wN(w*u0`|%9n4EC{6j*1OS=9&h~B9e(vr4xfNPMe_4o&-+~ZtR56P=g zsqy!258BC8I$~L4vfma(3O^5g=^1kc50W9H(OWkqNSrEXl=>GTp$_8FU5)UZ_2&Ex z+|_;wHo{o1#&Bx6iJEh)C5U|dr%s@LAFVilO$6cZOtBgvttn_Resxr7m6gr8K*!6U z-e6r*Q!`@xmk)i9(_WF_{8P0GUDuRedOwOvOYh~fD%wgkV3iTYKWKbq7zp^}uhJ$b~}CZ~tS5^cbS(NbCqV2 ziq<*zP)nS2Nc#MB<& zzdj)10lsuecc-*;cc(NGhXzTdLmKIBICLZ3ormrY=|;NY8Gmd2*Ykef%sq40b?yDx zRXz#vrPU1kuk-m1_nAx(-+cSEVy~F1a2XosEVfe-J5KjszX3gAHQ?Wx`{xz$Vy7RS zY;(U-IgMa2w8U{nl)#02_|x0TcWSCA49X|>3-!z>dM@X&h6Lg|V+gX&7k}*yevcXU zIo&(8=RSHbF|Iyl{QrxN-b?t=i9AzXq`U7XYKxWhjJ8Ftl8DK^oGhmpAuXOtO(6#f!+K5t& zp7UXdZjTdfBDiF|sCy9~#f51Uv{a%VgK;&BmdyHF{`wex*}26dPJh-Gb7}U;N{FVm z^DXmqWL{bQ3A*sTj!F0-ft#R(+yAG^+JePEo`4c`o4v&;Y-7|EeLKdNexEJ$R$_W3 zGsFL;e^hjf!K6_!36mzRhA`~F6eFLCDxQylcVte4nH%4TS>rzX=~D1Z)iMp?vnU(j zF77VO6=3T8sr5+PNv4l48-JfXHD=LPET5>+-|k;hw*3Tud=$GB&1OF;;ODz_)01v zD`BH5sd?TWyY!V<@<0M|#DFD<;DDL!aqRqF;0>~JAXLUe?nE&3c+vKwmD+HRQPdz&Y&jXW$~MO zg+vKFe}hycWTy{Pm4JdX#<=d^`R~3hS92y@;xQ$%4VYMi{n=P*N7>2Q5S(v-7P|G_ z+IORaW$Vi)YHPw;54-oyJVI%fYlnYnNCL)~QX#A-v?-`4q1q7ylvEmKCswA9szCt zU34pa<-hcHCQ}DlIH&As{sQ3*>^q~mdL<_goWM?fVP-Ko`<-tESoBCgmjLgRcA zP196koeNcgBRRpxx_^%s+Fi>eSU;U)>lbm^q?>mos z_8&AuB(SmhZ-DwYMsCWNzTb+G@?+?*Aox(h*Nrpg-nnosae4#kY34Qa(3B3FH;Q%l z%IW-IwnQDoCzq{WZbzHYFSdNX4VuM(g|iJ^9Kb6qjGCkBALBBuF#Y~~X^rkjBsR2; zY4M;(v?m33qXw|I2;vjPVLo(#Z~c;#j<)5P zCGRERF4hv_dck;Mw%p2^-VSjP)|~w%ux9<|WSuuW$>+z?(|4mSGAl#vX$QPFy?9gH zR9L6SJrs#4t4n(iY}q_B?&>$AJm0Z4^wjpg#cmjx6J+b%!yS;Ke0r;@aL$ zXjI1;uFlsM^&BV5!?^{cCaxLYy1-A18p9DNSO;eRfI#6-(}-*oe1{)lXecOA#O`Br z3s_>&3j`%J(`9bN{r+oaPMwTLviym{4chxQI`$=!J?Im`6_?G>SDN2DE&2qC)1(z8 zvKTBXmSTuBJ#7X^fN=n6_9ZK-OM$HG1b6=ou=aeCxDf;@{T`$p1{K5UslTzHsW7ck z$z6D@au=?5$KZ1>7R-Y0YrYasG@-V@?MWzlx-WA|hsNk4$4f@VFT6?A><~F@E>DEl z0%Q0|{Vp5Y%@oHc_%~A6ti?!;>O3HGOzM~B&f`-JNoT4hl|{Dt=|OO zE+Th`E03Uy)o)8?V-?#z<9Wmc-O1P-f?~cFa%2kW4q28=CGRWW@Sg6s^Xd7d$K`g( z>b9emy_ha4MlWl!OFWaGB*RG>EV8E1#E&+DsRZzJj|hqHv>zA>rOP+*=zaJ`|PD~oc)&7jOy>`102N@^p zka?&ny)X*FhLmZ|O1~tCktsS`;iH}8v~8Kj)7?m>rDisZi=n#8MZQ=2Oqps$k!qi! zp#%8WGiHA00eAgjv_HFjMR8Xu7$a0x$wpZ*(Asf1%)+7-%g`0eE6ylRw{Bw47->GU zHR4Q)NKYkTLD@76Y>3TCIcQB0iuUHGi+~aRWC^-3w_Vn-ej`A7Au~Yt7bNw*R{a}I zdw>uG>&_0~6Ap4tN9T!N&VW`ZXuNqZ&8DZBN?t78nsbwR zXH!mo#4wKe$Yrg;RuLmdk<2z3Gds_f(2UM-;sctpXGh$iW!^m(J~phWDkcau-8EcgiN+xfLb&y1~O+?xVJzfye7VgdsH z{J?m$zmiWW@a4Znd_g|h&`KGDhMvZappgd*+0E= zxi)QC9JascJ#fs~W6^>t;>vL*{G)e?c#FZzAe7K${n!daKb77fPo2`hd|||2 zT-`BPc5vHG0u$$h2>wC>;^*xA zdR~S51MUZ{*s2oB*#auBp#-O4mr{C%|Eziw#}4nCmAsK0ID*;Yz8&R$M=)} zDdD#on}5HgZ;ye_Iy%BM+a(2x`}*q?fID688Q}~WuvD1Vk<7g>w)BSVPzt5Q=s$|} zXW05Ar{47pW?lXw=6CyVVK7H=xqw(s=2B_XITt9d=f>Q)5&OfD{RJda!9(3enpM1~ zjJ^L|2VyCy%qK*e&$Tk$U$XtE7ETjHnk05`LI902qSnTPcH*bi>>EpmwhCqQIpjVC zm?4CAuF^1XWLGO%J-p6^KHs2$X;Ijo#B|3v_`+=F&7bkyskkPCTB&w0P$(WqhTrSp z#j`haKau1d{9PH#iXo(+xsG><#^3vu0c-ePSYbBSYdoOPDb*a)u7I6Z1BvFFRZxN; z-$j*%h$QHQep9~ba=k-U1D;F=o);75Ctyjy6ida8`b{d2CZ8MR6C;i3>;8!Oq&f41 zx%ktU$}az%=Z|2MFQoux>N@@MipU?6lFjvKHijt~Q$Ixv!WL?5|9K}yJYWM=DCu;i zv8p@^ed5a13jND>D=VTqPMc0!F&auys`|;AvG}2bzh0IK-Bm+c{al{6#I+{LqF0h^$$&wePIbB^ z$eK#*)w(3@beH!yIx1&Sxtp~W@rLo}n+54uFff>)R_D`&ULSwHN*kT{-L3z$eGyPG z#m7)R7R4)O9(fjrCK9~OFlQ#i82CmY${(YUEcFwHMdIc0MxEVnLmZyF&?3OjOJM8; z>;J0vD%_x$Gylhm+0!UQ`$M9iL_3alUcG8!)*#&EX-dCn6Bc1fY^n&RnEZ`gu~GVW zW9#=a-dYSKGSoha6K#xQrHf_GlIz?CKDt?h_yV|lwwM{|kS6l@oxt+ggH@gSO$Yp- zh9S~0Ep~O8ET1bMITh60S*}ESKNpJF-CQ(^fqZOeViWP0Rg;o8HC#JO;r;0A*k2AK zzg01X=I84PD$UC!2FGiaIrCxzM{L12uiqZtpQMQssT2lX&ZcuP$S%{0?VMyN?mwBJ zI1NYo1(!=a%51r1E=Xh@?a~T5YN{VsmhtHkQct;QdR}#Ksn*JforbN-A+s9vyc!Vs zKZbVIL-X#s-k}8&{QmuRFMU=TIGT@YvUj2;jDcQ&=o6QZAHe2AKXOdFU57Q7`D3J$ z!f6BA`)8Lm&TN;Fg}c3w!>EtHPSL2*3m%}+g|C~>Rp6x;S7SGU!FK^ z20lLEM~TQ{nqxhAT%-80(#qCXSlFG`-{I!>_erF)lGMhG;|atMXa@ z5Y^soR5_tiBN1UWIl%>EOE45z*p#d0k3ZNE`CtAkvp@JsulGv*>Pq=!DmKggc?PmU z^{pH@DC9czl$KR4hfZ1jh-Q&9WtRLqzS3`tPd}>UsY0bB5G+D`srh=HUS1O|^ON4m z9eT?rEh@O>ID^;`S;icD5^zE;kyx8Kmhm5=zIq?3Z1#i&=zx71x8aXa%d1g6hu$8F zt0A(&(K0F8*MWh+s+l4ij)tl=QL?Q2*nyX8tYImycuL9ph_az^ep8uW0WH0|^PZZnD`ft{988IO=?J%r!0 zTdqT#3N~nUt5Byh&il~x3)XMvW|^rZ-W!lxFKk3)glU+-WiwUm8dT9SctMsr2-94( zR1}JXGCi{1&})XS)%N=ohgN-MOpcyK#EQJfrDUvVF?(FnQ=b@?zyh+zE-PQZA9a+> zgm;FOCJhr*>P^ULDr{X1xgDZ(Br>IR{!`(Tk!=P}`+@*LDTPSIS!*I?bOMelsBQ^h zVTmiAr}*)ZT)Fm&`E{iTF2t7T5{%@XYnyjX$)dXSax$@8&8COpKU*}HpRX$IU@_;) zzoK`+M{Rf~v&=Pyz5Ne|z_#HE=+XV1#5c>TI*`npLeG?tZwwLp=%wP;uD!imIYGu9 z>n@*bS3HX;Hp%Emuz9cWz+X?ZAyZG{F9Iw-W>4xTFtP5P*yEEUo@p2_7PCj!@ryzo zZg5D4$&Q3Ewoj83yqHG{IzK=8V-^3a%8#N0Re6rUA!R_r9RX8#7Qxa&XT~T~1fl?a z;J9mnrl^$m)%Q#GoFl-cRE7QOuxG8U%?~IjCf(*NDMbU_g*&pA^o&QJuc zSEjOylUe4Vu#;Z5aC=MN^+#6SBGzJS^&qWXL7V=^HGOY?VPw(1K z}<&{sldt0?Lw@NfE=A zkVlpP_ZR17M2w_{OQQnLM}@t=Z)^0mFZOaAbq#LE&v8hqtE}?x%gd3-HxY#8;GAAH z)~N%@h@3PBjEOGQeJ;Z=t>h%zHUrdpj}ql1c%L*2Cw5vO*6?zxC2a0q%(RMfNgp?R zxu`}8O(v%08RcZ}2nBepq~nLsK@xh$6&CX?t_Na^MY0x6(WT9So=(i}?4Og5K_9ma zuY*WYKXU^hM=N2g{x?22_kT;sI{6I(v45(#U!90WrfX6p0hiqQyLR-#VJQaCHvlgd zh#6sc%LtkNvEXbqyAD+56#J>qJmyX?tf*+;s0GNZwos`)2w#!M)}JSu$Sf;x1{Gl6 zkD6>LTAXKSj5I%6U2t3wUD{wa3!O>FZnpOO)>W+_fUm-g5*5fi;JYIemg|f<19LDE zYENnq9a|s3wXpB{|mtYD1=dARI1V0rG4BP;;p$O9D&rnEBh{D6m&3{MdhV&{8fnvH756lJl>-eU7ZI%3#5cNX1F<{%8J$oD zs8*+m*!4R0m3DCOH$hFnY{`E@w!e6csrC@9(fEao?rpK%vnI!NCk;odIN;~8$E^bU zfVj&N7{y!|tHe$Oa zwndEA&a$g%-ISsHrZZjwBdMGWfmtU8`!(i6j5`ITabD*=8>KhV^6uwh7TqB*4=Fyhj0 zgn}{Sx$RkE00US)W4IlJxghI@?xbPIJ!A<(n#y}i|8eMM6&Vx%2}AKHMw7EJ+dIjA zxRKbu4QTnZJE(YwM|F*o`*rRBGEr9Ta^*rB81*{<4SQ06QzYImoR8rr%(Tu)U;m?j z9ZXo2pSQ*5pKs-oO_B9UL9TMmfz4BwXovLTmm0F{;&%i2Zt)Kh$YI-~1W#oz>V3oZ z9#Uzeu%%A-_4gOT)JJwyeyc+5nKdM%8WUs@F$y}AwyRBnFb#I;mJB>=b)~YLDW0c^ zURsB9n|b)rVz^T=_VtNgpzGZ$%HqgxzJL-826WF_29x6v{|^-1HM`d7>+1;^9k18L z>JvbPXYtBHOG)}pvhA$a4?Urg_bpRoA}?oAHQ|`5Ybb_2%82a2J#yf`%KZknO|oXE z)EA1e4Qj~Ue8frGEqT3WB{+y#kwT(w^}eO+a?$N}ZW+7_?G8i2*gZOO-68c105@q`uqS1`erb*Vt%Do56A#2g!e>v-DwStl1%(i5uOr_>I^*ldB zKDU&6P;no2A-qn89H<_gPYBcQ#EX#q?|o#X&;IwPiEOf_b{cvdQvXw{Ui(b@Wnnto@ZlAJaz>mq_FF19S_D(yvNCLPP z^aX6n6rFpDPpQPtovTml7#0w557dNjtV5^g@)uQMzC)Sc#NXq|Hfw8y0S-xnfha}L zPUd$Ss%q^js?gxeU-hxHSu!AVD!|)#9>0Vd`{(V>SGFK4FG_A6UD4d14bEm#X%7>0 z!0`xc92WvFd?_Qwc5y23dathy&@*$CfL4DwmY2_ON|o>M9(QNVl0lp}Gx<8TV5zj6 z_iUa(L7`s4nA|aH<~y5BZS_2w{3mMruM`Oq{^D#CSdAaA@^rGtp>`$C#k%SYqIVrV zCKQQlk_>Z$gBxmvgkK6?i5XnJU88L&M~}3tRQf)Z7g_Y2*DS)N23}tX%WcXx+RKKM z-tJQTY<`r1K@p0#r2INYU)JZ#B02){-^oD48m(-WLalAbLZSDGom(R$onY-$;7rMo z#&(Y;k$uc5wtJaC@eZL>;eiJ(zbL|;%NQwE@O#tpUn7_sK=NQp`@M0AKH&ufSV%tF zvPK$|223lQuMuW+Xf0D9_3SITc;>NW+ZGBwKkegMK2izWfS+aT)Dfsq=BVwcK~NU^ z$||Ip>*IYDf!V?sY~J@V_D?1bZ+lY|jyT1VIAQa}Kv;0xla}-jc$Rf^6`fCp8kSwc zjj~*aEw7gB3#|-ZAou0G-WUR^f|Kf&b93A?yve4r)9tnIr#xrkX4<^jf{ouOfOKY# zEXSzf->D}72{zQUp+Mv1;)$CGUIw#cCN2DpS3>8T)~vHEKmH4LN#)hA)xS~g(y!sV z%3EK;g4)vXPAK9c_FTwarTTd81Hz47u3ObuIxBIxP$e@hK}T*e}Cpj zRx~QrCBPq&Rkg+CqfwlyV2}5fuN5lRgb2l8TGr2jiGKaO#p)q=(qHfy6na?3C`R~a z?)2LZ0S=h}*kJ;sLP^*Oef_}L4%rggL#GYH*i7k?mUDJLX$OA~9rPl2PqnCw4;gD(do*gp@~PjL<1t=Y`HW{q#)MFt)Go#|!v7dtEbnn~jiVqP}hw zK2r$AfC6JCm@>qB90P0{{Khu}EaTHdM+XMi}hW4s$H<*9; z;u1Rfm2_a|%w#9j>+vwKPZWLl9pYCiF}~U^n4QSw4W88)qM!Go*ub`T zS`T(;Po!cqvZk-4PGa*kV$h1}f0G8B5Onl|O{WdA#Al-)x|w_~`orF+%!z9eH9hT{ zsY}-1(HFc}WGjYVH18{Ai_xvzbWC6jy@RXW&qZ@sTjmb}!*;`Nl3pof`SuUrBQJO~WwMj-+GOhr z;3t~_vYvW|-}OjlF+M_nyWXjZc`+uJa+lt_g<|85iLIR%WqB|p*af1W=cw85R7#w6 zzP+L|kJrXgd9Uk#KJHn1E&4^Ywq35=9 zEP=xDbs8cDGmgJ9V*ZV#_Jee&h};yOOf`tgD&|q9>~V%_j%7ns(qeC1+z2u7VdE{X zfM)DMSW?j;$yTi9(xvCpc7N28)QBJuTM^9CU3D4G=tO+;5+&k@F^SCSd)bSIgHxe< zm`IfHI{aAO%fKM?Cg6KFG!KXou+G!Bmixj&sNg9PhBG9x25ZbDK02+b&FZ2L90_84Vs#Yv*6#6m^)nWn| zY&ddphPecPaN=o|D+TrlqqtjdUuWC-GV&1GV1`SJ+JqpcVGB`2)(E{2C=6I+I0iGxG{TSVnkO6Jj)yIT<}XF^ ztXqB{`X*8k9BV3Ef;1rHR5$45T{i6nXsWnUDz;ry3Z@hcO9(nrR-?58zA7AoUed^f z%UtJm1}j^RN^?>ro=S#Q7biYb1paAp!E|Yu>N1%wM0q4N7o7Xx^SAp$@0D6l>~xf+ zFi?a*|6+iWPY zBrJK%AIzXQeG1Or|K`e+y#Ln+utwkm8xG3D%8f-C1{}J=(8rEgs*j}XW}*6->)QTd zvfbzGdI65(?EuouHq|_-q}<6F=$L;HmS657ikvVjtY&?b+KM0MLYIWExhu*zE|5i$ zz^#e+oZ0bAZp8ffMK3py@@|JDWi;>H(r)GAir8O`lC7$I3VogMPSeM+8FM_?hW(0? zsL{nX=9$U!TG84sS$yoWZ8J!j7M4dLfFn7jmz|a8Qi{mGg%S|ro_+K{z5&5sh}7F=EY zghoq+^Ph5~EkEdJ8^*Vwp@bY#8VIg2mo>giPeOtP?IxExM&M$K5{4?9dQuYvlMQ&ENJk(xn`TB51;?xVS`u~# zj&n5!nx<68{!naio-(s91*uZZUKH3CJ$B|Z>N+cyfUW83qVY5LOU?|rY{!)uG2tW( zJ8u$8m)aQn)4lL5Fm%!>rm=?!5J$e-CeLnV$p>P*UM$_o-B(;$Ox4%Q#}6u3i!Gd# zaEdq&Q+ZuY=BI6(@R7!Wy8r7_7G6=*X4BIe2H|EYFC6h+hLl&3Mr#M9-CRH!%^N14p`#pMlKx8={+ zW2*%9*_a_e6oh^<(p4xmD)#eVUrCI}AofcqJnm=mNJ6wY`P`&vpDF+#-Cv3oD{gSBbV));7iewC>edw=Yx7@qQ>IJ1bB8cNRKi0)EB@36` zy4WRWCTuu;#qm)kynbkR1S@wyeBQFYL0D|8A=Ev0M@5LgPm4WOP>RBM)eX#qZm!CS z$8d4J3cQft#JUqWaE+n(qTli5b}oHEHC zez%UiJS^n>sNq?a)^NCwLjubgbE-={a_UeTSgXJ5hD*OlhUw!eY^$aQb z819o5Vw(|u8D2DWQ>1${$*~#kRrk%8moKy_w7iTbyO(b@ObP<7JKWyZaWl{A`LkOqKo?|Xb0YFyI=^B+Tl)AM&o7>3 z*k=|@w0!khNunG{74|g797}{j#)bpYn67^uriG+z_A@9HA~=B_55{MPp=XAzz;9<% z7+i%!zK6>S56IK5>nIgc{<`PgbdYr)m{H;&6x1~e zAOS@FfI(<{86cZ5_CD z^jO`?h_M67JHsmeG;yCHedkTvsQ*eYVyN;UT8VFna+R_|aV1An(xfO;^Y^wUZnTpK z{?GJZJq{?n^Ng&VKPNg`p7YNgMG|NYG3d&V@8f@(yUOsAs#L+In{)ez?alfMq^O_< zauHn%-=O-lJ>iK)z%>V6|1nBMQ)i)aRidvS7*Tkc)B_(k#xAwVw&~SmN$-p3vJx|$ zT3yc6YvN+%VyBJ>@EE2ZIV}dU((Sk?#g2H%(^`q+B_v%hzJe(ShpOTT|0ZEAcFLn?s)?|&qt2#(8`3q61vfjvqF(`c1*Bgv zZ`Le8h?yh|MJQrg4sIxwu7nI8Jc=`iYg4Ti6S)f&O~}0{33*~~FbXnn?yjDJk6fK7 zysK_#J`LX!z_CFy!!{uZBbOcgtklO<-!iNjHYp9IElpD-3m%l~?YaR%XGF-yS4<+9 z^Ibj?bLMyz{>m#oh2M~?%aqyZ@cxNLyJ9-QmwA2o zuEMtLU?R66-y5Q4{WUcov9P2}q$W5z3GU>5qS3QL0Sc|MGUnUdi}Xm%9g~K~0oj51PRWXW+0F{(XHZ;U^P)b8%QHLLdXzCsE&;xInsZ)*&4D1Mr3p zqz&ku*bW>Upo5L&ehkYd5PBEf!_PiRlffAXMqs(7bPbziJfEfZuK)3Lfqdxto^GXV zV}A#L<0^bat*@H`OV#q6PG#5Wq#Z9xd*mo(@&&ma66SNI^_Z?4SGHFEmLPvY@4NCX z6(kCyO@mqn6p^w3aRRCK*)I~EdKfZZ2p@cNHgaWlUx{~Xn;gZ?jvn)o!xCylI>51F z$Z+XNC67Rw1CxaMh#9lF?+wI_rmVA9Vrx(P?UQ#jy6Ve?c5Pk@^-W`$gYjN;gPvOK zh9^Ug?8HS6o#t=M&eELDqr0b#Vw$F=dH7R)QSfU)`mv7jz>O-WXoEaUY^JaK?}PNd z`OZ?LMbRKd7I}&;$5O#R@RCZ1DNKi>N85Rx*&}Gck$d+p^GEdMFPJ{2_>8$ETTwV0 zPn2kku=QUgh-$+Dv)4lCD+<{|qZ1r0RistIpq$7I0Z9V8i@=H%D-GFchESU@;iW@L8ZZ}uy5!KMYw?Ku%k(1^EW5xgeP2OARk4`vu@?i=1n zRlaI&FB`jPxui$|pY@ZFQ>_!4u58sWSEP|Uj&iPp|5vx7Lx-afk@#|6 zFN(Qq5Zd}5?#9P*0}n)HP>t%az-wl_tA5 zniA}n@+-kl=B9A8=IF7TRDy#canq3?t6)Pf)n-UO!P%M~$Ir7zr_u{`naaz~D3J>E z(6`6>mLX*~pvwvmt1t>b(Dz6gzlh$o6E7N(noR0%XR~arJcQX|(-wqc4MkhcIP-Cqyj@0hz$5TXThIM2qToNNu9x_bwiZeci z#aG37CBdKN+`2i!Uk3W^S^evcvT=aW?OuSTMLWqcABCbrHqd9&|HG@W=RPcrWMciF zcaTv0+F~{k0=Dz`N4EVs7Mjr-@WM&yfyry6&AjG+AGH@U-v25yf$t9l(UBF0n!v%n zowsv+FScs2XtD4Bdw7hyXJwt0{5aN_Yu|WLLV8V3Exc{X7`(GeB?zUl=y-sEV~kAs zj3Wl`wpisv`Z~A}>-~UIa8J9U@jAiYwKGG?uqb8k7BP(7KFm;>y!Pqy`$3a*7_%kW zo;OC8STD9t-^a*Xyr;&3p--z zaKJN2|H3J5lb<^FWNa)<*>uA{v8Ci`^eM{IU^0&T53_MK?q16pk}mKuF+}U@dqN?7 zx+ncL+Xu23nc03W6=f9Oobn<#@4KWD*pEZx;=z_Rz6zRYS;dG+7}SR9UCOKTod)lg zIAPp+_Z@cNceAlM=!wjXe99O+w=t`w->27A3l{3lN2e1pwcKXj(x$oh7rX5nMnw(GOPQkN;-K&=gW^B}w=O~rtxN55wCWxBeQymI6p<5Yd_v(cC zJNDE377$aY{#CB`eEu$XTWKRI9pVtDFR$KEZ@3@4Oan*M)wC5ZHiZ{|`!xwM<7e5W z7F$HNcf(R;t2OuU6nlp6bHGUO{2Ph%b+0Pia@a3JVOX@wl6VFhC<<_7-!%ul(!3Iq zzKG=&McCv-5%}%qdHoS&Em_?{f)nV0_iG8+z!3V<#!kTRYWq<_?NNYB!T6hDqS&h8 zq6p02r0(zqbeVkn+nb+pj|-ls37f&N4m2N9Xu3Sw8a8D1b(B&lkN}ursEzD-S^JuTY;sGE0AkLStv z*iCNq;dCX{fL7rq66QSnSD-UB%vHW8<~N^fTsY{}Sch+|F5K0RE?C4Sc#XLGXYDZo zh%uZtfI3HeZrTP2imX29_1hcot-D~&{gJN54Bp+##=TuU>`NZ!!>ivN%1!+-W-q{g z)1gI)sj*162LQG2x`eQ~QrW=*I)Hh`vH z_cHZkHRTDk`d4V!8yruGFa2?y8rK@1j(vm5zdH)n*MC>(@5Lp8j>^>maIK&*F#>1O zhH{v3Re)4ir|i7%^m&DAlYkBdCC1tLynd`w!#a14VF#B?A16a2s59m`8>8$o$4g?6 zcGR|}F7>tFAEylQGvkBHSq5)gA!~?>xW>F{Ju4x9LyNmWd*+)P%Fd+UJ19~3MSrEg z0*dhwiLj3sOuXsgH^%qsJoTMu8Vslt@9^ulHY)w67hq(!8jo52Hg(D=R#LGm)4VXK z&>OqojerN&((fac(p4W9)NPPIS&%Z6dUU}AwKjfGFk{r(N4d6pZJV3 z2wmoLbGn(BxJ0vK$Sve`9dY=q5_?oOvcVZ3$K2QeX7w_5J6Y?|&ZaI&PbG75J&= zPVVgw@TE0oU~EY+=H6Dt=VvM52a@nC`@Ey;1dtCYpPkwbt7cyF+LDb@U$`rl&mteu zrcSj_@-*aDs2{lWdNl&7;28#o&3v;&cKgGP@VT{`xe<5hKP-7U*QVRcJu~vVmXcJ9 zFAcmQ8jyOHQ>0XC^o(Cje?W3{MA29Pe*UA!zi;~Q<~U&}KLdz|Rv?eGEa@H1N}~fS zUY@!wKn$(WJrn*nFVnc#qD{nJYoZw5F@V6t56lg)<%$a*8r1f7LxS{_+LRwSg%zH0 z(vcd`%bgq45HdUBb%LCnwfyBiCCB?{`AjankIL2v%8523a1i^eSKENBFTXT!HLhNn z?@Pti&GF7nhD)LvwIh*q=r=$-g;U;4Pi{pZQb~FuzCA9hMWCy=uT!&H%};#-fP+S^ z8E&V`LGXM3s_%2`{~N`fBL5gub((EG&-5F811f47a}o1`&MkTIv2l;dlkP@M`h!*) zg(XTY9IWRcPbfv(ue1;M{rl=UPH7#a#1vihQa8din95c?ITZE9KOh~<68=U$&GdGX zan_+8X{w=*G%5R=KgY7LA+Lu;O#{FN+ReN?w+VbdGfSAxVIUS$?@atIq%Gc&YtQbB z?BZ~P-O51!>nZR6b`Gq%v^N9D zyk4q2L8>ppsa*?a<%Ls1%k=01;+?|rOHU_n46b=8bLai~Ns%hZM1^XwAq}sO?03kP zQsfwqPv>PyyQ;EcF3-^PaJeYE%k#KNKaK=yN5VFYfQJ9)@x|R){CgR=QOCHR0gG(g(;C%ABGFuH*b1qE5Ro+u| zOq&fzfgK76VW;ydU8sBR%fkosSg$Ez;FsBfh^$ZPUz7q3LQrMN#yell8;UHKC2^plu<^N`R}x~)HniOH?^fOyyRcsU=r2euaYFox=*u$eGMkclZR?B#>&AK9^i9348g^Wk`EUI^d+W7Y z?c8p*h>zTnueyK`6oAmHZdzm(0CnGV!-h}Rh5g?A;!9ih%|_p5Va%~PfbGC1{tW;} zYA)YimCoHOR#u|k!0(z~S@UXIUyxS%L##IGQae~*BL2z;i4bahU?My7d~Caw?SV7o zQ2DXvc2L#9j->T0oUKNEE+Q zv1oyseFH%`-{?Xx`aZ`KYhG-v;o;QTwU=dff`)eZ(Sz+;hB zOy&n>y+@cE>0XvoO10vu+kkjNXqsa=U{f!!Zhrd)ER5l0{+ZewtzJg8ne!Ul^WYHA;{HZ3WiHt++@*tnnRbKi!?}X>)p2Ti4rQ)s6y7;=Z`+m z75VzxD@S7B{LnT5RDr~uitYQG9rC|m1ZsAXuT5WGEV1dx+@6@)1kJ|6dl%zkgFpIwP zkTlSL$E^Mi$We}Q1-pbU23M397lTyS4zWdN_t!;eNc{GR4zKZ<)y;k8D*dIVM6^@m zpUzAg)}5SIJg01n7dxytT&yF%*&RBve(Q{pc;iQq}mZo!e)^d-WxN8978R;Cd*D#$-QL%wz`1#Sk7MA^! z@}ukRym~))G(T8TKqy3N@{D+Nd}Hk7FEb8^Im4Wfm0cZo3r^v<>i<{(7^d}Yol9#D zH2#w2i3TAxk*(0&>xPxlTUEmXNxa<}i{UQ@&;59`hao%3XP+4@N(%LTKj$zl@EucVIJ%{(LDU0?XGF~3UXlK2 z=j6eW8bJS@)kdy59yRA6{*K!N_=o-!;s8#HqBZOh;YUjog8n6D@_r=%vOMu z@iSMxZ`y@jglF)5Q3US~Vk2J`V@4{YuVWj!U&%|F3RhZlI}Al%Z0G;VYp_>IHTtz9 zEBM~W9Ih%S62_={MnI1Cx~!By2;xTxyP>*~OkS-2ts9=x2PU4ckYES~$|qEqO)z_ntTw?x?+?l!$6B5~3IZ0NbKPLGq) z0PdT)A*C=Dm|9kw-kKgiM5z0I7&;C2g<(Y&p97gr%eVljH{JL3p`A~O#r(l(LFAo{ zvEc)mn~{{U;@bT_7S8#FI5j1`itJI=cPUVL7;NBNn+)#!cOk4otb=FqP?zmWC^Ow z@9(lrx`Den=Bf7}F&LVI;YV$qW4q1YBAZscVj=cS;bHr*i{+wQKwx2QsL~%DjI5lR`B9pM*LJ)KXB!;v_^qh zWMej}k6zj`AvwnqL5^MblT+AK)jbRms*0fQ)9(-s!Yqu~wf(OCwgh4yeb7s zyMd=l8^BUiQsu*dp#E!j{WzVtDOV@tJz<_^<$FqFdJLND z3E^zEl%lLOiC?XHx{!46W8(=7^_@SICe;?xHa@}z28FG;OPGCy>ZivV4h~KO!2DfG z(zCY$AmUN0UaJ#>*+dH>B~~!LLj`!4UsiO2batxlYqo@7qW{F(m+$!-(N8}z`$Jh< z(kqy4XHur^=xaydz4q~9yv=0HAIbI#;X3k#9&e>FTza%TEAspfQ3*PscExImzq_>H z7)agwei0>3eJ6gCqv%xTlf}N2Ml>yX)&BXzbe%$2JC^hR(exG$QFQO$@GRZkjldGp zAky6+rEr51OE=Obv2;jxhcwb9h``bv0@BhQ(p}H;{k`u$u)8xmbI!RwIl&E02n&W~ zHE6sQ65c6JCB1zcK*;#*-&BcuBg6Znp58Z5l<Ql#5d#4bdgW=wDFaBI&7{fe?BZ0O+FuN zJTXs>@99qz7$AB2W2Wbi$`-z3TSU6hX_p=Iiifhr7u)M-ZEmwv6z(uluxFQm9*od@ z86i3nJZJz$;L#xj`KD}^A|5;$MY$Gd-)%SxJGEJA6s28B-$-n*2Y3IgQ_&I?umA8q zUTrVT345~uL~~xaQd$uBsHTs|R2eY1&YnXBKC^{> zD|@p^cHU8r&rz_)ml(buB%tM0gYmQ~bAOO4F$04D*I0fZC>{kN3X2{^C;q%J!jFJDNh7SI@0DIF) z7|Q!L+POCx{MaLSk`KysXDij|k5y*a_B|Kxn7NrJUjdD1GlJj!f<7&in_uOG^Gx0~ z3?hrqw+94&kSeiH1g7=NPH3@|knPdbX=lr>W%^%q2U}7|YUrlK6y*#oG zv`Xz;{bSj?X@qxp4&HxlV_Q)xf6~e^g#JMHzq64oka`oc^G3wkrJm+BOO=dxg3&IY z&gQJT#Ou0G`hCYHj|ea#Nz7F(h|A^=f3}bb*G~oAt_O6>4C~`4pB?v+8XnP**WiaL z*S)Dq`?)y*0rPUZB{+oFn%*?+Gu5N>q*uxBZgYKh6G0#_-&65Tx_7KvWA0w&r}4MX z1rVmmU ze5&(O_Yl&iN}h~2h^$3@av}trqyjRs1kOVL98(Ej)>T?A&=9-K`|y$0&-QT^B}7%) z|7Gf^HAtnfo$4R2!R-qS9@Yht&kS(mS25Z1eALfC;Rs*KR4F?dX)3dv3{pPdIVz@W zC+q(8U8!d&jVBSxvtyLo5ys}~)OQ&rCgVj-YH9eew6%NtcGMe`$jIg41V2P){6JCs zEyMqY7RjjhbFg~*gLql_`7+rpyPDQQj?r^X?+)4L_h28Jl^8?~0ci1??0z4MKzVcUfab$K@MZWRojgEl(W|qLwy}Q75*1LX< zK9q5d(Sf4v+j;lun*oavJNxsdbPK+xti^?~cZ(n63K2aw%)1S@SueJ7m<83%->h0- zBeE#Osu83;?MRe=EpnAYySTE*WKvQSan*324@uaPySZ=m;gT4~c zo&Lf^@t@=T@UiK=%ITOPd8T*g9YXw)?bhO)MFj!t2+Cc%rHf@5{a4Fhl;}Nq!nDs; zo-?wj5(X-LllF-Fc-wz#QxZRI@clvZg|h~SftZ}73*e^fv9m19_NCXY!Gk=N% zDXe0~C7r64V%I5H-eaTTsXZz|Gz?##Z(2uXRB^tM4YDi^j>1jv<>nPQ^;c0uY-ZCG zCjDL*G&I@5(~FpNBdnnlQCK)GT2KdM;FJ$30&zErJtik+gJGSrSIdiLscL?+r^iH^ zTS$$+n1R-MXCs1^uP1qJ-(29rzqzJ4ldr-wZPxClO`LudF>Snnril|CdC%SPZ4HmtQy=heOQ;TW(>&?Ts*7u!{F(l--%?Eu^dnmxSoa`T_M71y^;jGr8d54A zd=N^V8Lxy)s@}e9clWo-)!~OvRG{X3v4!>wE3sK_?Wox-Vf8G^AKE^k*(83qRbr_p9GojE#<9)lzm89zsu%dzgJUoR!cbYyZrO#lMT_$ zjcGl-%!qunR&+%w;RJeGp`*_N`47pz5cn8b!IIqx2lk01$-?NU$C*;~O&;&BKc_$w zA|+%ijDLER<)Re7{zXXg z%F_VQwntb6JZD987R>_3%}DRB7y|M<{-kKylr#nCeX@`V$lrSX_N4mP8$2+9^OXPf z%8=4+@sQl-Vs`#Jc6NiY)-;^Nk}dcy@=X1wPCp|IrTITKoTTM8Hk>@Og|`m+T55Yy zd>m(vUP?h&Kevt^3c?ms z&u71!_6jZLk`{GQk}dz+WC``;grP$PPT!dx#^iJi<$dRElDy20f}v4^Vm4+3^Y2H@ zk~P){Z2n|r7hLLtrKf3nJC&n4ORUBui+h(eZ*&iG_z!+o&QpXj0#$!h>yh0mJpN=y zd28O=6;)Yq1q>k*7UP`=RRh~MKSo2B>AB1PSxim6p07}@gem(u{@3N+c$@%D6sQT^ zUjV)u;b>_$TmDJOPIMoW`Hz8wAk?M3Xu8ON<$E~vb)M(mWupBnI_#1OCopD(-&Jr- zfja_=&7s2{ZuCR#6uY7R4iE1zYj3Te(!1;mS; zmb;5>7vini$#u|>(tbRTORk&F(MPTHR>+m#r8eIX{|usrw8w_JlT{t&S_ky|d{n*f_ zit(^(^l;zA8vkK*(XPWa!hWht>QQ9>NzukfXAA1LI>yl)qhK7;a55J8&%H<=`ZnC> zo$NjTafs@vY3J=mI(mv-itG~I` zt{sMd#3uNrl*U1aT;l++;x@09OVaVLZvtvq`wE=_c=~$VUYq6&N;v!vxAOy!aTk)_ zR9Nt_Cku3QuGaJjo+Ml2_juRaYpin)hqt_1y4j)|mS~~bN(@L~Llu-FG`f#f@{t}} zJ&C`G**gjh&$a7lN$H-Md*Ds(f{(0_un`_h1OODkhg@F#oWUN(kwp)HHjw6qh@kX4 zX4I>%I8>?DodlWvVgco*`+teS*+>IbUy^hcvfn%N`G zkr)a=@+LKqD!#lnH+lXjo=r%&N*0TVICQyojxI9nb&9$5GpJ1BukK@UG@+aL7&2xF zxY^7KdXEjwk~!uXN4ZA#K)Q&^>^?z7V!w3YYScksC;j*Ba?)Qs%Dk`a!RQ4J#lKX; zqs)j?kzE7Z2dKE(FRYZHRya zAC-Y$Y!hb@Bm0CsoCK`PI!CwG6>0qTu@Wqhu)I8Y8^Tli3V(hy>`3%yXp5J4eFLjY zZpw}Sgei_WFZ*b|F?#Z|sM@u0gZ?Ym>YaJ{;Z2hKto6o~aM2{?I|}_OGIc+AK;_B1 zMiNELV4lcRFv=62s`P|8Jj41X0`9Q?p}iMxMLRD$DJ_6iMUTQ(i#Col5#G)F=&`mX zc(+^7J-n<1FvXwLG`spVBha~eBJuvtpIG}H!Cp7;ieC5$?!zxv{;#3NIi&6vs}|ox zL^K)CxBVqo3;6imdoXfw1M&d~jbS7;POLE~fNqUKT81s5?!f0T%meF9RDk=$l)zA? zn$OSiYt@HEe60gFT&4c=R{i=Qp*CmYBYI)|AEK@z+Fz_dSfo3McqmsjHd__6uG&bq zaRlK(6Jz`ZL*7*d8{jj{Hi?#;!GeUQ*e{>@N$Mkx!Nqg@c-d~D^ZvEeez}!M%0lhK zhZK@KzcmYn4O4NHgkW%xODB9pS0(iYlhJ;NU24AkDzMt2#9Z!G0PZD`=d>pvy1tmeH#de$ix?Akz=H~7jdP=>2 z#Lo~e@2?00!c*XRvTPHYi}{{HWAL`)a?*~bqs((};V@DopWiR#wG;7`Z~}a$(RQ|6 z5|gVKky|PtwPc4M;6kf=m>EokFRr? zRykj{Pj$s)X5iPH&orLxw+!1Q`)p>G-$ zSe!HbazqS1vMg`ze|a1eby=E!7bwK8ZuqzNDQKk~!JSBKBtJBy@=oC0Ty^mL^bz+Z zCxrue(3ezRj1#U34P6TKL*bX}e=h~7ItS|Xvwo2}9>L2%e!y)$ zbu;Hbf{~hbH`wKt5-+mV0FCC;KFTn1i)l*g<>dbit+^9`ce(>iDY~z?Qvso1v(#B08h$D#voDf!SC=6#LCc6dW#Xe#ouI?N?_i}z{URblk@jFD7$86-6CpkUVM za5CC+WddW>32ci4$Un7XjqcA)20ninOH6#F)UivfXTE#-D|A#Osd0@VBmqib;>~MW z|H8PBzgodD*#s$P9+kLv(``dp{L^yeH6hSO1NZsfF|lj??{J1B@#2E4z6;|u(rXIv zv0U<(+v)e}*z63CHuS4e>(o$D47ceb+RcYJE=|Qug~cfZ+rco=v6@OW$p(1;`5MLK z;@#(2$zqhqw^0O1iPbHcI&g;OY|u_K;Muh6@#+4!yW*H!dpBUravPa)R?B>@#@PLA zka5*t_EGlh`on!MT_>uwSLu65MGa#GKXU&#hUla`(2pc8*vUG=D+EcpF z6PSHj$h)(tJ9*^!FI39l8al89vzc*Dv$7Z?LrrXB>+frRcc)>ePMqy2K5~F&PiMJS z^Mxq?F~)~B3~Xm@^{Gzj=6?8xk~|P-PGTfwFe{%7(Srrs3;BtHHP^qoC3Y;w^{hD8 zyIe$BKSc#M?Ri_Hc5H|noA=Se95@Mm`ieQuj4sshhzZg3DG=g_P(C{IVM-D_fBJSj zCA>|JIj*-=uVvIL7uQtLS05P}S>6reFMuFNb`|=05T6gcMdgLX+c6=fXf+2tJIR!P z$0Pus`!Hs-&ZoG@|5xU7b!q>x3T4;ifa{`;K_TPv__O<3NIflA)Pi%VGG>I?Eg-uW zeZaDr$*6P-FVVI5^tr9E?RGo!3U2RTT1J&k_3)s>brZ zm)mdAp|#TC?*R9A3$bj}`z;1nUO?=@mN&%hH>+6HS5?dQZ2E1+1wy7r5zg<&9{VSk zVoAqFP!s@EIFiqX(;hw5BhbmY73DW$%55-0Smr;M1Mggh^@;`iW_6yj&DL^^Fssr6 zCO>D?cSI|m^%nPi(o{iAH}VeN#q-}unKl0)*|;sgGHz%tRLXs=b)!^kTn#?lP;MRN zEpdr*q!y-G;jT;5`)^JTYwG}^#Ncu-t0BmK<4y3v#G4Zdd)1&Egz34uw|{(b#{*mi zkJput7zGHX1i=47gu&kSR>(Z`{gDLsO?ErOSx9^>s6@QReN21rlbQN<68!MtAUABA z?Ir*hti3uWxPkQr-X9YrA=KaREt~tUMe)v^T|+lL2Tq#cxypPJWTx{FX~~x>j`!tT z?5eYa&n)&|RVLxf1Az~pki2DWTG~TPXu~hKXdxeq7vc`rfj5a=FS#^9@-D8PT5oOg z1fdBBs8m|rpDc#vgUvCpl$^b+MC5^lyzW;|m(^!UeN$}?fr;FZgw%M{pVIZRff^^E zU+|(m1Ufy1H@!R}6-m`X?GEo)Biew;ScxZ3?y?EG{miM_O$4Wrq-%KJ8f1N72Vqy% z;e9g01K%DVD4HEH&6yStwn?ZinlG(5u03j}t|_E8r_M&|L*#Jl?&!$yxZ3T1Ig%rPk2PfgT-;>Gf@{}J(c}nd(siAW^D4#hbD7JnJ zlPsz#%3NaohP%1@UqbLA64qMD;2YfcBEr^-y*iUT1{hP&f1u<@MJ@GUaqTd)3KQuG zU1?fHs49I|S_nk5^=AF6%*t>N?eGK?gm?(o!D0RT1TSxY58-_~Z0xIge2N@ip zo)^%0;DT+@;kVl_fnTVwzBfEyMzeT|tCMl?>2hLMiPTWLP-*EA+y$So-!9?3qIMD!{GhfB z{ZAMdV2aqn&-(dx!gq(vHDg34LbQaTsD4A-se`k5HISRKpFMaHfx0U5(^-qisBI>) zFykr~7_SD!s%I9jCY9Bd$%P{h>6a@J5Y;7~mSFq}y;x74HU=5ZuF`k=Pcyb|;r=Lr zEu)?BiRrZWb^|oFfxX3hy&qoCp*7@aXvXUH{$`V-=8%0RVXGz*(?;(QwSIbi#9ZW-9+s3OsD+FX1v_&QoG(rl7Pyw zFa(15cX<v7Lt|NAS_ zY_Nu^tbu1bU0j|PHr}psYb6<8jV3+*btU^-@SDptH%ZM~3{t*%qlg@(lmoe%j)z`Z z>$2JG&ofPO56If%hgblg&2;Gr@7d^ZNIDeNtK;$N`}>8^R|54?ILU*u>%;F8g}^KF z+ziM|V(`gt%`;64NAv^+= z!uxWuiw`qd_#5WOLx4P7Dop)s`rCLt`U|PAT|=L-n8`Oo_BATq=iTqd3PKVy62W=8 z3!QJ`jtNvqW;+EXF9hlMniBOVYD#tc^@kJ?;W%oN!IHK+DiX8VE9S z@Cx%d#e)tY`}no~Qf~g==+d#pnn+)cXvp zBCdcyy&WyXmvK#&Iqior)g|l$NJ)s`!1}GwP`c<>!d#_EWMWNE9w)nPsowN-a(rAa zE{lqJY(Wsx>DgMnf*du?oimX|;0PKB`fC%3$sDDBdh6%joCzvg^H*vrYQ;k&y-=YN zaKwGl4`cHFlA!#8h{cJ{ZA$EP@tptZB=r%C%0ZGekNR0=mbT0XC)Cx}lvfNaXrXwo zaiZu}34U;$G~MmWj1u5X!|zPw=UdtXKv{5t?F?8`_}yVr+O4!%#ktUi*^`bA>Wz# zXj=*UU=l4e$MyHPe(b|E4h;b%JQgbL= z^D&w-R22%oEw{)ESf>*eW0!WaV9tU#d%rjN!3kD3NcPf=b$$57RR3MNp+(S<(4e%( zSZR9kkn&G^upR*}7Zwwd2+lz3Pz4UbBe$YNJ!#SoOMe7?cMQe8FX!7#U4zIBg` z(@p(e{*}$2I!6ECoN+VCenEh%M93TVzofh^{m)q#kegV<=H2tT&?lUl2=j+J%-!deJeCymK})y-Cl!vRq>$MVqbffyByx|+Z4$; z`95r)&F8Bh9rN&N1mZCTYXxOKodM<~s7fE5B8|@mI{1|z$VJpTj;z1{F5`v|zPqyG zU*W-G5$;L6bZI{?=~$;zOT67H2Y+a)MGw{2J{%rk=yna0(Vi8=2(t+?bW5Auy$i}i zz?naMyCv7Rm-%3xbZde#Jc3u8fWwC2SA4^{PN@`3BfSG^r9{TVfUks18L_5o)iQB7 zE4#V+*1HrF-gkQ?VMludj^eR_rh;WmyR!4R`BO!RNOlfQ^A>A@g})#(zHpyu2+Q&F zeaG{6ggp3`?53;mlm5!(h0=q+2;V?Z$|B>v|4#X$0#!)zxKWCMnNt1G-Y8{rq_6A3 z!EdlT{Mqf3I?Y83p3Mo=xLNz9?#eWJaYPRDWLZ%|k{t1WIm3%l;_Faf6Z^#g(`c&@ zE>uFgPpmy86KZ!;igm;Ifoi}Y&;Xsxq$00lI|DQTyaQg(B1gzj zl2h)EgW{rSqwqK9kRHw!i+=HIP)VXgdOXy;5M@@Qf$W@hB*lHXAvUC=nyMTaG!G`GwUe)VrDNYQ=;RN1GDs&&FK618QOgfhOKWxxyZ(|E{32O+8D$7nP{T3LD zop6eG2uvae)|#_Ewlu`X41>%ylAm90p|T|6h2~8{A_*!W|4;EwHn<&668W6$e4p1M z9y{oX5HH*vY8;&)ci)kJRMGTJ&w zI_xR^k?TV~A;2V_(?C6em1Z}XeE99(@M){|FP1huJ*%GPrj*and_%_8tA#=>9M-^# zlYOO;wt~np__`~yj>cqhknyGUwBSH%HLJcPP2B*qg@fQt-^L-j$gild#B%kG;gUV9GgK;0>W##1agb__ zIy-nPggNeGo?0w%x(m@FLb>vlv$`S8sPC=ytB>2(Ax{0riM#LRhMrxtC~&x zDia1jsOu$kXhFVJbp^%TCZk4?)8rxPV4|)zXrLyuKaOO0?&^FH+4!2gTvhA;mN74C zwhKOG;#np*32{Lz`a{I`fIUULC(G7`DnY|T$ZpbZ%^diXWtZ1R0dXgLzk;CJVS@?t za1;AZVvFyC#GyWnc3~e{2ZY=fR|QxUg6^=O?=6f{jtGFa*vKsP+2g5iqTupWfhfa+ zFVpL3zpRn1J#RK&pAr84z_e27;((e~=!~g%o4=KR&-2y{L756_T#&cwMCGUYloOvm z>~+Gc*QrWA(O)7E0dP5_V)rT9&JPiFR)2QxA)ygjMJ}<;7 z;C;m08?_;f|GWPIG3{`s(xU#RqRsiqB(5{-t5-53JVEig>P$@OIQTu^(`%@j@~2KS z-f%P1Ka=;jpI<&xkOGhe<&Ax?;UTjgvgJKB74mC^w$ki#oxpzx+G>}1Q1Epj!a?y9 z0xa$zyZ1xbIA;}UbH^qE95e+O;>&K_L1w1laR0{xBYH>BFbHIEmLpFi{UrRtRBXw zy2*2$Xo(4d7e-LKC<9i-?>oir)t`7P^%11vEm@rA`v*b+_Oc74EZ09+u6CL{$LFEC7vw zA_k(RO`I+x44veM)P`y@o&b4rLIO6FrkZqO=;D2aN^5UBFHpuWOFBSXPjAM ziKkv-i5f$V1(Z?M6{N!gTd)KYq(CVF5C6d#wEXk6jmf$c-&ab;_mE>Uevj zZJq!&5vs;M6OPi*pNQA-DG}ZSzJ_fN7~}#>FlB%VrbTV%8;lczdkEaN?y8nrDqm*7 zb0~swB*bcJD#x`B3Qo`FQl)60-{ugayh>fS22M~#Qq$RK>Bv{a0(;g!L+OA7kHjzd z$EXL!#J4fSb&UyM272%l`M2#J3VDi5@1g(%ZgjqIy`*zMa0-&JfuLV&@}TbJ%v0p- zfW#+kx7j#kCM7PZWzt#x%C6h50k>w*3+O*oU*H7ZEj)}h_NX`6notw2XMS!MqFQ;L zt^nn*!aKz=Hh?MuJgnvqj=07_USp8L-+beF|1(rjynMS(A%9chM@Cw7O$()@p{cpt!2me?RAEZUYY~V9er~c`EvO&A8knHy_uBBV#!#c&-Qf z1MM=-&8q^s-oTGdWop_}ZH#!#D*~&*ob~E+Tr0kHb_xo(al!d?&XmS+CXlWO8h>`- zM}9)!2FcS~Awe#m!w!EOWgL+`Oy!gxCYkNGGpP`B{1*-yP$C$5k`CHqeD#>ovkV!e z!*9LC&=&JtIkjgrV)IMe>}Sv>ilPS}urx&ALQ*8t^%L}ZgTzCW*y8tP6ZnKeZiAzP zw~CkaD{@uwa4VPyKR!sdRC$iJjHR}Sil?RzKR*AohTeC!brA>Ja5qx`?1LBy>G*{X zmM3j5Gw3>?JSVQJAg3Bh!M$}YL+aHx6ns2yimM{9f^QJSz{6 zdw#ahw$sD&b|vVaKfkrW@oUz$8N`Je3^PI)fwTsOWZd)VXRsT*LxF@lqpbcY*HE4g z1s0u0rf&#gG?rIV59VUZMPsohwAlTLR>Aa?`FjQ5WgiY#5;`xN*z~*7s4RDKY8hkn z5j+nytJCikRdQk%fWX|UENT3*QyvCmJ!0$g(d=IgVt!9vuRW@N!vFYFJmdb76jh_V zzA+Nxy*T#!fZsi_3Hz@<&_E-i0y`KXXYKa{w8~6msno1hl~Zpm*o9r3r{eD`1@Z}D z?7gtA&nS`3cu@R^Me^`;U&Iu$ng~(zxNUzjA`~w&!m7+MZa5Os6c^Rfv|cYY9n;wVp23)W*VtM)I>l<*zz@f%lAu7+j*@{KxAR30IgKC<*IqI+a7tm=_^PmM!C_ z{wG$$_hk(cI~_hifYCU z(W?ehAPN`U^7;0}Pje?{C+xDO;+F`#b*D5NZhbWN&BwyBM+GFFZZ<;rt9u>34rBOI zB?j9e5YE?IsvqQ2l>nqU=y$M-`ZW6vyJ1I5K{(HeKpBJUAjDkIzuqs>g%q`uGx(7Q z`3KoU&hzcKKguNHie>6{&COTaajV z?7fdm63jB>L+jr3ItjVVl91Be1Ems<&N9mWNI;_i^SU?ehIhtHGp7;0Kn8dXu)Nro zm@yJ#jh>yaAJ}e+@HL#^)t1PRp{5YD9cB%Xf+y606$7AsnA@bg{>F)A?^q-Nd(W>5Gc$o;|y%dfL_|47mDGgqY0&EnHGgG~)IW0R_ zZu`>MjUaov$H>fdD2`}EG_r$qzr_3+Q#=DuMEMkab&B%>SJF=*4STNeR>xnRuB8tn z3(Uh)hKt;>Ve(TQ<`~y8`bkl^Oa61#|B$7GRbjW(66yCA_qkZ051YmWAg@k1>AhNO z*U!FX{!4`MIc(6JK<7|A;Tl=es|%eODNaqEM9aH{-w2y1l)$D{%`Fhjmx3p|&Y+a^ z3XWJYk&PhYaBCVC=kN~xSJwHhT{?_P#9SDC4$UHGk6&uf1#sPk4!tAuG$tpX0N~M~ zy`_3Hzt_${q6q{c>Qog|)N)vKc~d=9WTRUl`h3b-M8w0RAFHSR%fE{Vi2(u+G117_ z>u-8Vji{i=5JC?;g8b{0H^`xk;w7qGz}K`YuPeUAUN}ghBu<6+mU5XqxCyeoodNOC z9TOo5v4xU%M*=FLU(oZC4qlD(jB!H<3y@ewUTMfyvBSRjL|X@Zy)4ADK^`0^IOCI za$^R*Y$GU-p}vnu{{*I-PaWVF`A&RhtQnhW$7gHZ=Ff8iDMyw))j;6J#q$)SAmL~F zMdyn0nT0MKClr*o6iiC6I?%|o8qbM{5(8QxD(l#-bukdaGp+*!vJFzqCI5_HVDQ> zkWFX-&0@n|MeP`P{4Mf2#G%K?v_ElTJf<6$*jZn?KnHZmyd-HyM4sZBJMbE*QMo0l z=?L8ul&rHViWlX-++Q70#-xt={~LN;jb-s!w}RiLuT_qTbP@;T%H4~g%pHs9Os!Ge zs6Y4l-y3#DF9lGdC?7B=eP3;7*?YOuFr|j6`u35WFcnQ>YHdYo>$B&G|T6xF9+DoW{L|WGA?s9 z_17VHj|mR9_H9-aTZ#lKFJt?}4xSFRsjBx)?wqX@eSg_NNAWI6(wCcq^EbVX8Ew7u zc)|#iqg&A9^l*(KYf_A~R9r+|d0nbR=Nw(ahKC9?UWJivEb^9wIEK>x&0yWcT}1Rn zX-+jQ)04XX)T98ae1-yxH&sb<@auO?5W(>U4&LW{R(Uiw? zlAN!G#{c0I1Wd@E-GBsJ6h7HEY6I{?hIL+IZ_*%-5H5OQ3rY;;Iig~?pKa~mCxZnF z$OQBceR#;qlI=gSAmSkPVi@Ooq@@^HL;x9>aAsgGC>c9HVuB=s4Y` zfJC$*FNAWo9@kTLqW7MmfVHaX02s!X=vP(a*$L57Mbt7a$#%yOk}V?~52pT#pNNw4 zc;VL&uU`P|5_I@8?Xbk*xFY#fiSR1x>k|QiF$@Y?YbnXTh`%V~KEA}y8NR8q5WzXd zQWY_^MG9=d6+4NU6wmR1y1iRX5r;+qiE``&NRz#%Y>QsLdV4nTu}llME(a}9M$_-V z*NNZlB$Sdo!~mvkPDzvJr$@vB=n72`avoZVry&F-!@smoP%>Q4(5M#kcTcjBY38iX zFIWxZucfr-W`{XFLwywW5nH5h6XX;4CQsW;D5X5ZW;&y*>Xw0ySZ9dqK}7RvO(oru zv4D&XarYVQZlY7(h|FT>1KHZr5-G~uFekjcD;?hxCO+a|Du?g<=roSz3EeX5uusB< zsu8%S!{IfeJS;j$o5~)1*czkjW~N;e-&h%9&fNSs*7W8mRa__EUio;qwevpiot4PA zZ*k49tRO+&>L0aFCAfJKD(YmBUJgDcdvEc_Iz0)PF#zE}>R6%eG(fQS%C4ppC4c;Y zqc{^L0iK2awhR19a439eVNa0jbtjRqbI!iDftJS@LOkqL29Zv32bCT*S6E8;kWax< zYKezw??Q~DXGdhwCCu*3tKv_C049Wj-FqP%Q{F0$C|0LeY2T@-Qm;ciFbtfiZ@_%4 z!$_+wF>AvrGA}@`H(fB6>YLGoX{lR%O0H5}J|W?)dbcrqPb;sJ*Zh1%uaLnYVFwsN zeOEg|tY{LHjphOoSCo6iudeo$kox3^j-$P+AS!DJp*M7%!4c>SOU+HaE=*LbgOeoO zzYe*RTp53}qfZpnM^X=@Tjr1pv%?riu&B|qNq+WgKH|t-b=Oe2O>2U}i$P4P`0cHA3e&I z0|R8w7}-|c0v1=_AI8s`ISmnq$zKmVN2*|~CLi=RV6z~tn$XMqcd>FCC>`@PPoI-uQrdd<8=r?>BTLfA~4GOV@jB=Xh$k`XjQ%sPV+BYN7$1m`>kr=DpWj%+&0uNRkXkdGBR!P*&F= z>LtBB0sNY2vFmL(ly|gnmHbB}C>sVquE@wO=n z%D`GCS?9;9qrFs2{JV{`T%mtqUkFpcXlQpwEEj`O96hYEV1D2BIgkD$%tv{Tz0;D3 zN8kJ6DapqPeY>}~T-E`b?-|2dnj5x1^L&z~S5i~1)paAL*|Z8(?124R0*I-6c#=(M zqAM7=#^45Kt>}>N2e&G25+e&=SZ0~2L1T-BP@n+>2CV|N7LB_&B!nHLu(!ibn2MNX zZ+A!LNVw6v2Tp--G%kOn>IYg8ZNCx`3Sk+5W4Qg{Y5WYJ|_n8tKyrg6hm? zOlyTDiStE}d9i#(|1f?S$Lf)Gs>lHi^n*B*pP0 z%xfcm$JkOQe2TYY__DLN5X-8#8=(e%1E!&J7a+%O)prokQ{?VR)1m{Ws@b&hgM|c{ zk+Ap!FR0vAe3$BZ(1)qg_KKMUe>LSEs8{L_X~|UMr2 zvDrtN=x@*;gt(+TsO~@L_VDK?*gs$Jg0GRL=zbgVSO|wNI*p!o&!toV#mkc3C>}dtWDOsAB zRQjVu)J9qbZyKKR7v7a1}=A`cTRfV_s)0NbD_UCwwS9)`83Z~deiy%lqQ8> zL4vK~fdY&k(&uH}x4{Es>L<38(RDF#x6+EK4>^OWrSZUSk= zg)~3^I_-n?;Ag)x8tfr0#+iwq7P~NjGL^Rh>2?wfUC66)M!IMs zg8^w1i8!$lZ?PCaF&Arvr^esZRw$6;(7s2~ib2yTHlgeA`7=zKBnmSQ5h|>o%R7j) zfRY$#7Lyo7eX-M=ZcJX7yQ3ckLLy(INxtGhJ|S2|{N8u z{FMz~1RN9h-T_IQ6G_z;GaMnmnBWXt%)3Fl;SQ3-BdXbS3`p`EA!B8z>HDNA`1lK&-h(x}Gv2ZnXZe?P0;Yb=W z@8Az|vT=wDx3po-Gix7WBDU1T2%(x50}tvuk?7eQ^|;x@5fj#2)Ncc1a9Ha9QX6ek zSb0&TffG)O#z)m2W1-)|Vb;7x>d8u9GCZ-{zcXeu-liOzQG$kqE)BvbP=C*A5~CaW zfLol_M}@(AH=CyRAX(7n?m?*_Nr+#}6SgA;bp6?`0S% zDJ^mudtCDIx*-gv+$ScY+CEwDK*BnB5EBCg~TLqy6?pn9Cn-j+CGw}&u zHdtZf>DTKh)c@h17LC}!-irc7`+WS*@8G*KgrU)At7ufm*mE*2nOTY)M^jT1KTx;y zPHuT=ps$xF_zBOM0RxNi@e|SAXamr<-oCeW`&9fns_N6BjM&YHOAQq)!iy45c_lI; z=b`&z@J)cy)#!gG0Xu{t?uCn8pZiDyWv$`;Nh9ZQo4-A<1{iA*#fzjnfoBDYVvqm7 zp{`0Dw@L$cxJ5FE$Z90iCibT>k5o;)ffb>^us!LQ?#RsvYRko>N{~%8&T`CdM`GK)GG*zV|4( zvH-m*ZG~wuH)qkkJb1+})<^`B@Kg)F;yU+ie8lA=8}ENh=sAY!h$Ks(kN7p>3n4q3 z9i6=t(A8^)`RIW(9EZvC9gRtW9+UIu?l%p{1{{IMNvVHQ9*7yv2pU}Y=e$=v9)q$! z>99ODgxaw1&wB!qFCCp_t0Q07-y+gGkt2VBGvq1AALYq&+CQet?l6jP3@v8BDc!&I zMcD*j=Dnx06b%=$^AlbEcnV3G?8n|>3 zyQZqWH}V9B2!!yjF-Asj?>rX47#ug=4Mzzh?+MESi1iZygG>C8L0s`0h&Jc2W`TT& zQ>;_`)w)E49NG^sf(70JREVkt-a;ZhVPT0ceTkg%fw-%h02YaN8KW-d7f;j=v&SF> zk-b+vsZF31hMjFq{(AF5Ql-aX)9C;8C-`e6z}Qc?WuuX1Ap9})Aq4s^S-K(?Pf8Vr zrqmRn)%OE8GFuYg&}RsT;AHJ3QsHIo-6{ZmYcZm=zB>7mylt!ccV1RX=sTBXQ=|T2 zD~stuKViZVW>4bU08|-Z%tMnHumhs(PZYwuzN%7Vz0yg4p?@-F)4ERwRa-C3Y`w*Y z1yLM~%+6MQqWpD>ASlMtFH$&!PzZ~jIyaLf8K3JC4L9jx#<-A+eYY37A;Je2(W*rE zc*6)NHH>qoOXC00bQWw;b!{7_OFEU18oEQeLztmk=^Q{Bq`Mo20i;uqkP?t?=~P1L z4(XDvZ}Ysz_XlS7KGt4q-F2PU>pb7ZVoJsBN$9zOG0>_&SHS%UE_5A>sfBEfmd>}> z?}n8-sNYFmo1dtg`vfJ0Wys}Udk2>p9R}5Uh~JX_FO+MxSw%l37VJpz>knl5P4F=t zhc+fUTUNGb+>X^ZM{0|59@;iHF zzYHP-1Tgu^QZKtX|Gd=}={So^4N?wzO+&oq`OihIv6-_Iu?%5rmNa4P&6zY)cAoo% zIQ5?hiH(P^N(TOU>p;ghh|o=txRKd@!SFKD&$8&tCm({IfE)Wf3yRn8jG3W9yBWB6 z90WGU=DHL3*&)&P5zs`ufPTiuY9I}Hj>l5c(E`%GJ`QY*aeB=k2*2w166KE#b?gG2 zru)5|Ss!GSYW@)J$JD1<)f8s7?OwblY{u9VG$Z@O=R>eb89rsoK(^Z%b90c}v& zdm;-e*lBs$Oc=Pkub2+fe4M0j8`XyYkxHq8jxr;C8hA8qQ%6!6vzQ!cNGqJF)XE+;)QN&zqn5 z|{<5QvRF(qk6a-1wWCY5?eq;Ns3;j^*qx^d~>z+)&@Ki(UsS-OdcwZ1{UnoUs zbwN9(PCST)^x>uGwb56b)}LIK`xLWzCue>MTKmyw3;FI19-EDJl?G$>z5Au#dA#lM zkEvIhI-B_`(PGeu97fFRvOFwFYQ@@GVx;;_Pu=d6#)M#h9h>a(F2j774#Zi z;ESxxb!wx5qM{w6d=Ri4(vH+6xXDIktK ztWy*y@+rm-%;mZ5ud%6%zw95zdE>g@eL<<1smp300IcgMO1_a1j2C^SC2ZD3R1T?{ z_6)~zR+b?6gvhu{#++Rs!F#XzTj1}?E|x~1|03wlXV~dC6c^vaWfPC8@kg860=W{q z&5Q30EIuv?3+W2o>*=_o4x?^&&4f7ozEbZsG|Y&ta-O6-`vT{?Xul$a zhFB|kPit2QnsMvc(lvSVdvCNORt29;b+OTpa{Bey50XKX|FJ$|)*uQ-V-y*#YnFS| zt)TTdi;sPR4QOXkrpFZR%zf~%NQx0Ax0^PW(*`I2G3)$RtExdDQAFm{NKN^YF`p{| zt3zE1H~ymjWa19Ze)lYkVeC7L+iU@?6#H+^)Iqf~_lNe~moFB2+^lK-^<>Ri`ZiG* zB$r8KH<=+6yGoUJz*&6vD$?+^%+)TC%6v-tnm)dSNQ6gCnAh6H-qs^X`e`0_+#RW} z<-g-%4*05VNmIaK)lj;z>V-};tk!lL0sUDA5hIa2h%RB>MS0F9HH+4zZstn2*l&fi zy+52Cv)EE)0pBtci{Kv@0`4*(6Buj5E_Gd}B@&0ZU_zA(y~@W;EitK~Q+vjMsKA&U zc2ecaiPYPUF%4vZx=1T*D zx`FV?ckU9VpQv_=n7hA^i|o&alNsAE<@wdZk+Sphc3DPFV`?#oNCT2*5Yis!2AK!^f!=>s9E=@b3dc^qMP)hNne8V9sFU!?hY$|bRW zD-Nx$_qg|b@kie6~x#MIburci|JT(<&=)P9eLJ+U}+hlk(m#r&b5vpMS}V2j5z8@@DNmwW4K)q8(|m z<}2m$Qj8no;=fV=wP(6DPWh=+PevQC{aA$Dn#d|*x7pU%S-{IMod!!N0ieZ@t`6;q z+c?jLIFrr9Kwar8;9fw%>HX7qy*KDL$NR+f`063*;wM6|klavZB~8kb=Zb#=y^;4; zDxxzdJ86Q*cQsZXajW`LfqyM$e$P%HzpG6;=PpMKYXGH4Y^m{|$Md|Wu*HJ=BS1>B z4UNB(+^u>^lfu$9m{@*$Lc1$rC1(;aXFtoWRXa7e5LT8ACZhJ^l)V2LHmagwj!6Ny zszVK8^xp&cIBK^``fI{JQn6DA_fNB6XqqIK>~FTrEX*G|-{9sT%(mTfz3rFYiW-5w z3&}Q^Vy?E&fiXdLA+-` z$ECCZ5Oz+p#OIz+lzWCV`ddjIsgP!|^HDyWPf5%tv71bHA)}o^%7mjk^pq5+& zhk!Cv@oKs(nX)KTKWc9ixfKJ0_?kph;075Kq`@E>+MGr68ZECLf%8?^H3FxZ5IVM^ zUj^~f>-$Le%6@lvC_oPXiS&kBXY(6bnP|NN!gIj{1PuY>7th4Y#V zHrCJeW}FoIH9~THp7XW+-a5z&Rqekm;Ti@O78EVg0e*j^&Zhue=eFlW%)EKfk|*RK z9?z;_^$SPbk_Uo+(LG=}jra!e5PfILvOiDr;hXterZgKcroBkQr5^^}4?#lp zrh(VdYBNud)-r2Qr?#XT_*@qQ0#T(KQ9CV`F^A3p!Kt=f^W>YoGhJkWR&L)f;ZbZR30{5Yw-aiMigqley%g za5i2mhDD?KI|C*$+HE-<1EdJGAMyeG+GCK@F#6H^LRT%hT`pv=S)z3i`tYvz^(FJU}DA7!{XV4X6VQ7GxCw#%R9KgrtG`O%+w;VUylC;^L% z+SaGd0O62WfJO3E{;_6P&o*4Jrks7}U?Z1K|CbbaIjxl{{m|VjDB`d0`g7UG?kra% zUD>YxfA7GKxHWR-OFszW07e%*q%w3Bb2}F>6y@-&=C^{X{dx+=yCX&{zj4 z1a4>a9>dwuvGr}&0wuW9u%Lwcg01JObun0cA(s^_=u`0-H|av*4$6qIckB1{e??4G6?Tfg7dGFe;9 zxGL`$u%CXoXbUguzcz%wMbQl%eueV4OCR@jc6u8)KOs+7|K+qPKhI6z{kK=rQrd^_ zKmGzGi6Dxn_eFEMM}R7YpN!VYgHru863-tp`NaQuth?Sb9YrF%6+f%|9?+aH+*SA0 ze2w^c(y{7o8;zj`Lb7#Es`BHcE-E`gnT5!(RR|O_;4DK;P&Q=NW*^N4 zfj76jXrFD!(NW;!m~H}4=e@`cr<>~yOunI7WyE)9-2?k;kwn|@dIpqJ(}W+Rs=V&+ zG*qwvFr-Q)BFTG9sk6zFi>N@3>V%ay3g%&mX}cPZ9Nf(n2%BIaaBbN=aBrY!d*DtE z0+%o-`po+b^EZf)i3 zCyw8m&|E6*=8w&9p$xxJB}UZ5l2SD9rT($}4q`@`?^ZT;PYoR^B?2zRX=#Aax}RU~ zx`6t#Dc_a;wa2WPE1QVY*4Gm4R=HWo=oF701KY|U>?hfK6fK$QE5IYL>Z~yhC0|j$ zpvrt_T*Ez@1jU29_gRlKWG)M=<*>h8E*3f$IcV+Ba#zE&gP*GYe`URIL}@S^SaTAhk=GR>kv z38jV}Czx+1cG`W<7J#vUGw(EU-%$NK$g41I*=tBG)zc62b-N*_!bZeI>R6S}6&w9Akp48dyNZi=cHR4(7G+6< zn%L==J3pi_Euy*DhNjIxJo{!yX;nX%+PMI$ho&MVjAlNby5xP=ua$7Ww3^SjoKwKn zIf)?U8n?|$Chp*|U@C5Yt?*V?v(sRIO6NS6s6hjg?>;&|@}qDl?0~3f-{)*-&lJ9+ z|L`ft8>$HlGNt^F5^Y27EcKpWhxAw~J&`Fon!KnhPSf(YDT5g~8QP*Y7Q(ewhIu3o z1?ha;jb8w2&Pn&?Lz3ne0&^AwA?5G)iZDciJS7PfQuW_S`LDNdNc^*}&DK3La18s& zH>O{e92oM)U;Q=vviMn7qhOMu*5Ix4P@_`pbQjlID(GZ8TR|=%kd~xNL^ote*Qag% z@Ar8-|GLjs>&A`Ax^K2hd%_?ct7}xI<|Oj|x?XAs$=4)$w-Ey~{}}>In;@&)?EUGy zu<}8X0ufC8(l(4qyWtBeLIdbOCLi7{Tz~z^BGqIcj!1~m^v4(qWF9FYerw^qS8$(= z&5lvhX(AFCOG(odJZbE+P@D<|)6~B%XErVM%s8X!&SQ-}?2pA=S^LKPcS(BWG((Fr zZnEV|?Cnv5UAa(y0K~`S+By^lCSv)Hkj$NI%N?y0>DQgA+mk~4r`s}l2_)&#{CxIA zFPkB#v(zRtlyf@i>Lb@g%hdpO3uhWZDK_SOQUMO^Jo`hwWnu-xGI{BJvFhf0OJYw( zx8yV|H>(pQ-Qt4>yI0f3QkD#CVB;YHA7z2$7e_a(QK<(NIyIkE7@AyR6FL$L-Hqu_ zpXIpcs!cR8@)s+JPemRU-l!uzFD;T_cNV}NR>x5{icADNdPs3r*@V{=P?wn__UCs} zl}t!CVS0pJrS9oXWQJV_>6M#YEKt{^FaJ_E^$`+lj{R>z_F^N2UGscpA{%ii%Dlf^ zpM`4V%D|;Tq5S=Z>Sbro^^jBIj`QwTqAJ++7lIU_$&hvU z*lRC?REd?OnRkp1KjLt3iEPEwY782&>H?2w1?5m7g3b6fitc5ycsjc7Z-h9wlY+pg zxDmtJxQtWtr+{}1+AkmnK+~{$M9-0Bd=(;JyX7$R2Qr#HH(1krq~%*24jF*>d_+-&PE{()k_mVZ@D^)NVN zUL$W%RM274#_P6#HwVP`O2aaWM$1BnfLyrIF29=}IIOz0vsQuu(RPJwB<_uaA)SFn zUe*T@fOMpw6Z=U^LYDATGDdqd20L3&u39rz+$ld!$1f&9-XTM$wg5)t`-C3L;KOy^ zcZQ5&&Hs8)LLG!us~pz9Z3sHV*bD3+&Yq8b6T%(X@U%z1JI(T_p>~MdUw`9*eQDL% z#C|j&I54`%RK<0*18|3l%YFrrz4Nm#okSG>>~~`Ue^OcHsevP9uHRIQOag)Z4*`v! ztBL{8xpVxLr0H2@<7k3t0(s5M#EW!Lr{ziq^ytpONboVwEdaTv&TWlSL#t zbkQY;grVsCdJDk+U`YF0O4$&dJA|n&HKmmUPVgW=nYI zIf8uCe@LIdCG?eL?g9;Rt(y52L*z&F$iIn?88r%lP9FPTflU$}vn>Fp(XNG8qA;E& zE*53YN%AWgwrWK)ha3u6%%5U|bCY}M^roiQDZ;G0> zu{L#}*4FWf8)LxEL3IVdoJqv-O1)rwwTkNXS#10JA7ctbG7lXUi*kAw>N#sb_>36k zT1f_=-x18`swlcVcXB*gwMLSGKq``DW<~!!;;RX4PC_7V>JWdrKWEKpQ!gdKOQ#U? zsu8cs+_IngW-$O$&$~D-r~7$W-aUH8kQzpnuXKkHw)rL=TiEpaIPl4LrWgCCQr0rr zi4b5a|KoIahvS<*Xt5;X9kMK1vy69#-GOUrc;ORpIzq7Bpm?_eS)%4U`esqEeGol9#JJ zfcWk|IDdQ=Em8)cdUH&P54Z!$dLug3!2V_OV6=&g^5J$ow>eN{Ly|2iuWlOmD zqF`)161eH*vp+km?Gd}svJQjBezhxjc>1jT0q|uvd+}1E%j8SVJwTAf*qH~^El4km zjznE6$}_XsbTNOv_*s0v1I==P=7_jsnZiA~3Tv^~t^pD$-eEhyd_m^(iQ3~uCQbr) zP{Q09zO2+c0Q-w5;njmb01KPZQWa*H&e=fVrQfH$h21`hf3+*$u~(Fk<(IA5K&ZQWH}Cw}AEDXfvMuvgxp* zz(~|G$&?vNKBzJv0rQ!5j@0O_$R&NJTrPoVC`_$vfs$-L(7~M+$*ND5?8fh=6>STY zFECa;DiBaF)~Aqu40cf7#jsV?PzP#vP+;CoMF76ajeBD3Sz_LUR@5y6+jTHJ(SrSUDceW}pa@P8~P>RX|;<2Ah=NX~EvL z3lSZqf#>!u66YTPmZUED+T&t7%L%tD%^$IgGIHaWM1TTK3?`N2C};T*^1>?ye=1uO z^&k&oDI1^Grncq)H!Ddts-F%$>%N9xL0d)0g?|S0G~eOq5++|J4YPTxaMk@F@zNsH zSY*zQ#suF~w+tVA$B%y`wqR2*j8^?@fbIwcobsaq}Q6BW7Gf-@^JmxI@$XlD?wgmY(OThQ#xXxlsF8J-7{jtvSv8Yal`fku8ipd73 z%-tbeK<_t4r=?Rf!%@Ys;K<0W5i2GhLh@!hu^apR0x_b{z5oIv&=R9-Mohjx{;$2! zjCPU>xKcHt=|`bS0EY3;UQ{?MkRWP%y8M&;P~2L;H%82f1K}-T{O~GOL1MPW^Z0c_ zpP@VBm54OzJLwvg zaht*GXHAQMQxpIYdA99g>_lBg_#?Gpi_nh`O`su{VvrV+gCbX95rlYiyVX%kC74pD z%THd2-Jkq;yQ*M2mI5-cr2r<;G;Yi8lmSQ-Mqr{lCD*UeI7hGZ9^7-+rVE zX)T#6pul`LeugnvT;6Xq?pFBs5q29%L)k2#jcKa+Sk>LDLh`>zyNDl_!^&L7=wtC* ztTzYLj@N=)C-kmaiaP)&j1-#@(Sob}pC-Z=`nPd4fZycHj^y-KGxSqWkU7O_6apGz z@Zb=yMt{_P4NamX$_{Kk^4$EA@qr-76>u2C3CNSPb;At_F;$$)eR9Jb-I~K%r>fv^%H$0+o0YaUZyzH3kZp<*cOz$ds2hrjjqN#!J9r|J=;s`+)PsSj` z${m$0i4YU3v(QR3#?x?AWmYdGTMSmN;m+qL*PH}aL9>None^G+1R+m4=)D6Ria*sk zhgT=e;=k;BEZzzfI*7SklGmmb)v+rW>_NX)5Z)j#E)e#q)ZjeE5ZFK)f<1n9yfh^G zvw;qF#syE!UGWvick@%BMi9Iuyd*JEq5Hu%H}vn#PYLA>fd4YPc@0Dj-cb@IV`C~` zVx}p|@-OU+@z1>)=ei17LWD2MfbxIkLVFl5YYwaA5aQW~ch#SD)8Nq*;rnyHDtc3B zrvI6iSxy|YtAv?jnzzXg=Tqt2{rc||2jesiwSt^t1&0B#BMw3rg1#-j9!0*TFT%^a z8V-rX`)%ab>z}fC;pJ~q=0Pw9EK^ulI+3=CH=qZj<+(L^JWG4BK4$MaXc@kE>RU3( zRIaz(%k|OUn`U;7C1xh$^jRwq;?QK)%(scXk8K@sC_r+*n*0JUN&;^j4S_PikH=1x z?~`+q`Gy8FgssQ@>~h6-vfKX{pE>$omC)AQej9jgx0CBzwXV5BFg>LRP6BMyoQ>7poh#UqRfz}S$|ktP`?JRf?JG?l|G zYPl}G7kNmB%T<3@lg*;eve6bAzflBE4vDAFu!GqU^1-_{Smb^JN*j`pYNDv@Z(F2M zRFkSvTYow(ze^F;Std$oSkdG3H8UB!B(qEn7yd?_APZC5>%19rY5)qT0*Z#1dkH0i znrfQhLc)?2O*R9DpT4?_``gxI0T20J>0(Wx+Jsq(r#zZWxJMkFskZCpJHsscYvf9` zQjAX*)ryRm1fVk$y^q+$w#x@ZdEBDwQ7to%eFV-Z5F)^nx!Bv#Pdh+-uh7eDpQr2HUR#s?Z7mL?$(zB#x;0ptgeV9h#3 z8La5y@H)W->4Pk0(bqUPaxGwpJSZ-Xjb!rmIuCA!9B;Y-O>{LN>qkbEklCbDVl2DM zy=r5E$-DX|J1`jx686qI?}6QV>?k!~6!b2`7uQRVG5;on;sSinhhw~6;k10{g5%-w zNu|5Nm}8Ruoq;Da`%m*NeX?eL<+lv+2Q(L+p8l^5X%jpm4p`Ja91;i=N)8rjdPJ}b zHd_)7HJ<3@{qXTc=*S+NHj-ro>h(UzQi^HLKTjN<#P2(`C2iv6e zx12NS=7};~i04qm*|(!cQoQZ++X9%Mf}d`&P(0@AZOzK6Raq(qbX}`JNh?Vn*G_5~ zm4+o6v|@e6nsRl?pVr`zT*jG8rg0)X3L~t~Ro2+>Z1kZbV-)*h#?(~h^_)bGVq@-q zzctm6JLaDk1Lt`$Jmmbu0NdkLj7^#vW6dF7Xr_^8>zq~{@0?>P(}jQw2rtF-@}VTF z9sJ=)qL>tyS(G|MI{oYm`eb@M516WGr0u7v;I1WaY-XS*3gk8LlMI1TenG%b{xl{i zO%mT+zksfE4jd@pG4sRPnv;Df42H%P8Sb*E#Fr0->p(f#hCPa?{_VZxyn?Xc!(7CX zR|1G5B$mb=n6B*eQ@9Ob)?2b}fPb_;uyJn7RxyN-a1?^1rXbCw=~BMO$Y!S9(efGA zJ@A3ouE$jVDiSCHFV+WkviwyV;GU2^Dp%)`-B)zc+O>^G%jn?Bhw)wLj!Nprm}AL} z-x!G})lT?<_ZEcu$J1byMNr`^m-jTu^v_sk?W8{oI+2+Dg z-lz&veIHC9G#HYGLyS3RE{hd1R47W^?b&8}nvpZ^htvvDcquI4JoFhUI~_x|?AemV zB6!qkz^WWP@0h!=0YMR@gdlUo40D`}hXZS9=e0a2p}A)8d?5md57i|uw>f5~6d|$s z`~6h_e%I-Ccpr2H-|6X)zMLIw8O1gfF#lVt_jC{peR9jZ{<8*sfEe*%XK34NY>o2w zLFf5Qh26?a)%EkLMKe%da3x4lC;&#|6p}#_ehT@0`0DwteOSDxuoQxoD-~(>s}#s2 z4-4+;a9=Drmz{)$r>`wB5{6e=Y~zaH!hw=tY^UA_PnUnDTr8>)nORNnG)k%sNCJg+ z$ebhps5lm(T@T^|FiCd5<_AHo!$7TRbPC{u)F#>cx&X^85FcdH7cb;zxj@sz*PV~~ zrpF0MMC)3mKi(c&9Epi2HW9{%qQGc@esN<-by(Cjen;_k_)@z47KtOdEbOt)|5pH( z@tD`7msX&?+J?F4UCC`+j>G+zvD;e}hpm8GF0ZYG=!=SxzSxVR4kiDyjFZAcezF=n zMKg)|?k0*_ymOTY21-IwO1s}Y67!J5U+CSnEGUR-FMn|@)HVTChj(d9)wFK5Ga}^H z>b7jg#f7k}BopCA8(aaYU$rDx8Z7qatGmj-vlsUsTLVyF5Zx-?yXAI5gcU9#9bxG| zUa%?i2Xj^PaNKxP`Z&ph#orwiLffQ6E zRb~pWm$Vot;*6isdy!ChIiG zDm?#>r5m^xJ5F;=)P-bdL3#0q+~wru0h8P(doGj>iH$hE%i&yj zVvhlI18n?|3cfAHIjDHHLH#s~E3_H}i@g3!{a~}4;)abk^y=9wzZRp zUUjSe*x!l9(NeI$WRUpqO+B}x=Hi3a9QR8Kluy$hFmA<-Y+*NMJy_6#Le#J7>%Yz zo^pRzZ}iB^xP$d7lOuH^hW0O->glbj2#6kyZ6Ur0ehkNV!UxrH5DykrnG{oK!cWC4 z&o+~{Y(M5?xVHXxaGc2iD}|iM1Q!LVz_2uj9`^J)Yp05;f~BN%Y1H!6$KOvj(vpM< z<+}fVFO39_5h>Dx4LJGl8x$z)$*wCNd$jjh(YT8px1FCsmOin+H-DZfrYYG}|MCDJ zPLFw9G3e#c;dg&OCq{_%-ZNgguxgd4;%pLzV7|ZYLYKe?mBytS_Tx+32CK^yb)2PE zhq=S(w&khgS?Z-*@vGB}eZae3i8T{`+k9tBFG(|RCeu1V4zoA~6BGVNZnTYjW%qA~ z81ZDHH_t{)9$jgGq4$dzDfCx?C1$USPuDoQ&48}hgm*X*4_LFhhUYx70~S$u7C~9i|IpG#w<~HQ?Vv3AUdOLt8Coo6Ar|+d zjDq#**l$Nv8f!41^nwMSy?3r(zq=I{sFf2Ma!#{q(EG$3B^(zAy2-w*4($d05^ znepBI?W`^7Bo^4)LD0tb79tCKc(W8^cQ)m`JeSyg>c+fd3k#GT06Vk~6^#eOD#K1B zXEn`VM7B&0StjFByD(4_1h+ln)~P)W9bmd}Hd(@y_mmVk=%%TNB{g%!BHt4@cM6G<+h3=S8eYBjEPmO$7uM{&au_Eg^35GU&nzmggGdhMWn!=L4@h2yoyT}_x z3^GrpLzxAeAEz;xG~a!iKMo`7eIXOYO3q%R5jMTWhRGErX25(dtCmc{rLHMOFCkFSmp^javBqsF_kdzmkEP$-l%$qA8x ztwM7^(!=fiFM@G++3qhaASMqfAUIr8^<@EBvOce^2)lUEy2QtdIdo%&fvjI+d*v6N zzh5LDm=W*)Rr39!xmg_6w#d7cl%vF-Z1eETJMlR@kHHWsut%H4N2BDR@!{M28Kl)8 z&6H~cAZo3QzcWs9+auG`<73-n&?cDxXX#;KEGIzIQIZYuT0@b!1Ar;2FfX%>$SExU zDP#ZMH{UfNd5Q-|pZKvu!u4+j!i&3=5mI^2M>z0hv#m~2N`lBVO^ZUDlC>}_xeRC` z6`g3y(wO(rW`7FE5zhz`%7C)VXjsBvGNb#+>N33Fwk*NL))TpFUJn|*aT`xSVPTF$ z&yZk#K;S|f^&-NugFTgZa?2t?m{C!HcC5Lfx@?T}VY48S9Nx8Q*(_a{V!=woo!WYg zFojuR7;v0ocWTQaQgk`(*B<8PltK+5TXK>Ae#xA}kW+-)TdP7c&bFRRn4W!H zCdDY6w)}APx2x|(4B2zi?)%?{!ek`>FosO9CRZPMn1(n#ZAvFY7!&@bm~ibuqV4WwyZ?ig6Ed8&5o&p(K1tZ{R{EA1(*t86L`3s?S8l$} z8f*+~rEx+OCZ?+fd)am&q&s;juE{f@SS8MkUfcalyTT%aFD%BChzj`+G^=5?uLj65 z$>0MKq>7Z5_*`osVcBv_7rI=lPoq*{u#W`-^5jDTw=z1oJi#z?g`t79k!W(A5MUC?&jFyKgG zKoXEu8}hd!l=m_<+xWd-9d_sfrHH|Rd|ChiKx-8j6{47Mg%z1tU=-Qj7@ncTM{2dvzCS3I)yWc*MukwQBTc2N zU@>1@2s{B7xn>D?+>tcv#H46P|hoFxSzB6dH0NslhA zrgg?N$Tp*it@d5oCq6pblvM_G^nCpf-W904+odmj+iIfp|vPysqB{OpRkAeC7ygKyDc&iJu}gwY=fb#`eZDG8$p_U4I^;m0tgNxVX| z$5nL6m-c)vn%(_yp(wx;$i;?;3yPryH-%#nl8Bc3m@7eFpb*;H#AIP)_yGM(S(3Ig zT90^+xa6Bjrt`>?UyNY{GHJ17{^Q9x)B@4OMX?8J{xTQ%9XpYd_huMjxGeV}GRr|P zSRJx+`e%I9LVaCp&9L!pDJ`7yyR&jvgj8u?F`_YDn;J{`P5gmeWNDvKq90I~ndBYP z55!swd1(KAe}?T+f`>F@;WqTHR&%C*J)^OMyKZ=xIX(p>TGTdD$vjkvEo5PO##R;e zy3vYGx@Akaj*R~ymCjnU&+hF%GP9|Vc5=kD)(VQTPvtDb{8I`$$%AXj<#!X-qn}D8 zT&U4MJiN=e@n5GT5KcE#eb0P&gy+OZA*r13=1h;g;`Rp1zfv~~$fRx8Lh178La06t zY0J{dGjd62M?y6yM^G*V?K0*hA3wWP2pCk0(VhTm8dVmUKj{W{T+DF3$H{?kUHP7AskCuK@(%QNW!Zi2D;4hQfORYwFgN9)ndEf za~t8+mQWDRX8bpJEdix4TE)&wso%SyH^G=?)TdGdm>AeL$^L)=o4V5uDTWJO{6XTm z_9bNyzuUoJNZ4@J%?|wU;`edlKmX4H5TLj>IM=hhQUs+6D|!omUb1vV?h!6+NS#wK zKeS5~MC(mK7Q{+L;%yp(li;35Z1Rilg;%0uRD%ANr7v7IWpfIms@;)T<(rmQI z*pkz9c#*c))^RoJUurngr|E(qr%b!O#0!|n^yX-&2r(!;j)98rw}mc3K}2b7j*RGC zmZ+QAsA+cpE05oj^L=02^5u83k@Pc{e5+Xop`aAH178yGS1WtFGhEHKOu@_pw3uGS zOY-;9dXxhCJHgW!cPDvrXlXX*_F!u3*!y_0SEK$hPE)&Q4pcG6_j$`1iTJ_ydE(JK zUP%jA_j06|c5hTKDwRefc26iJr8l&wbKGqr%8a7uQG)q=Vg`>z>n9%QK6Uyk+lrfT zfUWITD!+L%@*?Ce%3%(Y8pU?&67rV$W;?phRRSlsGs-+IQUIAvuXN;3(}^^!qSB6_ z#p&Q)(Al8VpuYdbxr0(zlE0Q2cC*9gSA~bgM=gpAe;I^2hQ_>uh6ulj93m7)6Bj;O z%jnTbiMyQymIWtAgZC9$;`5_9=r3zGN&C|dB|Yyt0(Rg-{xc3|0$@8U3xXdA1aC3T zGYmeCKZgc(D(c3*E2M+&_K3=nIV2uanJsTl_2FT3i{=9c%Z3z~sBX&?%(ZM>orOs;%>HW>Qk--5A4uX(vxQuKDGp0^-O8KOm( zI=XC0h$)znT-C}szu5x=qOt_3Rt3}Jk`Jwsy@)`k0voZXe()22kyM-7feaLz@Y|8F zVv<=gF7NJfpWI`s5h|nF#|X7-2a%boQc^ilxml5zimf_n<-0>n%X`#aU)SIY)Gz5{ zh860ub)&B*X}wly>XZ@}+tE=jBU(QS6?sqt9*lX8t&LWlRQ$^2?wDs05Z;X2Ek6I_ zQm!HIs0W&?uhWdL+*S4RZu;{aI`da(lX-72!g!eU{9$se{pE3qpS9AGheBkIK3LJ&IB8VTfv44`t*cAg&ftEZva6is-0jw_ zQJ8%R$UnAN_w9OQ{aG}mtVM6w+Ooo{AY@kz5=)ck7o1 zy^TH)eC4@R3JU1)XTH(67%(!-+``u(p<_w{q)@F-)k zrGu|&9}d1h9Da8y&@;VCAT~TTk)18Gze|sU{fc>+QY(MC4isq;0KXfil=u8VOsLL^ zp{?8Bwg6dU_IzyL02lU02(6oj-=20pj%;olvwn7ZaEVHxow*yc(4@E`Wg$8akVkQd zq4BP3x}^O~@j3*3=A2_)+ZxO(WVm;(B~R#*o6$IYFy~FU9G#!b%cH8XgjP7r)Pa3R zI6I@jNZS*}+p_zps7s*ubojn6^H0IU@`6?3oLeKPPCmGgRFAg#z_XLj``_Ul$?`(X zOM;?LuAk2T_spC??CM5vx{@HpLqOxqpW(1MRE>}5yRE3Y(X)o;|I{%vY&J&)P*k9!H1>!BF3bn652 z@c&Yx%M2scymB8GILN}f%&}b9E%tv&t)w1mhpx!RdS^?N8n;~urG893V5Wv0mP{`n zi!+o@X^EmfC|km_j}-^Bx{HvIqBFCwg<@3ppZm|0!Tz+XVXh{BuLTtHi}Abc!n!uG z@TsR4dQ(Q-n+lv>Z=xjXqUFJU<3=Z?iJ)M#B1bP4pGfM^eJB!JY>`#vTVIXl|1t~{ zP+a$kCYSvncQ~*E^@rmo9ea+)6of5%W{TAo^GGW(=#i)YpX;pVNzvw3oZU|iy;QDL!^I*QdEdgRfaU_uT9DAN_jEl!ILOa zcD;F9lVFB|ct!L0m8@^y%hXc9D|o^#HiODWwv){z*#GIy{D=1-h>JU>`opn*b!Qtt zv063oIk`ReEzgO%N>+w3q(G?zgV52aalF8%R@cjD+fC9a`i3MF#z}DI8nM3;(32a@45bW&vx92q;+G<1={-Eyd%N8 z7{x6turMZO%*Z7)X_iE!w}g`T2bw#9ZBe`L%*qR3#R>O7>o3?R}qba$iDUDByYNDE3y z?F;Ywe%@#Q2Ydha{=~P7bIx=1I@YmfmnhA(L7?p`SrRIx6So1^Coj!!I9?KHvAEt? zG9;+HN&eu~&W0Qy9d(%bK<8(4SG92j?%@6D(a}T_5gLJF{-|~!j5{l6Z~y9(q1G!` znS1S<{F&hvl6^ERt3N`lvi!{x|2QUzkWX{l9WHf>SeD_IY?g9HmTaf)TTx8+dJ;;S zDH*$aC*A|=KoZq?%$EzUJ$KGZ>#mo~PmBUSyl354m-bLghrQ2|Ec1Gchk$BYcfLNV z)jE4*P^aqnjU@0lI!svpmDjc)njIv`W_JK~6FS6zrxWBJLhKpSkmqS_H)ZQemjpHq z=?|1mUDAG5PHT5BrD)|BHMe86E!W>JJs$yJmhsRBONG%?6{NQ5L%Z8X}-z{AVI2N6B_9U`jw>Ka#L{=M&1l)HshA8v8x)6}z75}Qj1ihM^o-faK% z4G#djHGeO@Et-BDg0A_>bq@kSZ}W|PG|kw20xWRlfFfMjy_P+meA8y_Ty`HPpd^a} z|MY9}#3aB2k}yw3j#`U{x^|e*PB{8KdS_x&)-JA?O$7$(EmYL*S*~of&zv*g9b0H9 z#@q135nwPk60rYy^>im^C9sP^>=Mc;ant%5>-FQnb$XtqHZS#UAucZKEXUJgb@^X7 zObOv#O9rm!3r_)OusDDJY`ftZ+E6mvlW*n-=!#oh8@KMBK)14y*P)Z{bHeX1aFW=~ zd0merZrDBPe!XV`-5o9_reQc!mbL<+L{CBn0fdSV{c`ixlgr;xTVMMmE1p1kX1eM6 z{;}Yya-R-qRnbSi+|W;@?&%1y_N?CM-bZ)VUHSN8z4?CL05M8hHiFf2_;=BQ#4nYe zMnvM|kObi;?C_sbF*B?O4e0Hqf-|~gdc&lYHYE>*7Yxm`kgb02(!UoDvRFknX&JQ* z?x}5DW&AoUF3e386-)wK93KzmF#$uzPL&3uTOng3gfECaiRh z@kEM!!q&~?fCj$Bi-{EwT6|Tx8IoIzwQ(K0bpi@s4S}vm8nBFPF*|ID5f0*&JWjC) zaqL{w3pVOB(c}b0rsu~6etA5-p!3->-HlL3!0x~SW`PXeKs$>`W8_%Xj0yRNK zw5`^9H*{JgI%Ck+`wzLUlAi83=4x-fC#27HBp(&n$~yE!HlMFwy}c@5ApXwR!M=On zjDIw~>P$YMa;0Q&srq$bgp{s*2ut+KSdFl>XgZuOUNvs!ddfV@M47|iL^%##mY1Hj z5!5`Fon)ts3EhJ2YdHC97q8#3j_(D(-+yeBRRy@ysZiiBzQIS+u~NpsX?7t3e)@m=ly`jP+5hXAS%4ndRHXM1(rDc|Xo%)R zx_2N^j{_}oD}$_d`D@sB;83)PAz-F`@{K-7xNmP>KDr*BO@@tvn#V(rqxdvE6EoyV z`yxx@Bx#Y*n!$8%(`A%l!zEhE`qI^D<4C5DmAVjZ0y>)_kMK+OrGG^9p#snt4Y|+J zw`pfVG*^7zQ@0tCaJ@sH<%m-VKSpall&B55`LY))I=neHCV8c$4v&3Ym{IVXnP^FX z17FD^{qtjF+Z=wB)acX}TMc4~wWbMoEmB0ZJsElpSE2w3Th`6M!*y=05+(e7K zG9NGOmgFm&8z0=B-JYuC_bab>-#_i)Qc!$W^X;xX0~A*u-dPZ|?DqxRf$vF{V(|VA( zh$LY^X0oPUz1*p6{BBIJMY1^Y~0Xw|ZfepN=HE zz#Vn!zDfgxtnME0rUv(>TL+e`Hi5c~T9St3fY{cq|E)3R`~)8B}5WiG8=S-sm&^P#=EgNG^zb@pT_)VvYx144Evv=ZH)?HHufG zu85dVTfN%MK3?(K2QB_ti+R5AD=w&i`rNXX-~N=Ec8%8zid?q(X{ zf%f$fhgHzIEMJdQY9@|_>jK{wij4WE)M*8!oi2fbHFMwRBPLot5~ly1NZGGV2>zPwV@f_zbCjY2pZb%+5w;b$I3dkr_slWX&yC= zB}uL04>B?z>!@#oC*_x8xH_6L$;+EkRp>6YPUu`noFsi8MhNI0xRL36yao&p(~fpud#%N-J(2iW8h|ugq3@mEL?%a$ujU-#pxQE)okaW2JJoz(VchdIaH zAcRqRPgEGlG`|o6w!nRFVL4NA;AmY1wrw?*nejp?${i_k*8zx*!Nb?zqjAxdT7y=Y z!Bl0X;i{2ItG6qATtSGyQ$2?0m9{f){P-vPVMMtZkjvxN`#A}xPDT5b^Q=NyCT0Dw zT6xBvR%>?RFijWd_pcq8x)H5dxJW3}0)A!R?W~|o4*PVZWkKdM{8C!zlS43Hjd5!5 zy)6!lV~W*C)6yEBHQ27tB+Lq>DYp6Hic4Mf$E4RkR*d_u6#qznzm2mYvGTc1deH6V zYJ)N8lcTq+HO}OKV8;>MHIOuc*@_NDXmRuz^Ltkk=FwS)b%U)|T>_+QBrk5WF#*C) z75m7QxrRPAQm%%|swsrIqfLgaA);H&wYUk~=}Dc;?)JD_liv~%k5T@F<-8^T5S z_ld5>sE1OVME@0G;yWy9cwb$afm}JfYXr%l{ANcK#-iBYKtM5+tHgv@r%mcM5Jf0- z+lobgJSn%Kk4ofe1i%Q%#wAjbX7b*H4fHVeBvef8!-CH)ph3aa$p8ncO#z`?SN#Z* z=|(F{Go7Iw-Dj?3(|n)fu1ZpSC%X<u1EU$lIf-12ync*?%&&zZ;R?5*1lDhTzx#i!vk_Jp0Y zFKFwQ^8hZ(tT&!=akRY`-BzwVVBT`V7$jQfDFZQy$GM!Bf1V+(94o*wg&!+OXAD6{ zwxUf!A&DR)9w3q3V=hD+P_Z5dl=m4HM@G?Z{!c6^+R9eW%rXBl(tgOivzo;GfCVYp z?E#QG$SVdbMvy6HPhb&{{@^QKWMyN6Pra+uyb?Y3Co8|Y7_;(PrP2w#BuCdA!1t%^ zO`sIjEirU&-Y}X0)HE^+K;8#hWI_+3~T+VrY+5j zoK=xBi%OQw);9{X5;$}f@hUf0TYd>JnU??#OpS4|FXd~kJNg0yILhL>>7uwz=h;`6 zc3G#Uo_K=Tq(tY!cL$q9qbL&GkeN$7atm?(+s77F+xii&x`(J1TAKFbn zGhc4`6m^Q7F+dCTs;fy4V%w@&<>6rIiXNg0A=RAMw@m(^^@4Cv0vW3o`1L+TLDL5# zx9QLmJPhpon(HvJ{<++!#DJiKzL9FrX_{by1|aqfh%0I^ zMSn3;A(IZ|^ON}k0-q2muDkRs%uUvn%`Q>mPR)$uX2iBlvcHWf=dyD$%WXJ5S+;xP zt$3#gq<5A&G=lKB!F5B)&v<1R%1q}GUnX~;@22!y*>chCI0Tv2;Y~t36YyoZu=^*-AF1T!M8<(3@yf(FrVdAvHu zoa8A4(MxI&!qpt;2pBGi6w4G72EoMY6bDd=8j=|gQ<8NRf**wQ&S!X~wllYexqSCb zP#87s)H78FdikxhjmHG-qClwe8l5~ENM_!Gb!1LJIfjKALUTL~j45n%Ps&13b)}a0 z&Cm55F_cy3p08{j6Ck&sAEA^N5MqLLkTqo_J-*#BHT`o2E-wmj!koNrG@ryz*WZ(Y zw$*Q9*`~%=346&=hrLuXmXL0eXmaC80zQd%7RA zAKO6wyrc{r>6rfUgXO=mJKh~I0*?~4L4;= zups!>5_${X#fb#FhzkU?gBc`jfXhNqifXUavW-#3#CMdr{*=NHpAl$N7bE6_)C)(i z4rR!3Z|w((KK1SYZoAeEqDaK=`&+i_r5``dYJg|C>FpuZSqDVY-Kr{8N`BOQaM*|R zGjzJ?R7Pr7B)+9)Vd(4=;c^Uwj=&RC$?l@9 zF%hAXxmxkNj#Tn9dUO&>+NwrAfUmuz-=f4Ltkiwv zU0hcUPv@*ZeU0dscCGqf|BUqRpW$xn{=nQ`uQKg&*qJJxyiq#Tv)TZN{c6h%8kGq2 zj0-uoA0Ni6_dY<%NibhRI|(b^@3dfS)B6S#40#=G63e=xwCB(%m>#Z8n6H1Na~r=u znR#mGJP9?1{7eM&+JWE#zMi@|H@#_$JCKkXz&zDwg;@13l(^(?ct)C$^_D#CW;^1r zPSyQ>r~ZT!xwX@!ZP1MQmhv~tsPO8IQTmymw|`x7B0Ac}i3KM%G)5FF(n4MQ-5^2( zoWhQ&BhhA>0NlE~RpUomObWsQA5G`V1r2+$D0Cznky@xKWR(ApxQ6~UjE5v#Ztay8 zT~I9H@#2qp9ZLE1d?Qjb0g!G)_G$N%4NH1qGgvAWrNO9}mNBdkb}I?-J-b~aevcljdHxmNv!xkBig(JYt(KD)It*;OW+66=L9RotH84B?Jq+gE9qxXT{F%yhDS z@T@X3Db6GmeTYB_JHHCPH>1cx(8C=|;p~~&ga<(yE(COQFDV;5p&RhKTpa26MOAxy zDOr1jw!@qC+#kha75(Ow;Htyv{Fs8wd6YUc-gvc@bruyv_+g+IB;@0D`8-0g*CW}O zJU_Zln!G#NIQmkGw3b_$E-L<|X5i#uXSmhviHX&rpGhL4uJ(rs33I*5dTBbTrCHIf(4)t{ zK@mi)-pA}-CD2?;WGyceKQkPDMX!ZR!EdK7(`*^TLf`=LhDwrgL|;yDJ%m~6{|G(e z=7c0QhmT9m8WQy>NJ7;RN;1q(0do?Ms5%BFk;tTP_kl=*AsDcrAR#P?uw&VK)~QVS z18w{Awi*omsjVtvrU`Xf{2;05XBe0iE;*1WIUX3+NLPi$N;t8Dt5BsmDS`1fZSPjg1%5dMF@~A`VD&GtATsF6k+hDfg5* zjSDT8s?g@eVv`7JXTFh((0f%fij)r~tY1wUXcS!*HKE zL5Cq=?E@KF9=aX3@_CokymTg9$$)%Vi&1VXHAK_4(O@f8hRUqp7)fjhc3)l<&i72X8^S{GbRH+(usFfwhR0v$1N1iTB(xc5MYe4M&#jhqJAR#TcO)ro;byYpqL0r#hrH z=8+?xVp-#_e4o90?!r@?P;4v-V?LTZ)uct=9Ok~f+RAGo*WnXL6zWd*ubJoW<7*>= zf-&{C9Djc8jYU4}qd+B8wt+I7$X9Y_fe90!7FGu25PCBaf@%km^s(^`2UWE2HemR| z;!nKx? z{$k+ZH80AVp3K#y^Fh%@sZ93k@9#WInS+zLK!)+v1c)Mlf^s~Fi>EXN@AC5FCVjB> z5#0G*=6K!PeY#P0p)S7O(`WOXYFX6cJqT#cR~s$8;;&hXicB;PY-w6mJ%)@A40@`YVn1B<+)WGFl6DB?L_7gEqg38w?rce%3I82(e(Be2luy85%^FC< z&2cuULUdYmOLN`!E8{S+%Q36!mLb`2(kef}0Agy$KC=DMgwN02_|aLd+H)g;NW+89 zXPU@90$$CJTBqcJG;BJjQA8ug3?N}+f2&08C6v^jN&pu}#62!4%;Tx0nUw(I3b_1kLL0%b8bg%Dw!hth z|D5C^28z%_kkxK5nuP5X2r{m7ADh5cQ*b7gkL_h?Tc<@x#u+`TCj48?eoh$MC9n%Z z73U*7_SElr@?1G+=@OoP^U})CwS6~o4Urv5PXa+l;zIhYm4oY~h8TohT$gLbR{RsVLVForIR5`Ghh*fB3d=to3sUuAqM$I)Z#E-g(fKg<21}r`Bh>0cb z8(;2WEr3|B**%QBiVkpnKa7#19{`SXN0g< zWX*Em`4_DF^u2O0NCUzgBT`OjXknTGQSS32ckn|p9oDOT<>&1Wq-s7)4b4#zc<~s} z#-o#|?|&VZm2z3r%T1jTE=dqS_3~uCFX4M-Ep~vw% z{Q1GpmBu28Mu2)>ZrSTY>@ZLoFq?CnOvfeUC=0rqm|g(*sNMXA3|2H>#H|Ja|FMoKDrIpZBYhY#BvYpWru&G$phnw^v(|B(*-FBbnj`N7-cC zJ`!R@y;%W3F^f{~Nu;ekXt33S2uAIAY|Hf?;!5I)c*Eb{=3OECIOHh|)emWVr754N zkm;K3FWwvdQVBFKsE=QS1oEKZudA!K9ous6j%aUx(R>-OJB{_~4&ETBaR9vkUYKe_ zch0M>^8t0GGXH`U72Z8-NnQX?oEuGny+-n)`|Db~1S-lu(*=Vpyn9Z>)~RJ+?;F4- zS#$ha9BCQh9{u|Pc0T9o)<}%N2X~cIO6?!-)VVZ1&m=6ZmbGrY|8Xwcei%5bG8?`! zSfytQ|HncofkH+ZgiEX*;lLK(6Wa)V89h50hoQ69wx|ZmTlxbOI1BbBmkZg(PJ<9y zA8#{Yf;rUMOkB6vX%Aeks(9lRXRWhu?!P~>KWy!AWf2o{F`)3Ty%A=7a^~uTR<+MLRLD%wlq*M5aI2l$wbng zZZr-H?%+6DPR|#$=qZNuuRT{A);+ZhdB$TL$-cjy*6m^Zz@HDWRqgT_ckV@jh19-;KDq3_n~ghWdP(+kBcbyp zxoD;w=Y`6utog$$#iFdftv(G&{Eo8UL%8cXMhtmHnakh=C|I2!1cC=P zUg(acqy^1u8FoL2Q*6>-mqZa(T6g})rZ#Syvv@!#NtYnPwcG!K9AIHFH>sk{nMXq? zGk6*3k1+*URtjU;NVLLsYRap>n@RQ}snkzJ7w=$iK&2uVE0HQE>?&KAf%35$-3CZS z)bHl2&PW?lo2#`vXO-^toEqrsRjcMufTpL#9YJSRzJK1@`Em(muXg|wGSZGhR4H=H zXOKnZY7nqnJawNN3S#q%FE>Vcv14Dx5shf(>)mWU>d7UI@>g22Xx3gbV35K&riP+2 z&pvZ%TG@ZovTzx+!EP;xmQz{``p`ii1^LlbS{MF22lw<1I%d$3d;*7jopAS&e8H2? zbQp`!j4Th3NV=}OZDE@m&T zeH~A5=@sxw_-foAu&)d*Vqhs)K0O6TO7lg_0D1rCclQ>Dh%B_;ejhbML0Jh5DZ@2k za*3-a0b|SWPaXG|x-0Xrz&U{$wyW$kZ=c2tla|M(PC9~-()oBahYz<)*qG zttNa6(1&dmbV(=;hetW+333PV>jeQ9vDXmvV>XiurFenB-+456b~c*NYBDq=)4b11 zzh?hJwY|XRMK8{0Pe=s;4ekRAD(5)`j7;sCRompwmOAPv1~+?~kn?XZfBnw0x}DtO z5sLQieT?WA!K7#@gdLH{B~n?u@$E(MBqua4l;ZPKhzj}IdM%0%zx6yk0ijXyVu3*l z{kaYfp@aI9_I`S1W}`${^hg*fmZ>bRmQ0C_tv0V#S!8t5Zd{^bC77*&k*#Rv!GkA zc$r)b#d>(3Aj^~IE`OOcSY5;mcGwbyM9e#G2$w&n=Vi8rOh@klR^~)qg+Cs znVm(}rDmV8Lm6F|LmtUcyXD8?ZR49k7rLW}^73#Hn6$__t;ZCkjYl<|;Iywlw=HVu z`hBVXJ~vJ*kWapm)z`<9nS5O&yi=6d`6(V9{4~r4^f*$TGKCp%RPmHG{l5Kl=+3#+ zKfHso+$UkCH2w6KRVo=G{6!zPBR*|Hne;HDR6x)_PgyEoKypn03RKzFsR&|xBJNk0 zQPGFVlx}lzpZ4)sUQ6>VI($hsf;|iWsccwK3tg8|g$p4n#q~i018a2c8;W$GZPtB^ z>=-#hS15rKDwdZ4jggcd@HL1zVa5~QZbCF{7YkdJZ!c@5s9|YEPYOh$z&_muspH~M zYC1T90x4?ohH?B!Vtd73>&kIgaU>0I<>ke$b;sM(7z~)V-d8HOhy7hHveN@0!383x4tZ=p2iDVN`$6B{wwR4M8e`c z8Qt*1bV(6O**$1m*-0me6cWej;(#;Q5%>3~<#$h^8_{+ms)Ekhxb2qvoV$(ew*$&x+nsa(w%#*}<2@+A}E1Fhdz~Jz9h+U7W~U>6(7!NMoBsFbh&)k`j=j zLGn&4pY??BfPdO7K-mz6?oI|c?mAU;0u?8cEuRcZ2MK}a*oq2(FIo1`#e~}|rt6w2 z;9-YRt}%zM6T;|Ot~3ntdaVp3JUq+?=t1(RSa0AK^de1_PRSvNqMGM=Z2D3e@VwGe zT(@`aB!7ia2@7b7F}OeTXND`@yByH!G3tf!%p2Vm(e}s?0=X3ms_;RP;?j%QL_%Bo zQEt^FAvE^xc;avp5(N7(6*gp@P}H!&IzP6k)M#gpQyrF7cUSY2yu%NDG&lC-eOv23 zImwA*i!}h2ReJ6~p{4Ltdq!xGV1cE$lrEKBl||^&R~>jaB3=wdC8v`?+CXnBXPJ?1 zkvbW7`28-h{d#5R)%yuyjN`}>@>WH$is$CFR8jO{g!~?V z9EQ>9LI*<0o$a)zh5EnR!ihCav)`~%97nDbqHSyT_0sNnP~G_y8^OB@zF@=xlRgsb z(^~{5rx7`DYl>4-LPJvEsIACU^3KS0#2;JR;jk)?Fg_5Hskr>8M!^z3g<$7}8R5CO zGo|!q@BaI>v%9aI6$U>Tx5JWpd{o7FO^YHtj$9C#mjoligshSa9zB+cO!a;9Ncp)A zJ@7pl01-P-E22!fJX6gAy_EP{5EVkJ2fp)LE9aUnxa3LY_xG%G!nsIBw@1icVYl1} z{&mDjQCV>)io3Xkg3TlBQEqf^7x^}LX9rdDRt~wE>Zs?zk3wAkCqzPM|6z5KHxF8N zE8?k`EGKMt+N_iul^Ze~q<$4NOz&N5P_f}Ri(l8x^Uum%e%j>2!GA4QP1$d!-CLIq~r0q^WT})A_-noRYdtFc% z6#3@aE^XI&hL8Y>?dsTFi62PCrGUF+Cx{<$!q7af3`)uH(1j4-F^G&D2npPC@rTK6 z1Du_;z{qcJMceV9)D3xRbwP(IZOYYLpM=#N)6>4Hvu}dX@|leB;h!Bce{qO&?>lBh z+x6)Ok$4XjsoYv}46kQwQJzbpDV-NTQqh50%h*1WK~o`;9(R=jc;tKF=PJTw*kiI4 z9{uzz*a)FDQ@jhcbwq$`pZ@ErHtD}Acz06UJLw^J3SYJVu28EUIJsxA%G0`rQ~PT) z2K~X>L}$MKN>?qaBmhV%?eDg|fO-zRAChIq8xz`Yt=`^vS+0sstz530EzEwr@i;1o zT2th37*iDZAbQAmxki?UL(XNZ6ukizk9dl_RH+rQDAB zu1NY+tn8?Saf4PMmi>2J?ITvlDk$#yM1E}c)?chMa8CGLAvf{yRD&bp+%TYio-5GQ zb3*>PnXqH(J#rf5Oj~%ji4&q7fO2UNIujokG(W883EP*v<-Qy;0ULW89V$;^ zd0uwK2|Rznt6(OSoB3Ai4I%DiAMtx8W%7%If5ieYrixf~k8;+f;eP}SoLWZ!?4Myz zau4K^Y8VMOIq;1nM8|f$m@|J4X5=B=JFbE7wVFKW$UDenTKr7m)I>Mc%Wa(&Yaj^K zbo_jJ1aQS*Pj&-kkL7P}Rp|;1%F#I7-S(|HCH4yi`0sb~W8c0KNYem6L>Gkf7By7| zsc=(&fsp@6K@0l+Bs9WfkiAQpV4aXD1y%5tPsGK6xyJZEgD^~J^HgR)RssfQxR1Ne z16vxT94F17ezInB{IhFK$;WJ<@I46hlM$Y{OFF`Xw?1B)m~vzAcFL8PZj{zKh`vJD|+X_ z?vl+|DU6W!bctf|H2%*@h*vMvY7Ly`4a`!Wh6Oo7(4f4C#QN8Ig+GOol9E98W_%SJ zUkAaRs41UNbpJ#u=Xwc@3JJ|?>+FAQe(`a^;tBZ(CdgDJ>vDC`{;!Yx=Ra_uamX_J zFn>?{3ScG(%-%}PuG@{$>o}-H6lGTDm8ma$@TeIGRLq?>+y)0s2G!y|N%yg;nO_Np8A+jF>P2r`diXGh(D*C*W<7x@C=1ci z5-RbH4j$s(rohX~w7_j5vxU9RApqj7E><~UJ@Q5=vu&P0rTAb!1as}pFCu~W#G236 zNYqZB{)1Ql`)kK7&~bjst*WmI8+Tn6F9!Go848T<))VK^Rc^=rn+5sYGbIj*F;JQf|?mv{M4xYhrMEKSX9+a~|#3Q*;tLx=^4 zlFAGRCayxgjmyup#}UU^7K>BOy!`)QD6O%CTMbfQA4 zT)h4X=6Kkf)C8JV5)~{QQEBIqf7}p|zEYv@jG*L)~>?zV$WKYDAqItC;0nK%h~?_2&XVTVA-`}IY$`?V8=piSq*X_Ru=uXrXK7l zC!mQ;$GA?Gl>3t`+9w5zVVsg_n|a6w+z6$iOAf>PGoT(=gPCKoEI+vC29PtnJpm{c zL&T7Sh&Sz!ONaTIo{E;85`sWxA9w^#53ntP;(tHozwj|M{(COk>3vd+*sqMSE;}(E z@!)T=_yDJ0v7cT3;DHaC=ijb&} zf2J$nsBQq%*%Xu9o1oq>t@kzs*R@#$%9H#^C&C(EfL9!2`r^(IFePBi-O+gcs}gs? zv!(m9G*Oa0mY}oN)rU!ZCA;#+k)vb_nA3tK_LL5DYJYm`UeRNJGpw~zeckW#BPSw} z|M)cfp!cYcAz?&ZspFqg6z~ojzF19zt-oVo35w{=$`CFZLI-FU>Uo=rK)Ut7(;`VV zcGhM`L^R==ceHCX)7Vb~;sDGujo9WEPDSZSOqR&Tpx>1 zoohiq?|0y-3~g58>q@1L&j0fZ07ohHNnWq~o@-8PunN-l?NrqIEGMLSxTFkM{J@Bh znZ+&#ht*^1E5Kd1NN;78vvB75pN|E?7t^~i>xmkJ4z6e?uxJglFlBIX@asLTqWhi@ zOaWzSTu4pmJ~D5#BK_5mk!_6Wo4IOp*+;4`ehFg2R%ib^h7C2)qDqS}nK)&%5t_Hh zz#}J?IVYB@Vc!1Mpu^@^%CqsZPX;-dfu!}UGd5={<9!;!^VB=_0j(*#pCuMG^AC#t zujUcs0~gWL)iE!gwA_A5ThyujB4Sr&j-P5q_4W~5 zcxYGTy)-4jG>WP*HRrO?PZO{rH#K5 z`=2%d1foPCoz-v6MmsM7M8ZGv{Pzzt`CZo*qup!opX}=&&*F0z_=&~ljs4#qBloUr zYBTQF_n#TLb9ITBzz2rD3;kjLf8%F6ljZdO;{y2SUj9FRA^-m+{55oU8uI@fNl3Qp zqY`OYVj)~O7|-EjI>>XqdnTaw`~!7qt-LH_+i0%%Q8M|QMPssS*KjiL*Jpl;kc`E~ z#R{WV_9ezsH>QR9(q7N$Jo31z&bd z17>f56>Z7U-t(Z2eECQr?P*1=8h*F|Og z`$782E8HwUB0U{eEDVy_8&XFM+`lRRd9ot4+e~kJ^4?Ne{#-jw)IfZiTwE%$%qcZ( zbF_Y+O?N7mE{N@0M~SFGVWxPQSC7!{QmfZZbO&JN0B0i*dyngKw^3(t4Q}8#6iePN zC(HWli_(nl;esti!#)H+_1FE>3*XU5$FmErQS6Pv9=Ciw6TrO%q{PuLuj^x^x zTvLlH_TF7-;McEg^I0cwf`Q{c?wG;Idk%1Pi_yMf`LeWgMmRf_oS9dYhSLXet&xN8 zn|W!woXgKzPxqYz3aK5aTHIOIpS5xPjf|CW?)RHpFVhG{4!5^?)|Rh!bhSv0qrrxJ z^0o>EjwX%fMC)nq|%^T0AgW5JmG)_iAUE z_9CtKdbe$Or(_-04zO!y;fZws`hyl zobVu4Z1NAacecmDig;to9mWihhCPCpFY3EkXPq0Ek}DI?YZTDA#!3YRm6o50(h}R; zNAC=1q9!M3C?3n0q=xS;kHk_4kM}Bzq*y0%JmYb$DW}!&G8V~kV2dcT{l27UWUj;Z zesRG%vq2S?m3s*huomd>G;KzQ{xn*!*Jv_}7QQE7QG_RQAhauNwjP*Y1pm=pdPg!$ zuW^hu6F?#r`KN91=y#Ezt3f$nQE1%m@D-t`R~e17 zEAnZ;;v&;Sf)@}p8)h_bRs8+wJl~WoKB{TooOh% z&%e!h4QlT$5q)?1FSfwGf6#5;;M5qAT=tmyYlgu<0cgOYUW8_@JtorP_N)IFgPbrR zbi0%VhWBp>Shx0Iou@xO1pAUx_xs&c6C?DXS{gaZz7N^Qk&7Dm&xywEi=&lP7>lttQrJS*vP4ok2qL z&T5mQq4Ng4p0G=+_te6Itble7U-1@W$AVJCbazg_iMJY@jfTg1>#?J^ug=`D^V(-G zVf+b(RwRpW>@d+d-`AY~Y$wOqda`T(fFWg1)Yer2w1DyHi0&WZwm_#%!sjqH=c=4{ zXcb{jdwHKBNt%ZxZ(t(8ckYP(a)`S~QF@V!$9*M$?JitO3UmSPobJAYH|D}$;j zDY=J=`=Zf+OzYk0yro&r1$Fg?7*} zDSJMZ{a77}MUFs>H^U*N`EPUL3ODXbuC8+p1Mlq{oNM8=R*Qp*)FnyUpsTh6KHKi} zH3`val6S4yei5Rt+CzBIaG736@+ zwci4^CNTOi!GSU@+Z_fFop7n_Se7O{OL`5qUnQcYrHP@f>D|> zjM$ib>+4!&XLC68j|=`mZcv77(n%d07ABY1K4lYR{&=c}_|&^7!pI|RD#i7XohDmD zemT`W%Xvk`|Iqc0eOH)j1a0)8X0yu-yTQdAy>6|Z%eaW(TWzJ0a&|GJ%d^@XrVP9G zUidHV=!aqgD~W%j+cY`Wtd|WlRs#jDX$P}#x}>7!()`U#p{m9VRNK-666c!OM?!V6 zQbdGBq7jBN^K$4z-i<~rFvkz#qI251&M&z%=V5{wEn19Y!zAXKtWPvWJSl|c-ln_f zp2+abhc#}A!7o|=T7JrqM`&plS{F+tC#Oq;@DOd!sdi5jFB?x)i{nqy0S>8)2B_+G?*pBg!d<*wDvf8gwIi0a*Tab28~zo z$4`MtHXtARgXI8B3y)P8T8~xC+2}x7Ew%Jk#YGSUEZ_ttIJL#K*ejo1nkt@y32e)! zG)pq79LT}uhPCI#ACrtC{9iQ-mKlkXxS3hQJ!nLRF{pyxoRIVCA_rQ&lxoNx{g)fL z5@yQge0|O5(=LWzD0U0Wr**_%HVx*RdRv8jU!fV>jR&}(@ z)7Z8a7Yef)N_5!V%_sezTSkP5L`M}=E=N4V%?WA2qoM2j*`ih27IHNI_orx}VL6mn zR1f0moc=yOX|Rg{X#=^*Dd&`F+Sitpw&Z*DBF8G&WbJKHGo@Qpa5b| zdi8zcK6Y{wbf1D~_f)4S83$RNfqYxdsWdRxYned!t5kBwop@+FyCXhxdzn3+hO=6& ziY94F;m;#B-dhcPxlYuzdn3iTYU7gH{p!AQ-+j9;Y6X7pr=P_k=*uom z73W589ykuolvGIuOa^u~)@~Z*xxBDfc_kxRE%|Kxojutf)uC7_QEkCdCU}6qojMBc29$_lRV(#koz5GF+nRc`kIr}VNPlD|GmATu|RZg6HheDYd zg{{-Kg(C6fFGBPf*h9;1d6lonJ-c$bdwm_u(uXDMM+$^ag(8A;Zn!IBse}cm(lM0J zsDu#wABBv|Ux+V!qmF0W&Z+cvens<5(de3Cc)mg>2kss?PQCksH|cR}nEbi97~yIi z{JpGcp~f1eT~N2V?&2#knn@q|_Brf;8Jj>M`>^J)OXM^>VcFiU#C$g;U~*}m>Dy-) zG#aIyxWg%U)BXXG%38zE=LXhi*Ac%s>Iu){99<39jZ3+CGvR_Aah&ct{@?45@Y{3szY}&LH9nF$h6OWsrx7wpRgda7H^P9(*t3TGaW)Tq{&9RL!Y?AGi zUUQ3!E}q^jJ8o9k8MNuqE&fn+44yqd$k_XoNmaf$O4S+b_v~z%(=_M+m;ak^XFGi+ z*L2Irhzq-0K&jXIx-ms(Z<#9Wnhb#P)b0)!^-UKFzdl_G%1O3Og`CNoo(6a{bVTU@X}h`_jjEO z$#-{lj4od`)PGib#_~8^=uuZj-Xsr*P z-qGrHXv%9nR;OCx2P~BPac*}d^1iN7zpqevR&BE8utt?!xzS0y^P=8kNY|j<3hzZc zJnNbCld~G23^@Pi#J=3*H*e4=lFVCxNu>(&L&TuY-`u7Rr~#fbzj>kd>1WRXd5?d(wv9u z{OGPRtkLzeJdAIWuD7vcD{P&xnm=!Txb6-(Alkvw7w0|K*)|2hXYL$_?Yb_w#`^Z{ z6MnB)u`;yDwX|LsZxf!J>%E$u0Q6>`NKn@N_{R_vN(*3 z`Essr)cN`HoR`DBgJZ=*fBl9HI&XD8Y913NjMsgjN9}pG&6clNuCc5O=iUfix7&AY zw+-uKs1`8bcvPuxKKu9UZ(X%+r_L+RL9GhMze?wPpFR;IuG1ZgBglD7wiB+GmAXck z3%4G+AB`G4I$TrW4x!+DOeBLoxR3B4;aVPTFE1p}BlL7tvhnMSZIybnt(|%ReHsQ5e_q$EHhiuoqX=u1cd-d!c+TwWxncgL= z*@t`dw(V8wx3lfg{J8!(UOPlGH&pMkdDWe5)lP`5*`V#Zhpb#=HJjGkXq{WVxgY2` zI%@PN;nOo*ZwnW`5-{Nz%|*yFaP8VPI;Xqagz@8Skd6`0+Ld}v^wvFluzqviaZEZ( z;t4*Gwl1A@pVR%3vG(rOCmff}TQ=*yx+=8arAtR$LrNjpDZYg5&^$ONnHSGL?#Z0T z^K{;=)pNhUumTIt2}mZ-f6gb45%(~zg*kKPXuPX!jP76k6@hu{&EeD)N_pU0sg@~jAstl z3gb9Hf|ee=dKi3wYm5;5OYG7$5gYh%VU!Ormx}Oo(F0)Ah*5fQ zudv4+e^L*Tcyr((J8alcTfBHlco6eO#)-U;ReCU#KGkv zU_88a@zChgr&l<(w8cY%lOw!6sSoBFt_K=Zp*=3zUAv;xlLzi7Ne5}Wr*2r>)R;3j zQBGiR9Lfzsq_ndxbjHnv!G+mT{qtae%=hivOBcq7aKSJpbsJAi^*2z2Bo^Ly^ljW2 z>&yjBB`wt&LzUKRSm6Sp4+>)qH*?L0lbr87NVwT^AwoPMg7n9nxDhZ;E`E+L`y4X$ zAdNN74GAIZz-HjU{$VVqE)kiB#>WBtH^{la{?P#F{Tn14DJJP=vW z0?8aSsDIeTI3XuhRXw$AwVAVC4mUN{cM#cMwQ7wXwhO}8wQC@C%wfH5RNJ;~wTVhG zIaoJANG>-Pqy!uEz=KFayyl8bRfs_K)G_F<2UIV;U~CM8A>s!CoUb}O6emm=7j8<7 zhcQA>!2_HY>PEOy4`Uu`y>%`wUc5A%&&ze)4Id#wuerYT;w)Rdbg}i(ISql2^Y5T> z?$CEhdsK%vbzaaGELbGcHP1$m9%+Mz3=cOx#>ETBrcE0IHe83isBkRC>0!g$J1+}d z-;hCGOqMKKYV#`R2V%{*d6;su=KAC&$PIO!ZlYXQH9Mm4>lYy z7UsmP-&ng{Yj*{_T|s9)PQZQ7do?5JZfZQ8WR@7R#G1*M~7d0lIWu6f;= zeltvV2M>)~*lv9;vc7QPlByiXjvF7$?w2|@RTF1(XaNcRe#I-F5R15c|4 zoVlUL7@+z&Ec0OOa&?`5#B{*vb1S|K36a+~xaitZA&RXwWt~hU3oSiSF|^Ke^imFU zcaL#fwtQLn)fLyrI2@6A8yVwzYvgoC)*s_3WIP66U00Fo6~Uc#(fdm~R#eWwxHD(& zFkIAG7k{;&k6;sD_1TLD2=Zqh*ARL6ple#6HnaESQaLXqOQOYa5yEN z4HE&__Gba?>lfBPc69Z$u)0{4GiT1MN{%4y+-Xtmt`j^s%4b?zTNUmK@KJD{#k}3<;nd zy9_?|SNR4swM2AZPn&yM$ib8fxGj*_9_7ERTK?+niYy{%$OF#~ zOBp#tB((>4?clY@x}(-gOmp22GzHQZ_uExGj}*oSOB*@SuQr zi77B1)4c)t9Ra24B?)m{9S>8~MSc#|evKVFCeLnp*0!dvJPtgEn***J)@`Utf{|!_ zY9FG>lfv@$IM3y2uufL3Tv-WYTh`v((@v|NO!ci;v7%x^v&MNktugDEw_$qfoH%K6 z*7ukStiI#1SRO^7ojkt%qkQW6jqFnZEy6ycdeqFx#28?d!^Vvps>fHzIl|^|ZWdg9i_+UfsR>;z11o z%;F;k?pa8Xn2ZS;kR{~KDYRjF|D9@vu=u#?~{8ujlguRk;j) zd!{+o9v)j>ZbX9Nbi?)6r#=R3-*~cy#K;+14Vg2}m{;X_N1{dM7bepUjDa;F<78A+ zL7lLbcbH=3BoNU;basW9QldP7evT~1ix(q$fQ`R<#$93L@2>iv^4H+Ohsv1fE@h|< zIGKxM6@+cXh+)V2`taxUILBe{b+U5s=8a{v&zT3!H^T3|S-> z##md{%<^F1f}3xyp7L?wIdkUB4rWcx`a}vvAa|9H5J*NXudTWnk|Pr#6fv__=^@xb zuh0|7r!{?|%LylxIxuL^kXR>UYDk2Ign1)*I^7nlc}hT^=LQq!Et%flUKIggXK`@J z1Cf^ z#RuSl88ynw#3RF70K9|~2#iUh=y*K45?;}^5eau85tOko-=Rap>*xA^vi$EJ0bVcO zn=K(xysC&LtB=KOK?|8s{=!$R&xr}`k{JYqya5}Y=dF>ez9FZKp{bGk=^=VZA`l^i zh?c(e`z{YFIHZ`~S0#6o-8+hpi}pIxqbL;0PW?gmk)w*O7aSMBW!p0DVKi85cL-dUN#@&z(EBj_uxr zKSd`_KYdrjmI9=S9}a6S&#GtL(6)akW>?E z8D49@;%{jnaE)DV>x$89W1FmZ`XaIv^nKF4wuILqo&Exc;ei02DG zb#B;D!vI20JTe<&F_`4>@d|L`vxuvbiRY86oyFq0gbYF8siYKu-Jk$H3(iEJEdO^# zz;q&6yd+W;C{#oSc>^4*zX~|%GO{=(i<=h+z#v9s47qb1#ZI1C!&?I+?&}+Qr%V|} z)<&a5r6y3?WSK<^OpqipUI8QZA+GA|*Qa02IpW0!bc`NrL&!va;l_BHMkRIQKIfcW z+phgc3WA^yqtk9-9%KcG2{ZLeUX(D3wdQ$)Y9?goE>ASHo{?$X0Hc)nFoN;EHRzs_COden&Ss;rH0lAf9$BeDU1rJs$?6;-L zEJJ6)gj4D`c6H?lnv4lAi;YIJXU{GN61t{r6&oftbam#wEs^123H?v5GWB2o^k(*WbLA zZi_-6QS&(fuv|Mz+u+#*Lm^N+6r$vC`GisJRl%K_5SL{ArOTGaQ<2He#Po|2$Mkty zBpnM|nIIO*(BxtYg#fq_!zI>c6UgSyvU2sx3e1!#!5~~fb7=Acc@Zkug#b`Oi1Eqt ze`5s5B_joajQ)-{Jr-q1A|*F1hqsesUM=8*+{vXuKIK&*fkPvU!g@#wBtkId4$ArE zkwMxRH}mJuuhy)brQIPB^0z2{Yh-7_lat~#92Lb&=8!m~kG%3~tz4Bn;^YOAVV*3F z;X#*JZ-WJbfVggtm#&pFJG=syFo<^WNNRfxp@*;`EPeaPwMxQ&$P@3LXNee$8Pg(F z$cc>?z-?SY%@x4Xmbx~w1~&(Ik(;pr&MhIdNHuZ?VC5>US-+;P?_ODt!x9#iS0+R( zv}8li&JZl&8zEogX3bisNUP8e0QG$Bm~e_bVLL>FAHf3c929I2X^;~Q?9GLozF{Lo z84z(B&_-6T0S}w#3B_Rijor$SIe21|#HO?#=@LF49vnK9JY}I-ZC#z*R31g1>A}GQ zgjzf0C(5G|g16ylNIV2&g`ojcAcW93(s;|lTa!cH>St%t59Au#jDhqc*}F3S`%&oCnlWVP^KG7ee4(D`dKu(sEBXBQ` zK#f3VjlvS%MC*2Gj4*OX-fg<$%p$vM@-r|PxxRB<{T_}Ff%U;A`KI!VMR1lZT@*uk zK;8V*Kb!|=V0haYhB(3`yoK>;V-vDkbINng<}Ja@70W6Sw5F^Z(XR7y5B#?t8SV^Q zn`cFRMOj2^Cj?7|1{($@x@&D)tFYokmlIAX5keu4Lw)QtN^*GsX;6UT)OcTbPV8b@ z89=7A5IebC`w#5RWF|D2glURfxM=g%grWP!iappTyP^_i93Sw`paS`=$?@Sek@&rD z|FG&h_FM_nfN5jG&_Ga5jvO!qP`GJmaz^&&cm?@Q82z{jW9xPP4Upv|u^bLW39O7) zW7Vn^)f%A4ss|!T%q$H+-?@21yb+_TAWK$k>1@8}8zQx5cw}~O zS+ROWRoX)6dm?|lOR2VoNBj1RtoF-Bv&iuN&h=$?2<5N?Au9nqVdnU#O6Qi1+2pY$ zuV33!cISTKLWC1oA%en@a+7&{dZ)fV*XYr_N}qs;r{_omhH=4H*<(P=ZBvUdI2 zn)fp}Z$whp_N6mR>n_#CQ+L zuJw={k&z+8LaYbGdlq7|Zo`_=xv4W)7HsGrk7#gaaR}b_7`!zsoB4xRW1?X6fA_xK zA;!Bi_Awl?Ydw0Rj2aiu#OUE6iMuOtgNi!7XWxPSs=_m#NMhn<4v&b^5e;f>?&uxG zL>`dI(PNXJnQsOq_YO99M9zl{$!3(u0wV9Ej1?DR^#>&Cba6xNJP&B}N+eWZW3`0|yU?yzQz+mD2}$ zrTwF$e5aPlY30dsas=+Z5#R_w@Fq>2Tpa{(d~1GI#F12uq+Z!56+Vz``kGRbEmhU& zCFE=~;qt7DzNv#=K;q!elEvB37F?UPbykhy#MG=9CwjCw^33QZ&+9j?Pe*!{=`*KS zeIjpJ#8m3a{-p8j9-Sy}@W;lSYp%PtIwD|`e>2o1ktZ@)KT8IH8=AJQ|(~1H692+5lZF-gqI$jvXEAb6*8=BoZ)A%phaZl#NlPT;&^3 z6z%Qp8IT-d6OdoEDg-n@HFIV{bFpZ719%F!i-i+;U<@`!&Ls>K0pF6POKLbtl57}d zX`i9aQtOkWCaHC3h^>&=qD2d%)9^nliw9$ z)|sQ9B6kRp99#fXEz8)mdCF~?0vtSu2;z=- zEFE*ivPBeFrSfxX*e0ZL(V|$!k==P`oKco1M2ZMB*02pZ$Qb$bQ$1i?Z0>OcQ&;s2 z4oe-pa@Gy6qT)Cep;@_vBLlo51-xU9zmgxR-8@PNC1b2lpZ;}h-0wMvg@Rbym@*}6 z$F5)@UHOJWjVWxBjQ)rRhAa7B4FlW6?x$8Tavy`IXI=X zr+tVC0xd7PEB#`G@+7O12UB{0z96<8?wdNLtP9~E6;d^8#*FG+GY32qLbCo|yg0@{ zep}hdvJh?{E5v7Dx&DUh>$uOFJ*zz8!i&nOlPA`VRok{~t7GT5rh_3=(iV)_-hKHz zibF((2eW^0(XnJwA9$sOsD;1dVyvD&Br$%`U=Om~r^)~_40qrw64yEg>y*0LW@Y4o z7ld+Ix@2jLi)>8V8jou5Rokb;yFMT?X-zM%k2_Q6cPup8NCXQz!JC#dC9wR{D$y}Nf0gp z<_a<@{OuSZAVray2+BqXkP-*D(~`^OyfsJVcqU-p5EpTyi0vSy+}rw3i#4z(N5U+v zU_9@PGfP{-I=y4s-*nTB)lxtPlnRc#JDIe#af8b-Gs$&=>lG*e^M7FkSclHhbH1U? zG{Vj{Ufg`kE!C)@6nUaX+%9`gEFc?Xv8!uSB^r#MtoF!A{|X!yKiNeffB=GX+rr!G zQ9_6iX{`q*IQfH7@Uv=hBYMQF}+%@e!FoyrdJD(-z?N%ldAs^T2pT z?&`*wJm2nUsQ@!(Os`%62FOB9 z!-#A+*RgJJiL%o#M!E2~BSjY6cvB^iJc@nN1|D-n8KGxb@GhEPb0_pJN0!&H|Bgh0 zqV(jEoqcvI50^|C^P$5BXXpLIdUTMmA$ienV`Af4uU@TmBI|{+)MkvFJV}qxj|sV7 zKj;bTNPgLb;o~zt`-*4)dA0G8o*-){%gGVAw?}}HW*tgLl5Vp*>sMrFaEwowPj>w~ zR$*Nm%fb&B-1Fw09{F!YJXU6%GuCbBv-S|gY8=K>iP*tvat@27&p5A^@gz-&ql_a9 zHc1(gsxl%`4iN~rKXGz$?0fa9YxCAyZ>?=&oWocc0k=eZnjPcPWt^`o(qNrW4+%Zd z<%APTp{`9)#H`zDLFZh%%uAHq(t38}t{fpTb;`8lJ;nPH3%(|8XL6j=M9G$kvHrvK z`^6h0fgDg`?-Z5|Fb)l8`MZV!G3f(C>g+x>ft&kmsX3LD!b2YXkP1l7X{5j?MBaxP z5tiM%oekH!*5^E}(@x9zhXFHZs!gBPRzpDxa}FUueZ)nN$XSy!>*UGF5)z{rgw54w zB9FHKR!RZ516;z0H~?MBxbg0&*Jq0t=e*4HS>C2`J>Ej72|k6Y4r5J`Q+|ric%5vP zx+g__1l_o(QOKIHH*Fvy&;Iff7eYD}IdtU5f$x!AF{ zElScH3tLm1#%guWHbWR#zDQTi$w_JkSp_CQ$h_}JevTgp+b$2mnUp-qr$6Rt7(=YYqSGD$iHZ|wz?b>x- z9TRe)9>?%FV=#M5$|)g=4|&i7v;N{C4xp1KgwYObXU64J!Kz^NUq2pn|NCYA&!85C#Q9TVsOY|#XQs3UUOaAm;a@04vd!nDo2XP^VA7>Q9Ppb$JrNzquD|jq~iBF9T4G2bBH*@C9DW}glJsWw1n77sStsT6O))pcd zS7UvizQC6>vCN5VOY70reIdj{c+`W}QY02HT~g(eTnXPhj!j+W#ClQ42_wOp<0aKk zGST5>$FX~wNG2M z+c?o%@YeX9dFGk*bK`2>_0K)z*}oa#4X)f9ZMwJX&ag@-Pq@OANjZ)z7(=dYn2{?!JL_D;MtY7-b!}~J_0$9VH)hV9RUY|>N7l3>V^SAa zp24Uao%J;+>uLG26%`wX506)J?1YS2&XSIvkc+vuuU+0bTQlByxVJXOtHaQF^{2N_ zuky-}9h}^7b=%Mb$M@~tSGu+)`jAu+SaPDv2`7{WeO$m{+?aSKhYd++YG-v1Z|ckm z_))AQlDN(ixM9T&mF+*|ArHy9+3nS%g53j63dSk+js)R_q?CjRz3jd#lWAulB`{>5 zqkWPi6wuodLP2p-+*5O)Fmh;OZd$vb=0OOT`wjt|HDh)Ka0*a3rz<3NOF%|QZ_e!5 z(Ll+M$N|O{9xSI?%8wei9izOa%Y z8#53vJ0%w`Tv(IX|L_n0ux^@A8&dT7&wswU&@E`;&Ud}*U6s`I>}jp52=({A_r3D- zpZ~mEbImn}0RhoczW@F2SKxo?OJ7>y+^AH@cr_azbs$+(wB0c*bNn|FS+EB zstEM=BOm!lm7h1f;SJ?UPkK_16@!f(ow{>gQ1-L?Zq9mQw*EXfC%J8IEqV)|tkz=V8 zdv|1G%CuAJef#(3m1%v27{^2|VFyx{Jin|BVOrp=ObrM&WpY9#N+nde-tVIobs=)ine&nz9#-Ob^_+0(%)7mSkN0xa_C@UMSMEo1hARZl8N;{c0C?2*tlJHUW*m>_w=r=>>l@$r#+oK|;e{90 z`tNg}`_wc8-l%6j^O=XM{K-##QvUg$|G63sFbJ+a;t`Li$73D7sE2=uhQ0EYudKL; zz#{v|2ciZ;V3KzHPb<Cm7uP7>BOm$5ipTWCZ-4vSa{l?} zmnS^o2{khE{`bGX9;DBRc*#p%QZBmaqI6V^Pdo=Ep|xW&yTtSN>a>UVhu2Y#!`kHjD6C1qe(TK% zb;bg4lo4XblVih%z8ue{oL~R?*X32OdR5+(adY{nfBL6N-n7T!{lXW%Q2zLj|G50o zAN^5%wnhDc4}73}^{ZbkfBxrxUVib5Uld1g0HA;PhkvNo^z=Uzj78tx-d+$c7UVnM z`OfOeP=~VwkuGBl6kJSJZjn>VkVd+xdA-~R32ss(Ls^$(c61)6x2Q#5f*V*OC8jo_(~>^-K60 z0i;;SkJ%z0NExq*?=e^&3m!inUa}^%nu3{rtCvjkJTv&)+uQ5<;K|<{A}gn}PmK1yk!SsLUF$@It~@u#w4`r5^XfN7 z)*cTh59&QF)(TuQfBoyr&wlo^`uls;jOl#zLEs z@mIh4)%E2GZ++`q%VQt=*xF?HZ2UMw%s-i;FTF}xJ}^CbZx;lO?)=VozEkzr?^8dy z>gZTfZi&$%UlF!50PM}6doN60v=lz7%o?d@%7(+xrF4v_6}`o~tu9dm9&jf~@Xks- zI*iqkXfMN%8p1Ik9gs|kR%P(2lT01fjg%*8f{ZTuP4sK>q{)@w`nR@-ph$y)5sbIG z`7-0J{%Ik?!ue8ePINipgmQn}#5!0>SjdS1Wt9O>yBT++(?VWAaz==xFt&Wi3V;zp zljVLy(tsj~22GB`ZK==q(*ac`)a3JO4o`>>QS|CLV03EousqLm9k(I*oh8otkfY}B z^_`souYQ&BBZ|m^x>z5Q;e{$siIB;IlUvywR=qAvU`sqx>XP3h)Y{fIr5s8w#?h3= zkrQgM{pL5nselDcno!HjU;gq6c-l=!6#~l3W(<)gUd`*Tzdqit8An!oxBn)*NC>4x zAhp%MS?3C%b@WK{k7%rgM=5jEr% zaIwh9#<7Zic(%Fow>~J^t)3>FWFhvnxL2JNB?YUnhMg7wXaFwxc3jKecvc+uFg{-S zA(0E7AU_B-aFv52-;(@{4N#CzN`23sKx@#4jY*SKeh z;2=ZD5ySt_{_M}{TKDhcE#{3Az}WIcwzaiYjFOV0zet;T{hwA^M607>9TKe{NHEX# z)1LOUDp%V4SAX?a)d4|gk|lCPUi24+_EdNDwEyOe!-A7RO2_Y8wAuT(JF-5IuSwZd z$591$$u*84D!@T@Fi}gV#vF(-1liv}Wo~k+crjh8 z7(j2>@h((kkh@o2k>|P2E-c}o-pM^6D9DoMnkc($0iiRc+=C3Ph!7Ec6EQp!L6cWN07OjZ6E@6HTNu@BH{AhyIL=R@9D%5BK0A|NaWkz_O?1MJQI(5+~aD0 zj03CorwKJ6G{)e^KmKtQG@e63sQ6wz#>V|fr#>C4crMGTDaN5G2$UUZ#uLyri=g@5 zW(Ah2MdEqqop)YcP`>A_5c;6h8Zhy>op4u2d8yMPkf#breeODKR#!)IrY^no(rS6C z%RS%y?stn__2k0!fL{In&4XzXHpP5XdPf%h^>e(%_*$6UBs+F&ukD;W_q3`QZC(H* zo@tjh?~=vtNoE0+L%JnpE zne3V;$oR2aTe#GFceU$e`QJMNlr3+xBXn$#@p?jv8Nu*5#UnI|fRRUX?DxUQ`Jvov z6A>ANm1M}h6(e(xHHJh|P9iD3x8t92-4-0Sp~?02jY?VfWJ_JHlk`6^;dJpfUJ@a2 z3evOXY$;NXc<*^vt&vcN>T%?C?6)_@d*piAvX1H)V03HOt+(dYa#;h&p?XBDd3wGn*(*hS@o}XK?q3$)Wc}iRK26`|M{Q) zS;;3{bgeWXp>EePRADg!>W2Yqz1}}3JshhvM9ZB1?ce@w^->CZ!$KIw;n6rTM26rT zqoF+x6FZH9OX_*W%|S?K2dd%aY49U(-`b`g}KI6x)oib?~SLk`}k=m@@niv zoje2P!$^AR-S2*Pb;x**$Q7Nb?f0ap!;xh?_j1K+PGV%k-i;!nMzJrB*w=&FqU#N@tR6X zqxXF7*`C4a(4M(s;F%ZwP(-qN_iJs2v^LH2i7qFcP#OR~z-U?o(mRP+)dbz(nS4Sr zIOmNmU%onoXj!h$S!?;+fD&ZNo5jFG7P~t<$mqG>86{iw~oN*2QXtfdycUb z-W5(^K>|W!AV=uQPkwUk|J}92_W-ARX}o)ndeoyTNHrGbCqMbg@}nR9s0uou6Vm?J z$39kE2aqWYhQR;(fB&z}J)$g+(ijV`^A4~mpZ)A-*U*#DxN!u=!b`vdF-92mPyYcO zIWliAdeMujqG6B#q;G%w+m+B7GhWCOQOv93URa|RJJ|z*LJG!>hn>u>isyw43RCvV zJqI%nLn41dC=>_9-zWXRGUeYoHm9RwS>|$4<|zl_W`2c6yc^m(n}IeUXMlMQdF9!+ zS;a;f=@^R^EzX#2E%VPk=R|bDzQD!^}V$x zj4s@49V49X@9Nqf%*_!#A&y86OeBj^KO9;w;U6w(zfEQG#Nd)Vb>{|C#L|JBbIFM3 zX>orvb0tpdcZTc1gF|X4kMedrm-S$+IXY!V<`JADQ7q#q%94}9PQ%avDNS@nnf$mc)*`A3x)_cEg4pAap5 zgP_VmJm;Kq@^+TfE2hFp81VOh|Myh~KJR(Ys|3++WQw7WNYO2q5F7x{ zc*Zj-!J;dqGr?4C|L})DTyaI4VJAH++GPyjHa%n<)Wtgnd*!9WYkC)1ZN|_2fBBbx zS=;oASG?kIde)JIxBGy=adpyJa^!i5IS3GTxvEVOKId3~oBAzP!FbVejlQM>{Y~GQ zFLQTKi|C_GE@zx^dNpF2mj%Fn{YLP~t+mlI4i44l^4N}z-f@jJ#2ZLAFa-OB&}qN* zjTHJ`Ul4yqG}h;xo%`x_h%3&)z-l%a;zQn=#=Eb-=3G7GkzCT9XT;k%eR^A>wTbcu zEB54brzO}#WX+o6THie#oF3kHIPUkRlpfx5T$la)7r&|skDJ&oN?=f5xtLJq#t1%Z z7$|PaU`aYXB?HPLP)wk~^Dbk#G(gh;@&3p~lXz-dyuqUEc^?nhExx@g?XP za}Y5L0uauLo7+y$o>&B|$p<{(0oA(nY(ny@U;U~A8PY{CJ%<7ThO9M0^ql8Br#$`X zPp^HF`@_-(G6*CA=ONVRhd=z`$0U>hpI~2n@x`^RtmKA3|KmUYW3}9Q9^d}18}ty zh&Pt>T?w`4cEw}lRiHpiiiCN0#DtKwdMQ2gQslZb%YR7iLlzFfTa2%hm;%x2C%J+61nP%D=R2HAiIoDmj9h2fQVgp z{f(8#@Otx7l3B{vnrS@HRVl@IX~-7&axY~8!=%s1)w3pB?{1f;*tgaTH|nu$@gUBa zIX&lcPN?<6N`_4!aYT1+SGmH3yd4$!$k^%P6($*BQaB6AH*PA|t&8Zt{S_Y5nq!V;Eh@bAE3NacK4J zj+?N0I_tbwRM(_|bE6Q9WCZJST)Ycsj|Ny2%s*Yg}BT&GKH6 zPBJE4L7n#duzz|B{R3|=*lfW7Db;)axTrMxo;&c`iva5}(NB3;nl%o$a z8QI)e^Ct-cAdmom*4bxOVRP=2ckFs!CQG6&rqt1sqECPVQF~K3Jxh>v>EEnamZE${ z;MRSyxDQzp=0L6pk86R6UEc^8!L_*Wsx%89F!7YK8UZaq6~2(Wh|D&NlrjMd@*-LK zJ_k5Hrx==I(QBj9kT&z}GtUG{KtT9LfA!UZR?MOAoBJ$6^TX0M1_&xZVG$yZ78Vi< z%uhr?^tPvOLL3w_V5mD$v%o0^?VdO9^vwN~swjmkS(A>E08EsFIslC}lCxPeXI0{> zE;1wJVI0gUV5hL<#Q~UMF>H*pIc9v3V_>5`9;uF{OUmpyvra_UPuBV0Fao63hAnbr z-3T=h?Vu92;V1 zce~?xR;|1y>v3T9TEPix*p5>8%uv@ZZ$uiGBTUrOlIxcD3n^nDk#7Xlu2u@TA%en! z&3d#M2sT)w+K?}@dwY9TdWiC-P05YVo5{Mi=LoYn6P$~x?UiVTq>_Yr_OOaNjP}__ntb~C`oQ*>~kP4mG6q|XpU!=&KAcMY#i!fDN zkvEP3`hoY6R~GSOT*Ddq3`sVhNTJX&%=dgA$WMLhQ{{q?LH$(_e)WCkGoPs>8?i)s zjo%M`@PopWDimJltZC@&zZu`Iw*eJ?!7^iska8#>y}Z1}hYq6m8t<>RA<9UvwPLJ| zk2y8A=I8e*o_}NJ;o57j&lsFj$3rTeHkx;9WnXwlR~J6uyww~Ln6-%XRwFFe+F#*X zYxB^dgJn%**?HRQ*C#D6vTlxzt#!@;Wg{}LC>b9>Po!VQC7r4~$GmQjKJiTa$xerJE`UoqO*52vBzZh2`ze00W+F zL$;M6vs(m;vR}DkWftr&v*7Q47<4J^3aTNPaBbtp4QX52mo_%Q0Yv*nNFDx+P*V2Z z9osi#(S&XY31xja3-ipg&a48BT;A{g=hux9a*33l(aBQ1k-!|Ov_OFjfZ=sxIU{(0 z0*O-^khY-wZ4m%N0;&%d7XkOvlhV{@yoIP6BB>tMEx>8Wr21IKevCQtYsWe8Li*g( zy)<=q|4h3TpacMbR#V*Hy^gAU@@4az%orC0&2KB$OQ(pDyY*m}Z$fh$R7e)a949a=d%-K1*s3jlwX1`C?_1`lBR*eMu zQ{u^kIgA!5J`}Qix7o91Cr^AsjhuL^Pb-v`9NNeNqr)3(I-+Q;NvRccgB37?Jo$_q zb#!!8?3|tG2_=NU$iqG}#*1|*@2e8XtU+tkuG48zeBK@gCvVQF7SpCpt=E!w?IhE@ z=)&2PCr_$*90sSQ zA6~#hey!2lZd+K#w=H^tyx=Ij>I0Hd3%^SrBCQW z>(+SD|G15I+PLgKzoLE200`qroSKQcu+V?<^ z_@XuOA%aKddv09k5a!EKwG!MJ=Di!fRPO;Qr3V0#`h*3Um6_ zljq*KrdAFm%T)-1CCj=+aD;W51?;zc$;&Ulygo+=M~H$otPMRa&9x06^yEHZ(h+6A zvKC5VIWxtE;2qsj#N;-T3a#VSeo=gF%ojavkYzR>pP-TlHO!@K}P$E(6?r&oebN=_67 z)z;R2d_%DH((>;g`C@tRM}JgSWiwo6zqFnAN9ARoeq(vej_;KB|M2|shNq4#-~H>k z<%R#11N%oNKe#?2N7ZcJUM4>8i{)RQcYZnh;J3?Pzv#W?vIQH;*4~lBVN=Vr`#+&P zVdMMC`>x2FA+lBmxiOpWb_VcvReK^wB1Pth^zBtHeEavxn;)6{(gCgJ|MIKm2lS32&+7_zroX#ewn#3_B=jFz#tb{HJogKil$V@2r1a0T?^v!aKTQ9= ze9h=`QO?VI^0{~Isc+qTWqI=hUtYelW@XvDC(pgT!iWCDf0Vy`%md29wp?8n=d)FL zKkiMh`_uFxeb4RqU!>9raT}yo~Cn zsLnq7tawYNR_}<-jgD{=N|$y-5hAB#oL9)0Q%bxm2mqO164|u#)U#}4&}Q=PI&JZp z^=$)?zIZMVk2;17kuH>DWP%x|2hbD3bmMQwYera;k^~D!jJW5!RViQj z-|)v+X$#|ca$~n56tapVSpP0&ta%DHl5uFb9qW(s`eSP z?xp#6^Sk?Zo^LL?7j1N{&wcOT=7s*EyXX{0!F}+9AFSbb1c!IqwREJpqC0~#~Qz;AM~Cyf|iWu#ELwZoFYRAlJc;JJ*+tIQoFU2 zT>0&%dpX*(x_{r3zvZycm^rH~x@~dg7$T31dwHkUj`XDAF_1(pZ5*Qu89KW&)&nE+ zupDL#%4b5>#)@+c5!6S0@T315Hgs0QPQ8_<#=yq;s;i3A!b9>)CT=*Ccd{ z!UV`WGoVj=;uGrY&;SzPP=qacj(W$tDL(>;0jrvW84xAZghV?mitWf`CQut4qhaTG z140ttY(Ou&I9vLlu_0@2d~eBbxJ_f>0Ha<=FDVc`iuTU-R%^Sc-S_JdGa$ShT1 z26-s@4h-}`SXv#&Do9#Wco8TIKx4s5g60X7Z(}YLmaOj^ix(L3tP)&xSyV@s?rrb> zx9j{{JDbm&-_3X3f9oT%%QN>M|M4G{c-zFo3u9rbrzyv(r}@13-CTcHzw7A%kzpWm z@Zi2GU&e~!@mw-GI^jqlXn|9ZP6R*AIw7M5ESl6)z}dsa?F_ zlsGxxw#_rf)U^Rwn)-zNs|P2~cX;~7crkliuKRd-*6aSc{A%}o%b)(kCFL*fpTl~~ z=CbtKua%F@o>Sg1adbKLX6^-*ojJeE z9v2pP=n>^rA3VEU^o@(lFFTX2aN%>xQ|AUa_dldOVCl8xBhP+exnxDWvV%`A&-udl z%1dTy<*ntzkNeB=nUx6C~=7t47Izgu4W=y#Q01tIkB#sBub^4#`rPe>ad{f@$;%G;K;@h8eW(o@uX8QRZfG&`-6dGb716D9qOgn;BGAcke_U($@dIt7%L3e zuWz4(@XieO_Q_h_ci^#`7N8_uY#iw)~quW{5zm~Gwofv@_Y-Q&iMt$AsO4tcB6 zj=VvnS0%mPT*M=Zz%kfiGhK2|i+knk$-|aTz<{TptYMo&91Vm(882(G!HMQKTy&r4 zkz8==5gFtRux61p$TNA&1ZB9 zeD*vc_U1df!nu();0Q6dMQ+;L+iO@GnMD$fN8@RQv-+tXdPHfkT1u7(mN7Ga`e9R~ zd`EKTo(7MbcDbL9fSI0c>_oR7^O(m}dE@CcFE(9zo*YB#Kwq@o^+-9Q)r>J&^Bi(T zW_f{yg0<;*3&MTweaxP-}>g-68s}Khw zM(`-Y#)26d;rE&#%GUXPuHCVtt6H#xl8^uuW!ttKc$>*xvS@J@Wm^?2pCeRAlu7bl zV7s`>CbIh?(#B&ILdPnV$Su)Zg0}@?_nVv zMQf~tnS~(;x=k-~wk&+b!nrsh5TSF$m@3`JqWRmr>W@W4ak;kXQ@ttw@ww9c*3OQ2 zC>5Svo=J-dz)%vrmKIOrA!){|>A!!IJH^-?Pw9&6U3JwJ6(An`;D_cJP7WAQm4iIo z8W!Kzk`D%r9A93ZB!$&b2|i)mSm55bJt3Y(J8N@eZN`YwLw82Y(Voy8Qv&6%e%T-7X97#siS=T(_bvV{6#iPJmbFQq9qB478UV~a6miK(m z%u!s^&MrG+vyHiER+&|Y)>*RK%Y@rWS?@l1*X(JjtG>+QwDOM2-&NM0`FG{}YZsOu zzV(CU`{)0CnRv>~GHOEJlRja1nK>nAq*mV0Cmz|H1mWHpP46q3npF)xWuE<7{`_ zUZ!7CKGXTvX&&S8frg(ILuU?^ouh?4ha8iyl~&d=#t&kPJH5eyiq zLN)`88PhrkkFwel9KAV*GmGXl-Y{|}oa{KY&6~GY`J5gyVNJ+AZykJ`Ur+(g=ds^U|XCiNmQKSihfh|Z9tdO&g zR5qCFSq+xK7T!9##s(P}h(scVQV4w4kewsj2xIjdp)+?#C9Fm6{2-b(5RwJs4P% z*XSSjd8Tm@2Is(VkDN(`vq8PaPhYfG+q?g0w@~==pa1;&G7k4T0mOL9^)#ODd)@0^ zS3dW-&()MF&$KpdW}@qjF`PFi+717WJyPk1Ty`I;+PEJ4hfWxqcW2K`iV68Z%5V@| z0)Md8*Jdu{+@E{y{Car56A*A8NB0;zYn1GJ-6GyV zuX;g>HE#Us+KW66jP7vV?ySRo`yFbY!~ci!a^?+!nNzu>#(;<2_~^Hd$c{Wxhq~}B z^^Y0jgoa}~mU=KeJ-XzuR((@SkM20mi`EAqI+l0Td>UaI?B0$<%CX-7WQ-*hK}c9c z$dJd+i_yo2xwCF}C&#Q64iB(|oeO7=80qLCM_g>L0<|{)ye}RfZe~ZZY}&lBPVgWh z?cC2ZYLHF7_rwyAwE=+vdH#?PzybMePd<~cMnL0`tnWbHx_wJ>KXbTx+95o?Ekt+w zuI-hGvOEqQiXdh2d0UC+dS52MK_qxVErh!(Hq{U|3k$eil4EuJAZow`(WDgQtq3by zIDo(+5~e|<-Oppi%4G5REnMyJTmp5pcJMIpEb?d~iHZe-WDCOp7TyLV&Ei7bv9mY}DC1AzWdS`Z~@`J&!vOaPa+#mCMt|+X4c&)v+QgLV?ct zGj40vudcugz#MllY*<3<(?jrLko6znUC;4!My4E}BBxhKaC>BMM}F);ADo?n?b(TY z_hn7_<-dKo{N#q5pLg@pvSYyLGBEQsdr;0Y>=$c$;?#2H^sVKJm1mcyTrj>>UGH1U z*WUb<_!Yx{%iQwVzs?T%k++9>Z-3zW1vi(@5QkwQz-{%jyiTtxJ54YCe7Ry{#$~{y z@}TEDue7Sn5gNIF>DN9}u3R54Ro3OH7d*B+VD_Xkvg*tnF8u4CmTP|b>vHXukd$G0 z-RU!*QSLt`a=+_W1BBEq5sJA@jlr#8*060`>JyJ7k<~jhduXs<-thnnopHaU2#S^V`g5uaKDF^ zbEk|gBL;|b9KDb~ie*i9jxvayS+^s&HFW5ZO7uiLrsib{jPp^ER|Yp|X&qIPP+XWV zS=bXrwPSZHkL$pp9MKb_L*#|gJ8EqD5Hcqxa=<`?9Pi4=7{){F3eBd*zI~z?ox!&= zvgRnYDC%G#|F6*VxC!GThXbop+P$~+&Tcu6ib&7E;PHWY@B5}6pTlG8ot(nm&W#(= z$GrSu!uX^+dFOB|hZ;W1ClfMUyJ2nJ06Ff|@f8R5=6dT&eZ~T|4ojOI$u)fV(E9A- z{SSQONraiOgApu+h5-+Yc@Ra4j2(}eyg*o|5AE&k^*#!mw~2y=Bk&Qya-7WzUhsm7 zokwdIqK62;dKhX03atO>Pk&nR$wnYvKhJ{ozW28uB#gtsvtSymlmiOi<$?NbSGWx~ zh#+DmoGdKe5K409?~WMdkI2axoEPv`UwOI^LD&uVZG>_5FWsY0h>ha8bb)$oLNb1w z7xFUUE)OUiMq&^^ILz=zpkb}CL)MKyJQqIKSO4}LDO5<8_H%}Kj%XD9r@izGokKtQ z(SBsy_u5SFdB)vg`qAcxZsGm2q0*S|-Jj@X))b63*ADY{P``Ah0a-T;CH->JLW0zh z(?nfE{FX0YQGbs>5Tob3K6G<*#K!Ov@@)QaAJI&=nhFaL-O79_UX|R)9ZMMsP+q=nGpUoEZ5*#U3tDUFFm7q-R#l& ze{Xzt7~^6^w9KG;qt9XDctH(6Pr62wuba^Utg2`*j5A&lYoon>j!UXh9@mX72TP4iR_%&_P*1Ibf zrQOt5{Q5WPTTU2=r<$insDkH(Tp;$W)Yb8Z`_2244%acJz<3rZTN@b27tapms(+3n zGRAd0BePyfXC43#GVc3vBQ;IJ=Nn|DwF<;g2l;d|RF~?ELbYD33SJYwo$M zylleb%4gSSNAcKaln;I7AIdWymW?D8k=B>XKJw;r@jrc}T)Z@!Qzk#8y#1>0mS+!K zS$_PF4=vBz@ZPfOb5Ck2y3_BgKlqsPuU#|C(#viwi?ZRNqu=~;_C-%ApZe~r%KXDu z=kVce-z_hn_T=)(Ev-D{M}KTX`Ra4VmLZkY9=`DKANw-ak`7=7oN1r^r3_eC(hbzq=WZ7E#!B2jg4Tv4L%S!9bIin*F-gZOD z^Bk^->|1-t4Ta1A*|KG8HAXjW>Wu6;QYf3ZvNpX7cumOAkU@iUCgmAb(Zb4GVyxb@ zAYt#2wAr)fr0#xE$hXz{oyIXS*e8FTfyv^X@yaAu zIC9?}a)WpbPMzb%O4B(00`HBrF}L=O2TX!Z)*PIGx7H>6f`9&oeej1tZC&~|GUXce z=_d?8+K*LWq~f{S!GMQ*@Cnwt*R$a({BnKsZ2d-T;e_II7*BWjOh4c`qN+aFO4q4R z-UEz`vhTFTXRsUw`ApwnkA7*JJ}d60GyEodaF@5*J=zcd)uDalgnrW>k^hurWt#X=nXoF2E`gTu>FR_H1vgr&; zi{6nEy?PCfAj)6B>{}|0fFhK=!s3NWOaKq4ow=<0v17)TgSp;D1~{o{$s0_vaNNQ1@H(_*nU zh2UwMa%3IG3g8h`g|Ie%TkL))n4T6uK`E)Hd6vJs7tiBHR{((0TwDLq?LQW~pQZp7 zi%03+R`oUQZl2ftyZg1q7JxUUsRL*=ZEC)=kh>S{Fs@C#&AkZdk)L(H?^u7k-%(T+ ztvB6Fm^!)aj#m(fcn%$zC_nzjgfjd8 zJ*_}Ae{hD#*r`Lv1HfO)b`*2{SL=1zZ-NjSyhur>w?9P8UJIg-4DQM$d> zmWpoyud39xhCouZ)?_P3i-JE8g+8K^zESavAT0<1#pTSrnX_hA1>+uGOL)TbENM2Rf+5( zq&&X}jEIDK5Gr1Oq4o($-*DoF=eQnGa4p5@m3E^O`X4@QOX(jya8Cd|Io9h}(^Sv>Li{`W` z&2`Pco8Q`vq;xNyhYWWw>hp7Caew2j^qqToRh1*hPkXyx>zbx7u0;+T=Y{W%Eab`k zN7m6?r;l_LVtsEFdY>A!et7xh?QYt-;^o8Hwqux81H zvt315c`{E8_BVS-v|H5R;6dp;F&y(O=dBtK&(+@{S%cQJdi4=^k(x3%YZQsMZW==d zm)V!=T2X-(W>`PI=TPIB#G%xEqRR;_I~Z*W^~9 ztzG~IFnFBm1m}Lw2VBUgqdSHS$q`1GEFtYt!$+01IaCzEl&4@f7J@8X#2eW^R)#ha zNWkCv@$};>M=r|lcXtPg?tgc`=6L>ANB4TV|9xaVch#;Vul4Wlb@k-$rjF*?=J%1G zH~+r7-`($T{%(G|xBK6BR~LlwKOqgpMld;&odE&)z%9j?H=D$B1q{f5(*hViWKqtW z#mv|U>{g&4OFOgsZ*0C}2nb6Ij$(Bk;<_rHsL45|<-X_6PdIyUz+`RO9L1eAfG7wd z4h`r`PNFqM;%z)VErUispuF_c-z(4j?Z20Iz5j#d1K(R#_V39~^JO=b&Xu>7S3dlf z^7U7JseJia_f`^ji*UW^jM3$NBLbFTWjoe)ln1&Z@a{$@^-@ z%`dOGpB*f z?|kN4<;fp-VyV3{r%9}D`Saaw$0oTrT-9;>5o2=58Rexp8R7ZU7nb*2@PxAIIO`!p za<{8@F2rePycs-;FpWo^5pkb$?vwe>i5a`D4u(0b{6JM2t5>gyh#o9$ZEY=YQtv)B zye1ujvgO%gC?jY*YKUTc!eqi=qAg@J2_s+u??Aa zeDjndtZ>$b9UB-J??Qss(W%`G@#C1Nqh5L}Y&#Moj{NsgD?5%4kM&$tbbnU&znkiN z`dM@RiTr)6e*8~rV^8{TUEn4#m{VYQJdkue!j5C;Cnpw+C)d`e^d|R^P4bJ#A%L~6 z@C2L7)`Y*fM&VIqw9yOJnW7H$Bj)af^VT;$(s*$39N2&$dgD|jnOW1;pVJubJ3slF zF#sG9q`lU(H74RZGSOOZ7i4Ij=yJjd<)|o-zI|7f6*)_CMHKC6b5BbMc|pNybNApmlWHpG>^Gm|V-LlA^Rf%`pEOecD}Pu71=MgTA} zA|{SMwaUZ3EY@w=*uZ-;c1#kdBjejc2yOP-n$O22nR-x2r^BNMNB(#OkiONcSH;@h zTrE-?w>q=wYue;#kZn>r30La@O<-W#Yx}D8Kr(Hs2<9SH9pR?uIjmeisFTHzbV@#X#A7_;J zeC~zi-Rl$fJNl(}`jq0JT;vAMo<2J}&2J3O4NQnP5rh~SlP4yPgc3>=#&Ksu2Mvw< zb(Iwz%hShrRU;c+2{A8SlFeMfABK-pGK6J>qI)GQ#|Y}$n)ie!9CsjF&S96FNv}y9 zF(kQ^kyC^go^IaQI;)XVNTr_b^FSu4I9g#v~_Hh?Ed}I zSCTdq0%>O|FN*YyNx@y8_X-BDi_F4Q(E{sZXpAseEcX*ZUa@>-#rCjpE4a$gg74u8lhf<8*Mu5IuqO;0PRP3@|Tc89O#|JuuuNBy&*zyd@__ z9lf!3{n|Jca!zZwPXDB^Y~Q`TOwJk_6zA0~Il*CMayU5>@S;64TCb_rjsg9XdeNtU z&9k)Tp=z&#*$}sSZP^>#aP-~yZc)GAZ?ukn_X#JIj(p%f;i!uPWo!D_2(w+p#|;nKjKr%Dai}kBzk~gu_$h_xN#fNk;%|0%BQs z7A3H?*VeMNZ+-&e!ce`0I@1ORpPnrLcSaynT|JJhK15JX7-e`MWX>XIvGTU;-v&wHG|{j>7xv$G3x#_ZA-*&aFW)R2}rW&UrT zP!@jcAIpQ^az)v*`HFINnASzJ)tS)C;i_Z2)s=SmgZf9Ggrlv$V@W>3HG0~N^5U;u zS{9!9=DsTI%PnL_m_E+W133-3*9jm;+{mXp6uiU&O zhbbROm@k{F?n%+c++0RH?A_(nd*kuEJwCqbl8eiNC;my9AEV-T!B*F{3WG(ujQ7N^ zUAv)@J^zM>qk}~gV=yps8OvH`?&T}OR%sOu+_!OHS5C+hiyopmL zCwD7&C!#`uNh{hD59G)gLq6Y<`vR)jv@pWh=*Q2xnquUR&W&TzR0lf?|>*#23cKCkz>jfdG>Db z0e$r=n>C~0M@CN=BWsRf&!{?CPL9C6JpxiMcJJC7&d^!Y@@$N2Zy%b?a5H1PZ-~*8 z+}o^iM{Y6PmM>Xeb-o?nqqBD9&Ua;P?T>s9Nd9@BtfTE&GY9-Tq*OjMJ;5MC_qK0q zy~@#AuKFUfEwXhWI-obaJCtL(VnmL~8sS{%2p^GZhubjLI4*Fc)-LpIRYypJ;_%?* zACVp5oMengYsYg=bUERK5_s*&fI4r9$4`EnftSCdqkzYbW;+|Xb#318<{2Tz6)W;a znkePzGm>8w1q+01rZJ#{5~`LzW`MDNVQK)xs^%ed;4T8FeqdxGFEyd z6Fs>n>%VtKKsaM#JUgqCib1}dAu0DvPE0j=;$0_mtXr?qYUIvAv(6`#vjzZw2KkbQ zD}3lElYe2=ubol8`MO7y2V_@ttAr9|O@+f8QPTEaNijJ_3f-^1bxAq>Z!aw$c=)6;=k{xQ z^}4luGcO4E?EAl4ew#VF_S-)w>!0)Nk__9Vsf;Xt{+j2OcU<~)1I`2kzM<=M|vN4YpB09wp)^ zrAU+r$*eNT!=b=(Q!%j728lsB1$-8?%&@%?x@Yj`^$?i^F(xVVT+ zZM%0R%cJ*f^_(mxN8sKb0pV)-lDy85nY8gdw3gnvhX>DbB@8xCjqDA#> zI9}4i=vtNa(vgj^3?L3KPN((Z45F-3>8v%zo&4D;@i3Bojx@Q&ctbsvCR_s%b^47p zEE4MbTW`Ik>Ipf?q7*oXqr9wV>x*G&E#gm%MjQlBqE~F{le1|(p6GHX$iBB9=*S5J zi5%Lc$l{cv0N}*`mu3QluMsq#PsoOsY9(g?y7bKD?=6dFp48 zd#gzcSWSG3#A>G^X;vtbyBUxIb0A5OPL}^WBVayRfzmR73+2m5;ZZ^mE$&vhgI6dU za1z3%0Oi|;C&cIp*d$y{)`hK|THweCJ6x~7?z$?Qh$%zGaVlg=oqiZGypZ*~$e+-t zb5<#E29S324hgMqp6c8A35SAMG8+L?3C>TMg!S6=eoa^w14WyTX8R%YB@7q;0eZ{Hcv zU|7PP11q2EQ-+`Ng7UdaMg&n1+aW2ly?EF?0< zV2*yg%d+N^Pbx3C>W|BdpLTkA(EMpNq$;dBb?PI_lOO-M^0KE-D~Gl(Ez2)^TY21@ ze%Y$4Pj=T{@b+@e_g`8j=9B%~E-ufU_qg)GTjRm|olCZqtKMDS@w}&$zrS=*>3^T| zN^7e`jw;)?sw`V{d$aWK$dhc=e6l>_{HK=>@5u`q;$glk8bnFh<+*Ix@~RAMPJuTR zhPg)M7%+B&`kcaHfFP67BgjGhiOk5QA}}zXltBMRhQG5&^p=LRf{;fXOldD^A zYn|=dk%$eW8eWolGV918n>RQGs^@)s>zFl4_qywED9h!+hbY=*PM$@e$S|XyhqG=b z$n!kQnnDmA_2R??9#qP9`Ld2mbe*l~jb)U4#rfoeA-6U~ICAS`IXMFN_6S%nWL7@$ zjG5DG)WB&7UJ`ma*H@=O`}FCFdY)bhqIJ0<^6!X4kytvS?$VC}kg_4o zL;d90I>kAxI}Wq$J6b2VFuw2_(Nad99A#v5@#2L!3hJ7AY|)^Q%Ml@n?p2@l1tXkB zvo(CBo(hprJUxL|*;G{ZM6QDuC%VvgwPb;xkf+^tTXv7$xF9>BTA%@pkS-v^k_KoP zd#ki|#CCSBub|@E*-0wrB4*JV6YL$qL-vHT?HD&fcH2_!fz^=K!8x{NMrG!5fSk+q zo2##`&oL3K4T<6%9ZM>(+G#euy**x<0abykzbfoJkkvjQ1Yt*Vk@`ll*|AO-B*Hts zh{7WXCXfI)ukwjccw8mMw|DB~um9yEKw(p?S6_Wi4L>;k0We5%b~F{>03gDYHgoZY zZ{C{lL_!a|JuFRfE+=MalqnF9z_&0R5SO3vv=A++QzWvRY zlsRfiTh_0Or|df~ET{eTrDfZ}fq5-tp4y<}`7bLkd+KA#tN!HN%x7M|dYk?|GX2YI zD0g&Yp0$6sH_NYmIioJ!KlHHomPKEBVVOQ5hG)00n?GTPw467+=^yJ+Szd?eAY!-% zn;6&(8r}(!5Mi*f*>Or?P&^D4o^T{odXdx{`I0u%z)M)`8SU-um9$YrTVr4^T9Pw% zgKuz_2g8OKyG=!p;3Rxrx^zk8EBT!5)3Pi1^eVePZ-}lC-ccAiitLh#~m%&|w#0h~H@Qrgt=s@hGfU6i4n@Vxai;#@fE z%z4f5o&0@r1n!j)u-Qc}@~)i;d*|HYpX3Z?#~fO3j4+tIc=4i281aSK*(5V2-gqQZ zZajyX$cnWCm+1(&FA_Q?dV&+nTC@guC#?gY?TRjNY$4fZ)bTdb8}QZlOO`CnVd>XE z!5CgyE5SJH)e%YRq9;Vnq)YMe<2M_^Vb;cZA&NmaXwTG~PBL{$%N)K}2J9%69LBd3 zMJR8+d121*TUM1VVBwwxjsOO8X8j_4W3s(oA}d$(f(18Z;_`0FOyZn)4keVcdU+W~ zWpdqT;O!2#mEO)jN_yJVq6mb%p~;gcCCt7uWMET0 zhQ=$3Opf-kq*==V+kvH?0Ys4j`4R}^!dUX&bb@&LuAZY6a6XW@-lT+>9QnfaT**Xs zx9^Og0(WGDR{?SGtSf$XMJ3Dg=bzgm#PM|6(K|57x>K{um*5EBd#3RtoIF@*R>Gsn ztI95}E%|;`#(*d1-20ppVBVPVTT(r~+U4E1>T|>gCABlpc6u9Xc3+WZPY$WKmxt9J{`AU92|Y1|BCbS zc1FR}dqTnyBq6oUA^H^2h#X)%AOy`qbsiX^)*?_j&LS2VubrK6+J7*c3!DeWgTWY} zxP}eMduuZv`s*NaO3|)th7IMV?&jK-qRkG{ob5O?DG@Vg&N>VT$fSj8OgCk-!uEJ& zELI*DudOpSixT?qN>7LOZ_G8uVrpbjcw}#WdS$FEY+gj|Aul}N@@t%EKo*=f@atdy zrq=b)yua4w2XekO;cTHv=l6L>D+TK;LeFJH@kSj=ofG4YpE0AYj_qCl=l{2Nr_FU` z*Li?1L69Ipa00*y0Gj|OaOgqmK`yHm$J2+z`67RctDGO>|B&Q=q>_sLA(kR_#XZU0 zoY^F15&$QFBLETvKr-*M4sY8o%OzLJNR_K}WtfeNd(YW>?X}+Zu3_)vxC!Td#<90n zYb;AIHr{?kwliQBGLwC7|M(T+^>AUiwVwG{|K=6q5W=%F4TIa?qRH#%`$~=@S_+vm z-|t`fPEMa~?H|bJz4`KK>%mjD=34pN8ztnXRAfE>!7CrxvNgTehxRt#{r-=6GEB(Mc6OvZ6g^p5P5|)s@AWkq;7;ubaT4{$+y9sG+hx&MPfHL-S?2|3 zoW=tyl;n&RezOHO4(lIgBcndd_SvfDuhi)NFp@*&WLM*icLak1GKD*yHD2?~T=oUi z9Eao#S_y~!8IS4|y|&R(rXQI_!fA$p&pqjx#Dn0E19u**?>jG1PwB2~!q8?ipAB>{ zLWY;~x5)^uE9G~3I7j-YIdb!Acd>fqhl6cTwWem%~9+|2G{fDEcIp!tb zx0yqEQmYHB(dObMNRa8;l{q;bCd#Aa>$D5=aF(;NYyIHw zjD1_@+YA00yyVI^@@c+{ zXjThIYz(2}$7CRl+Z?s69Cegk=E=v<^If^0H7A?)6RY6=ty|MIAC-m6moHYv(!)X= zM9;Tsvyvo3GPS2T83#6~2)EBiJvuay%FWSQlg;{n{{T-n<0j5P!t5RK!|`M61j^Y{ zOoWn<8N}$R(U7R4G1}o6b<+a?Wb_{ZOGL#<^azpf5@hdzzSde4_*s-YM{l-sHC-uAC+*mq-wLkAOy7e@_&m>|tE=K_{Mg(;^NOdg`0Ky^U-?cPUybAy zj~H=Y8*vEEUqr+YW@qM>4(Hn~6fs0Fr?SJ}6OTHwrht?Kp$|_yIUq{s;P@?1mdXH> z82o*3aIne=j%*@JPHkz)uFzzkkLPioacY{3jj2-m0SW{YkO=?)&+v(nH2QZ%W+^>q z;l@M!%+GU>?`7xeuHAINri2_uo3R+PYdp;kT2CP0P{@c5llPlA9tYprIg4<}7IFB9 z>BPi%Ib8a{=z$Bz1voiI3I0Hl0 zq7&m2MQ}a6hpl;Vg){ezSDB9fcO|g$;#_UKky&9oaC+p#@q90jBFq?H1`oG)DdA-U zX9z_mRyZXfSKi|TJVB^7S0+#%P7m8i%8kg);$p~0dh{O!!?ZdbOA!7vSo<(I@I3gc ztdFE3C+r8|u<6alOBqjrFH$o#HIeGl?jn80j@0Vov=I)r!s3Mo4?`>-R7(pINXC`z z%^W-(MPLc91Y5(wf&SR(XTf*bF2^7Z<#25HfA{V}$sW!*A;fvMvP#JFQsyeK<`bHX z?v8wCz4d?o=8M87eu91&leHWi7^)!Lc#jKgw?3`g}zjyRKXEjWB@X1djvESSE&pa1M<^>-B##O2-d z=Znlqm>`XO^vm3ze7o`)V<&U%9dv7Je5N&_yMC54HiVq-^%6j7oiJCrec)h@V|%Rx zJXxd;A$*7b4F=m7wvg;LUuKQBCSfs}IU(5i!fZ0=l_&~{cQ1YxCxFF*6#ecJGuBh9 z2h83T{S~liX>%5}jg-&xq`V`Mg%b-9wx`hx{sGzDA72l%J@JbFWvd8-YO0nx_cL~W zK@i|yIM0S{w9^JC|^2X zMTkT*iAqG*H*egihHtwind_!MKQUi@hE)*62{Akmth2~&z?J5~ zu}=q3$je+r>vqLA8HUHTTUm)fr?>I8&Gl&8(9!h_ww|E zGiT1!dYGdz8>^!k>ghX3U!1n}kl`qqM<&QFGH*3{$|+nZ?CyI5};#jLAi}F&?}Dg^y$-0Su2>yY0IK<(n?>PlRzA?qyun_{&E^f zfVLl5Avjk-Z=5dOc76DxjRIkj6%&{sjT-{q=yB~54K~0Z&daG4%4I4CYzWS=OJ}F9 zCZh@)kUfM-fa@9D4suq}aXr~RRU+9g6${xT7~%VL->%x#T(d6(7k)m8eIT1EE9RoL zi4C@~0lu*p!JZ9A&*NDA?Obq}O?4#0cx&cX>zAMXqBS|4c8*{oToYgq2CoKVpL_E; zSwJLOHd4h4u_9Mv8a+LlHmLNT7Iw*c?Th`zPu#p&B#3N$uCVe+9v7VZ%Zv@BT>&Xp z1%b^z$MIWF`0QWpE-=A*3Do(4o_szFpH>CCWSiA(${G2ST`N^gR1L-y=IIH4$H0$bGd=8!W13M98e&U-8-{u-g#KZ?3%GuON@?hq1D7t~v z3xrgnnjkD>?`49y$eABOTCIb?hP_$)D_7Dt9OB52;tc$Q`MpR&sVkXSr!#1al2G$q zFY~l6%H_w8pRBRs0?sf-YW>iSxWuwEx+B?u!)W_s7mh@H|NZxBe&m~>Wc~A0x#)eC zzvK=Zkm=$h!G^AI3%cg9y_@;kbV7OK=0t>+@@jz4jwgz#SHYq)1Pk5>ZFec2EF{2S zNMmDTC0xXXASuz47%xR8cx4Vm$q$2Mn6CdaBnSX2n*e7IUPlZOJ6S@Dz_2Nw&mm8g zg0UfX#$;i9PKGJnn~6GK)dA_08~L(jUzAMgEjWd7f5Zjhat-}SMM$C)=IeUSj{@LV zQ+fgdoCX2{>lw`4++6-UBskv{(Q_E08W}NTqZB@;M@h!aj!9)3#MSp0?%^1V`zw#$ zjRE*P0%CmT>-Za`C(cLakc03$@@OsmcyDir{oRz<=H_QZ9^WaaRZb*-uP7>WW>{_c zA=n%c05eu==AOVnNy|KB+q^Fu=pMn)M3BkIMXpG*qjEY^ey};qdRVv45KHX|B2Uk^ z_I`nR*7s@jfq_~FPEJ(Lku~ePt+JOkYXLl9g?KBkls-hJQL{RlMZn`6K6B^z7`3vM zYbukFw=x; zbM@-A`i`iY{LIhe>g+DB5>DoXh}zhLWGYh@NI{d>4CnjLJBM;J;pDg1{(qH#5U(2oHY5_y$kX#qekq_I4YlXp)8BDbXMc^{VBMA(R*EzHB1~#ZFkV{Wba3y27e}AFY6VAX9 z>xR^-PVf_wBd$9>k<&)fzdaH{Y5lzT6sMvfTYEz^d|%Q5p?6;d2~qSirY$)_s?nRK zt&E=#yta4ZKTV*20na-y#3yGJ@{K(S8el2Cu+gS>@m{()BEr zCf}v|jbF$C_qmsf5Pre0AfsBgWB}oxcNxEIu7C(%xPJY5$?DyA-zz_1T#_A#u5&SA10A}Nz=tgP2={Q5 znEvnH=M!$%tQ90S7BZL5^GG`Hx z&*>eYD1?q=VB>%USa8_Rq67{~Iu=Vho}%aBiFwIdIR zis({w&$wtl@KQ>q5TAVVNs%PiBo~ILCs6rFMwRg($H=I$QD}zBu-l{^NC|t)Ya{az zg;G>wP$IT-UPji_GL+;27+J{>kbR9U_tl@_e#U~ZJ`K5k5d)NJH;+Sy4wQi_Dfr!I zk#(}L4nRgfk4H#7dibI>mQ=lGrOI4eYesJkl+ctd5b=dPp3uK!!3mlR0AcVSe)wUC zw5H^>(lhCPG9u%4a8ZOmfQ4*#cc+AqDBNdcJhz6#(i1w7&eDvlyL!L$T^@`+lI2=- z60pkjzKHDHPf)}$mxGD^m?wR;HZnP#aRwaK!z%&Atfi=yuGqL`jp!UO)&t5pxt90o zA>s&}SMwy7ZRyuyKgwtbgJZ17(P8K0PZsnF0r>6fU#A3M6UU`w>ABT{M7Tp2I16_D zf-Ypu5xj+9D7`sz_H3;^-GzfO?+SqRQa^jPP;Ej3(Rmp{nG-fbSJO5C!4N1V|bKVZ|W3J!8?j{Jo6tQLf<-Fxr7-+J%e z?0n8Ol)#<3q4nuO^u~+K=%_h(zyu<^))C^HF(8!2$fuGQCq+IIH@$uPTf-sxe39`< zT)fQszImBkF~5}eBruSFSw@7?wUAQdwBG!!^7jdTn_%gD1OJa$y9K(*{@9}l!ON8IM3Kr$VU#?#M~pCJvo~Usg#1o zb`~Ry9Wf%MUrIij?48eX;G!=eqo1L&k|6?&v>a-bkkBq(xLD8cK9b%SJtU`3ovwvI zQktHj=CJg7Ms5fYAXA0~RE&35gpN@7yykbnhp-(@KO@6xA1n;401V|RVB8f$PsBNu zNRko1|Ni?GH39(<`mF#nMg_p^g*0lw=FIfw&UR#1J=*c&Vn)QMLk4T&p{! z$sHLxOh;JhHf-yQV-`@dMKAh{eDox%Vl2o3n{*wd0SQKMS63gjhU3r?JegFFEPapw z)Ze^p{)6E~E@EqBzzG|Fl|^$b-TAZUi+BijWw1DF7-|gF{}&sB&#r;&*1!30WXT%2 z9y^8&wYe$swjN|brv3)UdU~>vC7;*t<{Iz5_g-bl%t8^b5Sk^h4Gcz~eKX>k2jqU5NzG_XTEo$`4=}K52?Zz)l=|yH< z<+t;mEFHaASnz1&ruB^Cw^!`ogB@QX}KnWnX$9 zaR;RK$&))}uXw`#{ygVBdhYWQKV(+PiHs56@7XKi@g@nCu_F9hrRW_wE!MbmHf(J6 z)LV{YEo5;|WWNTPTR+5|j{3bSXYo7adZ6z>Y%v5qV-`3G5(J~=V>|}o;Y>Id< z&iCP?JeeU;no_J3GlSlF9h_3-z(`Pm$bo!y8T6QhtJ zG(VA}UJ@B8{c=*$hr16}w1ZIY3$f8WjueSTDKs*)CF9%PCA-T|n*KV9B(ulCyvTg! z(ihZ@Y7jQWugU`1sVZuD_OjV&tW?S<^j1_)(%?`OeWMIx?H@Rl)VTtj zBb=JYRAms=4|y;LVIyVwGw_}qvYnch86;<^ zk4K*^;EUMnC2QlU9I}OW0m@eX{FlFIUAcI<^+$jFM`I%nDW_}7p6Vg}?#5W%2f!l*BHcPpBL8j7$cfesnQ6UFoISv&{~Q@xi~EaB zG>-yANNRiu0PJEX0~sFI6`hNUfxD;p*pzMFY(T*1dq7aMzAv`mI13vakO%gq{UsrM z9BN8SnWLUjSt@$$Rn8@jkL){BM#|Ts`+C;03pUE3M^=eyGMgzbUA~$}lMTd)*;tT( zD`SBToGE?eKoJ<5^MJYyO-Dk^J9AGvn%SYb(rG~=Y(WT=%4FwkXb>>5H?rkiWTN~x zN71ZVlNBRFax#84XRbc){l=*^P6}=+I}tk*WIaf5y%-|kDPkN!@9sFL zU_td`#b!Nz&4xq)rn#~8w#;FUfJCc@zDU91q5KcV*?1sh=roGHI6atAEg`vvVAc+1 zRTNl*FdH=Vs?>6CcMqK0Z-pQum-s+KSi=-7qh6Hg_3&I7h~#nd^&} z&lB+F8OE`J^>xn#e^j;vn|$}=$>2i%2Ah-;$rK*bdpppbuO~2Vdiv6865O4do@)Ko zU;SkzE&ly~_>+>C1Jz}8$y(MAKEOfcRK1^c=}n&U)SD-!tt3b{CpJwVWXMzl;Jd7% zQg5B85nES*v4(p8`4^Zd39=S>3knglLy?(&JbmZN?2;v9Y2N@Wb6w?ga#vnP^6#XI z2K(TJmpMLLil0a_1>vPvyK}AXwAU0t%4gb{Gsna5dT^@o6Dhy0?#%Vla~d0y1lg7+ zNI7)_-om-rxuzvY1`9qqL4&^TNJ0h%$ugUx^&RRNDmxGq=nu5sGGY@GleI3lZqJl% zd4yp8RDUO6c$I~0bv}>o$3H0tt0FEgE`*ql6t-ETBFNEon_b|-p7=vAe&TqDl%xov zO+U#>u*ClawCes&1W{tvPfW*u_P>8#k1_qpk3X$VM>3kSfiu}83WLkX$HupWobQeQ zlbB%3id3e0cRxN-p9WOQ4(h|2CaaUbu8AK(>--?0gXk(I%%(2`E12WaqI3)H8_PGn&dw zW&sz{M+VGyPnT0RewE#_ zQM{{HFPF2DT0edIOo8w7=Su;O-b#9*yFl$XmnDkDblEQ-xIkroCZ>qUG$Pw4M{Xmazfbz59+9 z7?l&v+#f#9&bPcjeBzxr4d=@>yM}FKc@ol5nS<^`BHNIQJcxc&1t5m2HV4r}Q5AIkMow#fzovGNLlP2-nX)`(?6h19jYj zvH~zIhY?_|ew{cY@<&8udW*os@byq~+#04UI?r7C5A{bEvhil{NCD-->~!l=)>yPE zb8~X^R5=9(hm;nf4Y+ggQ_~aWV2<58R^>aHPsEZ@a%OiEEL^;Bp`0hj;_r?zs?0$Q zQ#72toJD>)V0|-swiX`Q+1^tnncav+0*C2+z;=+c7#^vlfO6BA@Z zffEO8Y~;t`<#y54Z8<=Ct|Dh(!^tDVY*R3&tW^O@Hu=a9a6E#FFTVJ^j-5Go?tJS{ z|MaIW6cxxpKmoj{RFQa@2FG40d1*A~$VJIOQ>J1d>kj1p@-P2qaACRid;jL&w%!?j zCpMjV2V{{j#8lsuvlI~+@6k^-j|}L;Th8z1IX*Go`tny_wLV<`LF;hz{W<%|u{583 z_KVzmA?uc>zYHhy5GS*e&p(OGWD^!5E4zsA$5t<0yj1vcESYTOT=rv(oW$JRe9j;J z+W>f)@uN%dqbDTAe`qnDx-Gx z?AZ#S*FvC|lhJq+yF@BDa+t^_1R4t=ncIUu2qi*jo!H6JN@Nx1$SJ9WbSHpD2)4vQ z`>*s&^QrVGcsUUL^%lnYam1@3b1y>f1yJ-2p6a_6tRa}NSWsm%#O|yK%q2g^ zwaH3;bMbFO;JT|U|LISDw|o&jGftSTFZxw5@4N4=Rgyt6LwQmkDs1TO+nbD6j+F{F zIBLgwz;|oe7tBQ-$YOV}fgJpOYp~)~&Qi6hNYZ0R>{KrsoqYN%tqk+aA+LwxZv@$C z2?&-w&Anc(uNH>9dc#j7Qx>~{&DLC?49`?3oOSyq2?jU_4|gT&B`{o$Un4UaE%?+M zJwfU^^OS+-&vK+q^ue{@4T5zrJ*mI<2ftUo#N#hjQ10C`1{J4ljEs(L%V%M)0FMqo zdh#%SLT_bC&5QTzRD$^=4F2R#{#`bi{;=??GkT^qOW8?Vz6 z74pnR$Y=0qvw3tjdhSd|GS!Rw`+xWcA>`S#qS6z&DyPq9jdz5P+`2WLjQ4!}!CY%( zcqBSCP#7wi^v ztDqyg{LVYWk=eHDMU{x-4>#WAc)mOi_F0}R#!oowtg^V_MDzhx&|v{6U6gR!*PE(u z7O;qO0+N@((8C$aX1_L_P|E&r=13pXC=E@ZKt|T3jzo#_b8Lj|v19wA?@GU=5)tw@ zG&mG6w6l0Q=U?SGpO8dgBP(GJ9Hz{u9qbPRz#N(TncHH3lJk?!N0ur>5+JOn4n-M7 zBHklYAmV((Tj`N84~MS;W*MW^7fpk^z8%+TM>QIXky^%xxN`y`9oG^CajunR3m{SS zjaMODc9dnFzKi@Qn~=LKA`o&tGSUZvj8S@-0a>%)Y`tWPfRoa-0K@0JXWT`sbN^=E z>p8^uy*h&9+Y8?o0Dk!4N3Eay|WFB>Yhq&zAJkL?CIP+nS|Wa>26jmUaz?HzvgfqvhYemz2*6`c9E0_&@#mi8gZLm5QvoCT z&RJK`5TbGPsNIE!TfhG>6BZDk*OqB_bTma;q=#$bB!l>+Mu87Rx989eN9QnH!eX$A4cadavK-W5>=X&7~ z;;oT4edCDR*C~ge&-s^r%NR5P;b@f^r=};PHwRn)>CgYX)=VITys{s<;C_1Y9P7oo zA~*B}(YtizaxzfKXheSOoQ}%22ryv;S<@l9AUi;==EhEtZW$bo!}SG|j+vUB%agkj zII#<*Q(3F#xS9KvHFuxF!RUz%T$N=Fo~be*NJ^Tu2G%3@X4~YUH*9=zvet_Zx*sAi zH8oxGETOcNW||E$s@ zSa98e*tfP3Hek~m+r1x*n@pzF8GuUue2ky~M$&^@d3uleAU4MA2f1-QegdBE*_~su z;!E6n2`FC%3W0ib8T{APoBskTX-yfft!gV`k8s}(e)|L@RP^vy2M3#t z!gOCNgS8=Vf3pukwU4b<-+u6h&a)dysw168Dv)vV%zXTxgb90QA9QTjt|YYLPcY{B zWV`uW!MKw=RQC?WzSyVAmeUM8p~{g%NU_Bc0FA|_9Pg)1&b(yE@vF^#ZEfG+FY;>t z_rK)7$-&e_5gUs_k?-W3MFzn+UP=a&Kx8KvYJq-)BZ3ET2n~mKEEyi3x1fMU>Bsc| zJpg0;N>TvrMpDoKi8JfU=af+xjHvU>nX?5LN-L{AZb^)?{kz$^x9gQ zu;a{J7dQe*q`^2Cs`Yp`#Qq0A$f57~4DfUBi8wb|EaioR$(l78z9uR*H*(ke)9z7Z z`~&&@?D_L~4(jpBy6Evil4b(dbV2rUIu7#EoKa128nU+Wi@s4GtVGkenDF zFYt98^0t<~hddZN-H`#hoqJR!FM6U8n>-u^@$S3t1@LpWSmp{StruXRTO8o%=xE92 z;lqWh6DHl26wzL>=j+taPMD) zfGiL_`Y!v^I0PlJm6{Lvu$AEe@$dZ3@09a%7%!)IC(eX3vpz_vjE(VYQ!qXR+aCcW}KdlIH-ehNB*A~%fxMw*;_c=HSwQcbm-RakQaO8j zw#ETat)ZU=7m&)78e_j2`vq-+$=YlXeOA8HPbGkrRb{X2n4Y@^J=zr+o;YE5=8?`v&gV@RFf z*@DcZ0P4n#8-N|ovA${dh`k&)rnx%20WY?>>7Lk4Vv zJdjg%O|~-F@JDHUJ+_SuxfVZxtXebnqlH0VK0FfipFVZ6Y>%uvIwTLAu#sbc@*VSo z?|Y)>+G-FLF99}tw)UMk=I9^0t6>K@E9WAlbc#Qu+kS`Z)z=qn zFuzx^0Ys9YpwD!w9auGfqO;_UXdzr%@;^P4&QW#m!msEAAL?Nidq&QXp*v$jJ_YXD0oc7WP?2ic%Ds-DgHs83&57(DL|w6XWl`c5E-ER9v28f=%R+z1##+E%5uP3;{CLGaY_cZJltm*$J7qWnNXV0D~tP>Dh zn|&#tvlrv)$a=7E?M3_m9|IR0K~;VtSzY*b@?=W-u?fBh#?vj=s1}|qUitsbO-q<( z+#}5T{o$?v_;||l`to7_(^Phx_sk~gmo=gPuCHHuGhdsYp%huIuY0a!dh3!(mL{(f zT@1yUTl!QgQjAO^;aed6m!3pHS^WK0oE0bjI)f8Q zjtq~)8KmT$oo@`%;)|M-iVcW3hq5tpr1tfjN7dUWy7~Cy9~IeCIzScy5#XfkFY|o> z-nIQu^(u*I^~Q;SJRJx?5rW;ksgx#Ca}>{$*8J>TjU7115SBr`O1~SWN+d3#Lmn2> zcd{i$vOn^W)sZc^c;QldpvD3Q=gZ(_hedmw+wtQk%IHg>Lxhwf^o-2Sil{ncXom`@ z7w+c~Pbmlb+j77I$*coeV?;86=Es4Xo5;<9u%c#Q#EAh&z^k-|Kmn({F=&QeP1d;{ z;LyO&$oIr4xrS(sGeJZzfE;2g6NlgM8j)quZkQ2 zqG!<~_wadh=k#4q7QtBblgYx!%w=f`6s;rB6(n3pnZE(ZvjxcW^Y`K)RRRvQ&Yw@q zO4byCHa^ku!a|;gllvVD5d*l7^OT^42a9E^PjZj#=~0$N*01IaRO7F9i|9{ZZ=U3l z_g>{3RM%R0pd6gGiL6NlS&U?URUd783~Kn}Un%S;~Zmy_?zWat92IyN?5b|b6f zdWf>@7EEz1@5uxJ*5&0KnjD?aTO~vDbZ`G!3;+En&IvGEf20iI@>oDSr3F~xiaX`z# z3Jw;*WD|PJng=Az)M3>sHnLv`yw-@};o%C1l#r|6JvO67;a-lO@f5P*>^8Q}v$yAB zkB*B;VEh&vR5aY9o<`J{EL1R!KRB3&3m_G+!3IaI6fh1}yD#F-CI#k*QI;(0)K@yM z6#|)1ZuGuj0Wt9uG^7!cHtxz0hqTjqttHDxLTJOL>CS=Nn=T*$WYHfy5CFoB!@D1fifO;0AJ|*ww&LoSJFHLRsrLhhad{s7UXHc&+?$a)}TLl|7gpj zv{$5GH$;Y?Fn2c3Kk2Kr!HYkXh|tTpH3U~ufZUMJsj11<7oShGhDU~5Bf}#_#O!optY3XH#dC#^4;8?vuF3v=DGr#scZ%!jPmH(f?l4oq4|_b|yLF2~dbPn?{D&sX$C%GnW8vOFr)@P5g!V;um^tZQ2#os*Gy0bN%k< zFx^oRkeMY5cBWUHe4Nj^H|u20`QE9wIL*m z+Z_X=^qv-QCS;D00ih$OPe+k+975g)&Omb_PGc@TU=9#PZV)=oli-U81`G%lspP!3 z4Q?x8GU8|YvSK8FSk?j&TF;^*f*o6$ERsGrfMT&6x@(~*!>%YF(zr#fA*Ak5n$$fz z*SNNKruSrVp*1s=r&$z0@2rf5=&OW(^AAm)=f)|}3GL{mLc$c{K3hAFzc7Z6zw**-UVu6jfP z)MSW=zOOT9&n5~><{;q7P(8k?T{aT!asn90U%!66ocigL9*d}1JFOG}`Nao0h&GukFCeI2wmDX(t99!5$&!PTnsrj{ebXOD z)Z1Ug8$c{Qvy)KYSo&LH==7m8PxRToExmk^CFjzd879lMR^VZ6_6EG^K}Q}@X0w$n z+sTk{;MdoijCBCfZtWY_Ze*UwZ-1-LlbO;*^(aqt;22(WQt8XGw%rGms->O}QTBjP7dG-rPb2D?H?)&jQI^5hhyxFX=WPIKH$ca8JV*@La2 z*pzIG?7a2sJ{BF1BaM-j1F`8xo6C#mHuGqEi4J6392~PB8aP_P3q>X;>$E3N(CCVs z1$rg(=#Tq2dl24O(-$c%U(bmPoS=Y9W_U|<2bps?xc^>>{u!5kQke2$J!ir8?9F2} zkHm?Glq9p`i8crG=sx6#J|KpiqO8#3DvU`6yQizwmrV^wjvqSVf5t4MgA8p8Rv>`a z5}0RETW5l^Y<)T#7G%OW%_g&+&$wrA&6Zu$fA->Y?;IV@Lk;wgN_I56=aJ}+Lu4e| z*j?);5Tgt6_oeHrtLbG7Zf)I?jBRkdzc=N}1Q4~zD1|q{H5*Zo z4|Y8kzxc2>N85z_8`Hk*yjO15SGbY!Td!w1W7m3FXZ~>K_H6X&Z%(?Hot;ep_cY^6 zb~U=ECs8ly&fu071B7E`H9=_C>k!R6i6!?HP#|u#i7w+Z?t^{W60#=2ftzDvRb@Fb zk}6%U$z}x-f`1R0(B6T7ddgS@IKf++cvKAd2ML62(fzTBv9gV0!49X5Ak=i9&#%^| zj0Fb5O(fI?6og+8sM5e^!!Y^>I|Z@UkB@%+Do^%`eD%&ce^SuKPY7aE5UziBz5L*4 z`Hk$S2#9B7(YvwM{phhSPz>3x51aIkYcK5Vgd z_2QLgvtVpO5@#jrfk&(chxj==z6CD`FLFt*_*K4fej|O!3y+F3z#XzvHR+DNXm`lD zOTix%tbo}jzc#((ef|24WcY3u5XmT*U`GH*IhFw`Srb5$T5q0`(vEsKDOng`jxe@+ z<`6Pbgi?kkT%R9_qtbY<^f5L*o;$qVkrgGkBTees^<=s}|NQe9OB&~+)Mcn~7#0Sp z;D~`FpqZGQsFD>RM*ft>fin_|ICy3=MXHQLJt4+3rKP7mv$pB`V(5C?jGrPSVUB#@ zl&@a7(wa#mH#j(y^6Ke|ra1P?m(t%AfE(iU-zpeTp{NK&6X`X*gR&{IV6wSNL^2#e zP^QUTH1>)LIT7+Ng^RKQSDRu+MouI;+84mjQxIZM>`o%xuy!Mr-Kaa0hv{8~JF6MH9e0ZG9K4q7N`ZiBg7K zkiyy9+t5| z=)z)j!LdHbB#bo#m22`~drMD&AiBRk_aHrdX~u4mk;aW`+? zEPFk3#_=+{VpDUqfe41t0~t2tl%2u`yWo|}k)MD>wHnCy$|R44IFb#Y#7|fYGPIcp zRt*gdR=`to4&KT5j-(aLgA)W?Y`lvS9{>Oj|4BqaR2yy}h}M=a@V62*+9LRSV`6)H zW05!VGiUOVT(NNvc~-_|*K|)6!#q_oWl3eJWf}!xZ!!nLQw0?`MDAHOmvvC#ur~BB z!!KRXPEs})84H9}1menK%i$5R4Z47Y8mBd|-tAuSBG18;caG*EB>617`{tW(>Igm= zeMFlrlO0TOgcZB>dbp6i5R*+?1ET5Pu18yLoSP?D+hRs}2U zS(SwEw6V{3zWw&wx{fvj7*1cVrEgTrSoyci3kK2!HVPkPZ}|X~mCbx@dWQ1+`EzkH z%{f{Gx{&9Xa%_ycc~E@QXl>D?f0cJdnE-_$a#Al|OqXGb4j6}>aRZ%$VeSFa7(xjx zMx;FFm;;M$N0w+(bR}&Ld@Q710_2GS0S8J!nHh5R%LL3hSD>QT1Nce9*K=vJKnNa! z)1;u&K%50vmXbjgG5B#U?^7OQMn-M4aNG~$1)g(r*D8W9rx2%ztS~lXtj9}b4#1;7 z_XJFg*SNfp0?!nU9TmX44*;TA3ju9TzYHZ{M)B=fx2rp!uF?@8aV?H+cQQoCW^Pl! zYu*%*yeO;hi-wyh%u|EX%M()UY(j)^oEHl>%>spmy8( zYz%*WeW~Omi)oEqgDyG}hkWe5l#RBA*3ZT-WS8>=mUM|T=P+smNY+ckx^Xso>Nty( zA~HAR()H<=bu~6e<3ymPXUg)T;jOvPWJ*fbpWNvp`N-l)bI2%6PTVYjQ5H2$=YCq3 zt(hM^Zir$UutUz=>+f`-d1RgSU`xt*hqKFGTL^HMg(3&`1QZ2Spj2eN=PPOL{ATn*an+bo9o^$VleXYRv?=&2wbrc=aAVc#w?| zanPK?-DD8-^l^-2E^y*h9j=YYBN}9lFu(`I-P~oFJ?_*-Hsq0Rw=tp0sF?#`=0w>Z zy|EESx!J+n)|*XeOJVPvh(289PIH$5LVN^QTe8~{;JcRh1jegtjU#sk9w4XJGNc@| zN1Gz`WT!OhC@c45&m1Woqo*<*WKYLD1;y^n)2Byk9+xj)$!BHD8*&IA_4g`gy@@>9 z*r1xRWL+~?^Y=ouT$6rUE4ZavB>T!HWfZN4XG$XzWPv;*`fLv&vKG6tqg2+E>}!Kp zbV|u@a&o#HzunMUTgXMAe>&r1|L_?3p3MdobF4FXhX*6q12ryo1rz88vWfsX5ZY$C zYGVp{GH){H_@5?l7o4#z)r>Yan41llNS&kEI8bvz63u~3=qdZ43&zgh2pDV*fjM_% z!SfySc28sTv(}eQG5skEM<1-O(x~fnZRuj_6@ZX299EH%RqfbvIQV$9 zg2ldElg#@c?ojNnU5zcx_9ElNd6)a@}!^0B){<&2%UB-8B3pIJBy1C zf_=>+Gb_-_=k(peJ!^CHXtN0sK0Z$+K^ByAgkySsVTFyi5+)g5`2m3dUkEo;cgRRk z(jOhwhDOKTn+&$(OU77wmUZ6|JD#1JZAp;0r-~81ay>8dN5EUchz zJvaOR@M;)JZuA#sEXo3Et~D_+QO>uL&>8yS^RlEOJVfDn+97Jkdx$P$Ggk5i$V$-+jXv5GrYBG762JjSdV`#C zpi1D+q6d!tKw^L+5^b#kzVk+nO=C3Y*4>>xx!lirk1|l?Btj(D1Bp77a;*=?4A5mp z9cT~qOW$)3V0$OK`#68==qxji2v~Cj^u>Gus*D@pCL6ls-c_oNU62bxMW3x7xfh|# zS}Z-&*B2m+jv)^has-U5m|m~3@rnG~?C!TNoSFLyuqp^hNs2DnxoFdg5~t6|yvhJ{ zB)g#R)tKoWAZ?uAd}Ope#8ALVTY43U!@e59j*BX+wz{n;60U>$Qg?s7ks!VTgrZvP4QBI?`x4-&| z^_?0BTXl^(o+Egp%>dbKblcNen!ZHym7Vu_SU`u3zo#cz*ElTp$VuAm>3785+`Q;B zLS_AxzUdpC5MUrI^ky+Qp~u_0SU;G+R^5*-_^j{HPgxKZo+i7irqB>f`XS3gXXtWJ z<83=iQzA!FKL4A~D?2xr|Gt&u*;&EV$Zc9f zC@O26Im0knV>(H{={_=qC~Qx8&M`$CB-~Ygm02Zox(*WHchow+wvV~8siKh)S+Qw^ z>H78WD!EX^D&Mtv%o=*C7a0q<}d@{0Y`5`O1BtVdSV8`r>uOM3_6Irre z#_w^P*7fO=^uGp!T#tW?nw8GLiP}LN`$S%B67u~BA)jxKuCtafjxNAc_Bk>#oM5g= zXy~~nZ!)@k`EvZkSj`n_QEt_6pGS9Of$4&|$u?Rq z@<61uNoiZKX;1~Chi8^I?;4 zny)}gkxAD5gf5QewplS$`f?SBEtzjSPPmBXC7>@nJ@CKR~7;u|BJt7XXi4Zu<`)-_6Yh( z4hiPK>PVI-ul_lTUFdL?Cj77mr&AK~leknL3Jq@Y;5h4opD%N*^{ z&_G3j0NR3BWQzot9aUhVHCu~dDYj#NERankQthHyq<43mn5a`Et4Wtbki7ulGAJBR z!jXy=I4N`SHv~`FlvD9cSS3lNdTDiw&f&?b%2n6F$BA3>;CLJN4h!h}mk9GtO9LQQ$ z2k8|Bo4@yECS@K)X0vm1HEu`KFnY=>OKc2`OYaOKg-`&OW7(k$kZh>&nYKJ8*+rR9-O-Wp6U3Pc^3isA!e*l0_0kSWkq#Kr(aU0K5+vR#wtG7?PwV0=WVdoG73` zf{-m^;na-Pd$Q{yas;%Gvx(#M7}B)_CeK%Lb|P{X-QxV%hTw)n)<%)(=ly_EbYWNS zY25B75J67ZhK(@*7+`vOi1D%s4#DRUdl_ce-^hITBy)Wv`p`uE0sS~l-~^NfOHFfp zcAZDgh&ZCaP5`%cVsn+*&HZgudXlpT*F%zIZ8#VX51PJA|MGg~DY&FB?J?19!H3>d z*=y^@IU@jeUz!YCbqazWP%>50qbD4?tUd>g%&=wuD!JN3GIBg+`urWx%K`&!W7WTm zkXa{LGmfJxJ!xwjDN6+#;7nyl=tX47zKv5!m7aN#Cp&5Dv~_Y{vR9s_@7BW_k{SJC zvmED>*xQcG*@u0HZpcKCE5hL3p7qTp;HPUKZ2~E>;Q(P49Y74|eU_tanLfyP*rnQ? zY~q&S134Nmf<*q68FBA8#qqJU4Z*2oE6K*0l}h*me)B_A*bpp-gED+8vFG0GaFvmU zJ#fwoxk3qHg!!ARYp}K9W5e}b!C!`&_nm?u>(`vOC{u2Ofgn#sYp?c$V9w(NJ_0y? zgN?~T!dyY@LbBe<^Rn;cYaDb*uuj)yQUzED1^li@QKppp`c=jm9|Tin;W=wQ2sQ{b zZ3=Y+9$Yc!!iKDc9y>a~{`RMR2+qr#>4k%Pa98pIPS!&Wa&PuZr<@5%kF@0Qj|k*) z-h**SA54?wWgEUD6HhN(SJi`kZ_j-NTlAlgvo-=J>kV&}tl35RiQLnR&iNeOvF-vf z8#d{_Yaw-W!CHr_drBR9Z&&qT9la*2HnC@Cj^q&pTQk)$8Ee%8_|di@b5jbZ z5Bwl|k?CZY0x~$Gye`NfKZzChBWIXP5BXZUjwG{x`eYpZFfq8rwKVxpzl-^8DPZee({s+SwV1zN+WVM!aL!)M8XZ)tbk@bLE zHi=qG^HWJM4}616$X_B!ZzNq7tiopgkA0U;M<4hZJ=m2!%{*-^Wt+yrW?&57K$hm} ryZm_JX2yf)vT>&_98c@QX1@L}tBEsRpfq;M@N=pG%KtRA0{*()0p#HpHB6k@B0N@?4Fnj3Aa@<&c$z=pY_ScBe0nu z!XhwZO%M|pp}$E=BF1;&L5258oxdWGI;PvAr05Ml5Ia7Kz`k`ioe}G zFP*hP;s`^i2qRI0auh<|1;I9eaDHF*gf!?!h5+ONgIWWl?oxu?l0i8G8AymRg4d0R zslg@tS(LyP0#yqkb0M(@)Sb}pfjvSZ1M%uZ2SNwzTYB1{4+inxkA3x7^= z99i6%-`U@x_z=7kij7tp#WEw|@KT};jhY$Vuux>u%Ap^?S%9zwXAPS)s?`!LV4cRq z4N{scntB=`8{;<;E(xA7dw@j@(QL;$DRc-EfKv_c?;>r*?=o(^IFofKdcpSaZh&3J zC5*aWcRrzgA^hO)BmP7al24>OLLq<&g1{n;X^2shwxU`C#G;f(u>u8((OFV6rPf60 zDL7H;QHarnq@<**WR_%WQ@5n{q*7&aQ#&YG$gi`=Wm(C+6E#wRrFo?`D$vKE$KY9V z3l!bSCF7zu3N8%KXwNjyDdgfaYRQb_$!ql5jLY=POwSt8BxPj#l&u=Hy4ApwmN|wh zt{DhxeQRXv@H@(5mt)Rj-x+jP3|!YN;Vg_SLRNRyMRN&r=ccYEgC_cA{$S(Nykik;BGBuStC5gQT7ate5PGF~KC%TJ(%kE9njmFLPP1eo+&EXz&6?HXZnu2`! zMR9)dMw!2|lDd;>r0P=LRN+)Tb6E#)TAf9qQMggrS@=2zO@3UKM%p?-C1wWQyrrq= zMrI#jf9Qv1>Lz`X?oLN&XQ|P66$P@o5vEw0QQAH2m|B-QrP{ojpPF|yv>H=YpK?ic zXEjANW=)cyL{qXi!BQkul_-WD-LDSgAUY5m< z!KZxK@!?7G_0kQq@2NI;M%lJ2CNCaU4>Lz)zUdwe?+zCB>2?~{58w3`)_(IZ_N>44 zh80217O(BZQ!LM{x-^^D?DNr))o|AgX*_ixNO)@HcbZ2blbF3SuXH)VEe9v1~g5aqi?-!Q7k3Qcom(%LUay|@xYrhv9OE%2|k^>?G zvOb$ZhCuv64y^@59m*$!GIkH`GOZf97C2tzPF)uvs#%y|G*wN7{Cwi z7NsUV6+IE96k8Yb3=@Q#MMe*E|6^l4Qaxfp^i?c%G)}A@UMI_qMXC!1RW%15HX)Hd zraO?Fu%8rt8Nza&ka9{RvG8l9FH+RM`Xp z9KK(7Mi-WS7M)Ge+NRD5&f?BYyLme?JCe%^XT4{Q5E-G#p*#g02k!&RmI zr6;9Xdy#vi7++-MWbif9bB23!tJAZyR>s(N_HUtP31%M3;%?uc)xo41B&KLn#U>Qn zr3~*vtf<#{dimc~CA>zD<+9`)EIiYV7anRemN%Ba)k@Y|)?Ka@HX8p7FN$-(PjCq4 z9C0{Vt8L|Ryp@VqRG7rtNiSvic9^}7weP=%*Vrnc$iYPA_yk=*d~!>1`~3Xa#^b39sbs3Qq4eq$=^!3oDC<-0Wp?7%Q=UM#od@AY-1_9YpJ&3) z{A@s0@mcY9@6Sh0?Ad7eXrT+;_Di2A_3@XXM$I)^hI`sYrQ?! zg+B()p(~IYk?x5-1lF8@_fp$QOhT^yeF1ZaR<2>EO%Z#dE6Q!z%`-6sOet$35R) z(0r=qRh%nu$yy)I*$2IRC?)^UJ zRpc-5^gj@N2#Z287|V${iy6v0H%vNFXmw{); zhR4u_#83I0oXPctb@^|)pBrI>lW0|>``Mf{a-RNl?cD@Tr&SuPtlG;0jvdJcN?{Zl@uy$R7A{f9@62W}YP0_9YmlCLs6c`+FX&-Sbc#cP+uTC$0wKvQq3fRd{1ilx z`8tr$eGrsDuhgOMQ{!2W3(e^?bC~_<={wiRusaM42d+sdhf&Y$Y_}qqAbNZtn@?

S_L6AZ+`;D64a4~NoG&8EDMW#N^Ed*CgFMRD(@Z9xO_8A}`pn2A6T5ekM za=fOF_Ke16jwa@eUiMCZGF=c5elOlXMSF8MV-hcWI|o-@F9E>c6uf`Re^oO9Nd6{q zvlRen$t#hFIl7pWa4@nnG6MwRNJvQdUCbbiI09d)XIq@da^M( zx>z!?@bK_3F|#tUvNHUkU~u(za5MH|aBwC2myrLH12lIvb+LAGvvzbK`Ae>`iKDxl z008ipqJKaCveVql`ahZ+T>o+FkAqBqwJ@K_8(UMziN4vti8_rF!TRS|Npi8N8^8SYX66mh4X(n|EuL6PJX7p9QZGX{uQmiYyX5x5RRYe-=Pxzbb>sJq}yjGKug(!50GyyOODH7Oa-$Tas&jL@<#6$=%Fo3sWLigJHsBgh0e!*j2 zGzh#|5{wiCIT#vfR3K0oK!VCm3-+Ugh!i>Tf2&~tBvC16F#jg|t63s4kX(TbLWYPE z^}ngnsFtDsOJE{QEDES}t^`afzuX`B|DhyTXhQxU)i|VJ$=q=$)ZUqYTk?OD(z#~D z|5yIoNM=z8a%VhJr5omdZ2nhkGWWRPf6E6Ng~CYfu!|P%8UK&jYpIY!UQEpNdI@llw@I$#7MRxHi-i_u>(~~!d0A? zE^mITh6gV02QET;f%TM)fyYgQwd%lrFva}iTCNntn}gRnkz0#LKP1NlCw_|#hnveF zVQ3S%LWJ1PG0@cyT4z-+@)r>}8@9D{J`(it+?#&qhy0n%Lvd-^dP@h4Y5fN;E80*J zK`{>pW}@f6`mqE8R8bZ6!C@_O%>PO9OSGEa>u$G_QesFmtEdDl7@1=^pr7?-==T~K zxY=s{!MWGYFX+ZHnF!8Rt+$7=0upWb%CfoRIl-quXs5KDUuBNQ6S;13z3k}a+3HUl zWLSC)+}K?H9MGexx@6v5f5+d+0wBx)5BBxxtoN&x?Q!6*TH)J#&#TxIFd(JbPE{GM zrA4=pWKHR?bl~B+sG=-~;FlNgx63@(9+Uv)FMerIRn=!16#E%&|L63_4RgO_d-P16uoOLkcFJUrt7HE1^MkyBjarodo(sm;V@oe&g(+ zE~I8>Al$(e4$hgg)OeJ5j0@d{E$fg`;hu212n>S3Bov`bdBAo=cL`J+#p(6h(C=b3 zZw5v|U(~wK19~7DVO2R_+adAR1qI4gaYYUKtEYoV1`koBoKP$`BnkPKN%gYII!6&d zS!8}0LSB9wV3@8qy{B*;V@vk>(Zb8tt@HG37V1e=(9CR*!is<~`Rzudx<1i+nPlLg z>o;uqeTt>-Z&+pb>r)b?#t&!wq1ks+0Z|K0DKFH)GEghdP#8)?=E3k!JXj-xKNd3_ z(T^i)nu+Y~zf#lI0TbYvLq~>e+R5m`$b;JWimgLpG7G*qd8n0mU4CrD3dcSOJIH+mzCF0ddN_D`BQgD#VQ5Dr0rpwCggesgF zv=Y!2e4=mISPeXWcynMW{FZRYm9IXEFTsXhJ3n&RNN6wkBqQ>_W;4qT0RPp;2$}M# zFPlgiFbnmzcR<|F?7^#Y_)F4f%(mlvBTdWgUb|y^;aCbTZX~p;V5ogFf+1}=v&g<* z@EfQp_xG}|CPK{nV`4Cg>_wJLMBmP>sZ&y?V&}K&AJ<~K^Znpmn^Kqs)mBC!2X;nB z6>GcJbYzq|I*5(kAGrx&tk{)~+@4&H&wjozrpU&mB3?BueiR5t@ zdoC5V_|r#!R~JzSk>DX}UFXnUTkelcg;VWxo9cV**$N4diZ2?!a2O6zn2Jp`K8o?* z*K=LX(Gd?wYe;wksON1$C8)Oe5}1Z|=EC0oa_$=mfRMAlodl{A!C!9d3qQk|oY1JE#b7yy6xAE;OAxzA? z(R{#0gn&7L3gvH6gVGOS+gvC1)Lo%PfACA7ejw~E*4B(SdS$#UaBM}gp}QHH?u5)~ zJXNj~SY-^uQBrKj^<#lQcArp{#rwgFJ{tqNmte%OX~X%Z=JecJYy=v4D<6|ZDo2no z!;m)tf*%i(t%7X9B2*iX4vIMVn;)@F^ukt`Zh_d3JANGMI5xs?`Kg0uYchxDg@nfD zM(CAL0&;ByXqNf{G%M_`l~d&|OLRdWQ*@8>sxTfl%wiwE+2GAniDl@7op!~x;tmeN z_Dyd{i+E{~*kUv%zNvP_p>7)!A>Rxb)CIYm0O4Trr{*CmocuJxT5F^7jGBrHhE zAL~oa?f9R*-59e>Qe)A4{(%w!)XCTZn43L5Eam25BI{ZSO^Dssjkf$)zh%NlDxZVZ zhl`z4>1oxN!@|h`0JNkezj|t*xVXv>;&>@OfpqD@u)A@i7~x;T2pt>CkiPclqxAV< z%qG4N{(d*mkJcU$VtcpjHB005@k>ch%HMp!fBc|R+UMN42|FZPa0ouWN^-lQbCp;V zDPkEERd$yP#>3s+MX8t`#9NCXv@z(P4Xay_p?~#)H}QYBjgD|lBp`$m?+;&25mi>v zN@%^b7rkAiB=g-6)jG{-^fZL^_*yx*r>*_{dt}gYL)698{C>rBbYMX>reXqm9Oj7C zTv@+mjEI>YC04#=h`^d$HwNT9#+sk6&(!*QNMLf21UoNIT-Vm%!Z%sSj-!_}T8PR~ zC0}3aEMpjia7xs=Wy{bu#i|G$TVSRMv4O8Oq{U=jsJ1FAigQ0B)z*cuq$*^7z=d~e zH-c1gT=71$35T5!I*zLiCX=z|gLlmD^Uxfd@`rSbx%o8H#SPk)R?iuSDtsSR7=k>B zP&~T`hLas0&yu&HMy1bWZ?^*UZx2J6oaSInXC|>onxXP2=Xl+G)7wt2*H~?; zdV6UGUh^86Rz~!()smtmp{3t1ZwL21hNi`jTbffY39Twu67s@ou3w;al~$J&&}v4` z;Oj=7oU^2)V#Q%Jo5XHC>V2y1>`@WW>x9kxX+@E_p)+@$c-rt-E&!>VZUb3XLxB-^ zPDK^Hko)*Cs2;zxLc?^8Fb`GGOy$QV)V}M4K4KVqYGb+`>V>p8kAE-Gj!1t1FN)&% zPJkb`qPMl|M-B+SB!J55AHQ@j>MbHdBqSu)lvy#yM>(t-gj2fW8~sx5L1?(Xx@(k0KL8JC?fP>ZAa zjTrG4YgY!}RrUtG=TFF*vQ6v6jPB4lPthPYTu&2k8AY^O+k=6L#H1xeSR26SHX6|H$|;G{paPGs&q)!NC1m*7zm7%~9U`C< z^nH$ArnUpVL{p860vxmKRJq9;`2m9qaFY|zAN&Tyd$xI%PXuRV_{3?2d74(y4%IK{ zO%VEY$LFO9TWYO_{mH?Hn&e4Qmx~%-x09gUaRC11^O|?hSWNBLCTqiB~Tbv*DArbISWD*XelCacsVQJ>EIu5<&s>U=XFV#-CUt zpam&SK?XLKv(zkhXhPc5YL7mB&6JuPl-HKMT<;~|sqD7h%l%&F?dX*6>TuCNLQj)) z*FHRo|T^6>1VbDvP}q?ye8c%3g#6GL7`gaXDK4&?YW*HuhF?UT># znnQ(=ukcM!_Qm1Vjm-|oCr9izA1547SB96ShTOe5WF;(omh`NuzXu70bl{q&1DR`r zBsR90vtmWi%rW$uE`wW&?mABzdcT9pDGd$slpqsBmTloF@M0C9uRgLD+S)--E1dGB zgiqh~**XsYT4&TsKMEco4mphOE1aJV4axT=#|~?adK&RIO+vAN!OMz)ucRKBJ37|3 z+!xVSW=GP5v=2ej&vhwM;02toN548gu}oy>hmP*3%$?H)c|6bq`C@VSe2FOY1(2K3 z5%?!VP6pMNUZz){j@d2;GMYfLPGrb^9*x8sq5Z2jDSzig1Xn#DdA%b)88%|ClPl2n zVrFc-67+HML5_RqUp>H~Er&ea)h9m5F%f;07jJ?l_S+*XjWhG&Cw zRv>>HQY8Eu@Oa8nf)EUzXTHb_ee$SVSjZ5UPs9GRQn>HONoV< zc3@(;qKRRHl3jM_O0ag%Hvl5FK|DcZ)J({s z;{eglhYA@tg>pL>o~j=ME&PJ8-ekFE^=foXzT>`cwZX`QJk`6ZvW&d=Zh^|_vfk9` zUOmP6K3HplKY(+?%bTJa53r5!bEx-QPF$M~_UPe0bg$j(=DnJq1KkHm*lOEOQ9w`J zxa_wW>neex+Kq&7pIetpPbFj5X~$7gg+Gq9qJvcodKs|T7+;}cS!@&AEExLSpTl6T zImp;~h^-etPz-xb7)L{oY2LZnC7?G;2*oeo@C$lBpolJWgI4Qu!qjY`r&{1W4L<>Q z?O8@s_>%M#7q#@j>8{^b-_d_6>uSWT#ZZwlP+)tfP??$>-~gA7FX}0-XI(gm+hAZb zBcN9K15>5~SJ=RVBI+d+Bc=>uyua*gM?wRK~A}OQf}TQw0j90X5VJ*@!Ald+P4?E<`wFD zo%_lC_^>&YpB`S@&}UgC;WdL}CZ88O{`(#DCv7>I=Lf+=P5|OBXRfWX*UQm9WG*(& z224-?PtA_8&Cqba?(5Ob{C@a?vr(SiVid)lx%zOwueeWjB%&u$xqhqdN>lS8`QN#L zF1NODG5ZpkqG2H<2>kZ!pYCdMzxAA!Uf+?}+aabV<6uR9uchaEFz|7sgsqPktxWS} zvtgbqf??pYu?O)`W?ySq^+=DWic-vO5{Sz9<3$F7`NR-zJ4=6`EL}0PCl@tMPT~!p z!3iVIG4zHG<6B$Wl^P-bMI&4tR2>7s7iYqt#eRDEG#MU8os}CHFRm?>!ws6GmuZSV zTS(0fjh)L?K#PDaN;VjLQW*3oupAIIAd*n|xG@$k-+e8uiBmWE1E_(v3-w%CXQLB= zStIL&R7TlIt{_>AHZ(tn!UDyEo?Yaoxh0t(B-?}%1V6(B+~|4!4#Ne(#Wj>i*XOv= zigv2$I1sJ4n&ke|ZlZt_HHo@{ybMoXzdyG{i=27*yA(EFo&ZsjH9GSr0kV3)dF0QD zz{zrP%V&k2R$q9EIpYQ`dz_TKK<-h$=2dz%&6y9oz;fY<^A=c>cL+-GFEpKOSQk$_ zeC-WmJFkJFd?ZOOG3j81+H0gcsy@>2aMOb{7bhB0ZJN*?vA74Pd`GX zGNF?AxK>W9mGt#u%b!-0QnRD1d;-FcR*n6vc#3CdP%-ht8bVmgQ)6p@yXUD0W~)I@ zm2zeZ+3~^Jrl@5O!sEB!B;=!@(ir(%EE#~&ZLsH6M^Aap`P zQ-iC><61CFL1b!5QsZ-0$i7!W^>eO#aPyX1vI7W62zW%X8Gcqt3J)XT;&kLA2X_-2 zD;gCwmX3=mdn>_x4`PS`Zo$A%2fs^H)~@N{bcU1z#igaAqNm+|a5)OAy261KIS+W5 zm_WMx(~Qq|7NDj7#=(eizXGKr0lrTP=;LTy6F^NiI3ri<%o+O7Be+#5NnP* zX(4yeuxpsIS5J)I9>*D@E#vjo>|mI%<;&9os=cfibOi zAJ?L#3dbzy!0(^_EmDEpy|SuKSk<1vqi!>{o%5n_iYhC}W!L#3>^YNL5L_9xu|b=j zT$vQ-=y{XwdI2VR&M>afBv8N4?hM?4^qh#jHFBizQIGV|*d}hHI>vUYTyD&j{_O}= zr33shI#ZEIl0xI#3$M*k1?fZbPZoxB=OL&>9%o$SHF7q6hL&Bp)1ZWRwXwil53~=f zUtuhqZ1hm?AYz`z+;ye1aZ&BEnTbKebKFFhCY1y$Ys+cOl1a+TQh+dW1>7H&R^lCT zXzdnw(QMOHJX0_+V6+>u;u@8xvrYjM5?*1`ZcEfu3N7$^vqTMKxbljhF;+F1amcY2 z+r)tMhLA9HlsEPd4GXfUZFu&Un#A2l65g937!(|-;SpGqZBu%{0LT%DixmTzNQJzN zl_-KQ3APy(Vi@k8gz@=#0_aM`)13}ulTF{Sdtcz-$ed<7xFaV=v7Y4!7gK(a65F{I zw=JDC!aTdvWs!4p@JaFR*Wz!TDD^_0O!S6*Xk2eE#F^V~Fg2VGBYy2^WIJWhEG)S( zuS)($!zFx{zWQ7XJ$co@Dw~dOZ+!cJ(axO+`K_5~ zv4i=0yd-Y8q9WlfQu6y{Fd9`G4Wmls`^%)zjwb_R$#b+NU-Xju+dCDBKNcDep|q+A z`+Pz$e`5zB!_v#!<8|h}i5|Nj<%JeI=qRcEpp}jAC0JfM?{NEu$`$7=~_SG-$EBSgts^YN91tLWWPSFb)f}F@M z>At2>tUW(EnZyJou{nM6)Lh~`Gos=k1sN;{8Yk)#LQ2E9b)g;|mA_SG$UxSU0xY4I z#K70~U6oa4U+d~4TNf4s2F_o%G5TT}rwtnMGJ6gY)tZamUD?syz|90V&c98rHr&kKd%b)`Ga9guY{o@#L6BheuZ{+`xG)(O zSF*os$tp_2nR*Q6e7}NFpmMD)1F*2b;yw!=i2+c4jCoo0kvOa9q7cH{sXkk0%=v!Z zg7nrWJwBih>7d4^Sc#Zal0l>DjgpuKwcB&<1HXq^!MJM9I1wPVkFF?{lp^J$Z7+-^ zwZB+R3OQxsL3V9ILvh5^z4lO3o4v>dE;5!n4HS!f`Gv8U*ADS?N&EI%HP(=vh01;> zq35y~l9@yh#7(M$R~PxQv^pLlnb@U5OWjvUwI1X;Y`EjA>=SVOPX8&;2t%-7t8g~5 zKQF-omaCO#*GDQPi>$1g#48S=Wm?P4&fZ=kKRj2orr0sGaJ~i|Atquv&z(8!a580G zf+Mwjhf3C;Hh8!XIL2Vy)VmAzQylLPP;Ln-vgJ2LPvhb>su*ZS!Fuv@aGPTvP~=0) zi>v0_4#d#&>r};_2@|8cj;wJ4AY(uj_x6QvgW=>(p~VaZKsTy&hQ+PQH9&c#FD|HJo!Z!l zPd-T>pi&;eO6|QurHcf=GmebWWSf+RnKyY;U=G{LB_(H)04Br*<#?!^yCcSC=0SoN zbawX!8Ph%G0q|JdU}mO!H^ntSU;NUPD$D@6L>@ZLxXM||N3~TJS}}TeSN^;zsrd)A z;ks8PveG4|N@QU1K5A#nvG=w@BAp*56S4`SaAgum+dOM6M85b{Ix$G+lDU~}Va^w# zyQ)Ez_o?~wN@zbif>xC1yWUt!S!)B!h`leth1sR2XrRTEJHkL`f_T)wr}&u5yi>_s z=TYy(er!U2Oa06xfso*GHbF+ut8FjIBLPa@n}-@x^d8`}{F>DZ5%pKt1xr74DT&ze zAhpr3$~vUsCz8d+xgNU@i$rcVmMBJg5f)frS`E6m%KEOwOAO1-%zdDLS2^m>&XxZj zpA5%ECd$PzKV&!$VW|qOljl$^?uNtls6wt@H+-_27RfSQXX_iBECdf?6%j@O#dUDT)~YO| z=j!%b{mJV|!{Y`oj0qie@TL%v=`Gw<%o{;+OCL`Ngskmo z>1q9NO2P#YahKz~$A{I0UU+2XvC($cUro18*nr=Zo#s^O=M;wG`ZWoF$O|?@UNKmJ z67^Y=N#wNmbLir>`54DYw7MGKSI`S{B`!uAnr(~vK`VB0z^VFkO2juO*%o?AS6DBylsc?I_nZZ zRnU=3PlXUPEt?CWyQ5GXap_k)i5`AZ*{cLi>)|j~cW>Kx5>lbOx)S~JTTs*-Sskg_ z()4;C-g?QZ5Q2m-<9&xmZS59?v$qdRwtdgYc-Dm<-$Yh4x${^ILzw)$s%noW(-A*+lhZ#F)@M zBm=qmR+aZF2Ocl)jQx+0YMBrt7Sa<8Kb~zSq}v94I`V!gPpML~GqZJ^wYGo2Ve2=6 zG~W5Z8=oZg0nTD;m8~;f=kq#byW!IBFphBMngWz(5|^aNF2uiVK3uTAS$mQinVw--%ax-knCO1b&kRW7p~n%c;L5*2uPf36a4H$zhTERU%2Ef|V^Rl!eWzSQ{A zee!!rO)F?MedEtU54G{($bb>fy>|QCktD?+1WIBRD<0HW=3(%so&#ets-G0t47NYv zWBMD^r~h4nR^8(6n>Hx_ryKI6U1@A4J0ilw#oSYt@HD}Y7)-g z;MpRdkoa~r*Ok+sttf_gROi!x|6C9{i+b?XwyUArnyX9Ha7@TBMy$;T`$X!;#?!<| zXkWnK>1B9HuP<%-uSpWZ^nD;e__dKqD=7e=>q@@}H>Ew_3*K&~7del~+d?5X@{`YC z5aZ#NiJteWaqhE)e<7^x#fN=4dUyGVaT-6$=)M%r%4B*mJY>bh;k zDsS^#Ma3b2W2RrcG5);?>{3O=G&VY7d=V171W1Q=ydl5n!B!^k#IpTJW!uo&1j#5- zySOx%n3f*me4G?}O*sdwXn5-0wp)%WnA8azY|I$orNqXbz!_qvLA1IZ8!|~4*n6`Z z){#EqRs$0(A2kAgAmYp7crE;%z>QrZObd&mAq^3OV~+01QQ1DRSa}{^veJ@^8b%qC zFRirxT2_QKe`*u%yY=-2b4PsWK>pJk{B;#KDG#;0^?El+@6(gNy$Ai$A!^vSn@E)R z-V{$}d@UBlpeb!YI!<|__cUNQZ8%8tRQ`E%HwdCH&9PJTT4Rlt7VFAXfX9A- zO*^<2)DbmIY7v72cTQg8B=`3n}>{`TTWia3h=F0k62Y zBq@))IQgdw0F}FCk~>NBy-6e?wKYbR^nLn0TU%rOF^JXVaXO2*6vwUHkSKKSg`@TItj$y zoz;?2H2SE+?>#-Kyj4`)GkO38lt4f~ZfSK(a&AT&hs&0du>gIjg+)-}2Ufm20ERqn zP<-SKL1$^>M+5vwrLBX+X`jhTcSJuYALefI>zw90USatdZOI$el$Q<;H}WDU>H;Zw zG&E%6k*EI^*)oW#e{A=WNvyFPHu7!mu{@rgZz-INB92^RRwR4$nhk#@#KhQ|i+gH| z-7zjadXzFb;*Z!A+^lRNWUV=GrfXvF?}to1>3QQ(lhZ`Q<+B2RkS4;`*+=M#;OcF287)jkCju0_29sO0D4d;23+jkA#`; zng+}|5dx(JJsX|~5hvQA)i}#{b|^APbCmJayp}r|M{jTQDsP1pTkh`9-JS;U{qrfx?4rPmjI@*D=@ri>I^#l|mZ0LQs zqWra4g%-xW7;abpuudHkMT~dt`|0uqVOhex?am=ws@uGiT8gSR0 zd*nbp1a-jLO-loHT$Rd-Yb_;*8LtF=Ur_ND&w9p0Kb9i29C@0d9}{nBD4Y``9gV$) zqo)O}nSR)OF4BHKAcXWJLEkfkg+}*ve3aiRl_cfpx#xcAMFy4kycxxn@jQpS9qM#E zHxO=R?J4>r99u9mWUYsvUMCe9KIkIhv*GcXKnNzSIG$XphK<=YNU6-Z4mr6Q9NQc} zwFQ)wnQowe@HujL2(1`)G#mY=I5Af55}h=LBvFBk-l}>pc(<-jMS6%rK%lavz}+H$sb(y(#3zS%5zKlrhZr0=njnviHH=o@ixy_ zp{v4$3ed-kgtAXF79)HK;a}SM>{UZMpl0M?9& zNfN5*-gEIq2$Smlae%V&GUz3uY!U%x|LQu;(cMYa1q);^G<1P8;M+FNg|&#KA4|H> zCwD%5O_9i}LT2~IP{rb&iBEJM8lF!G4{yW$W*m;^t9vGwA3fFq>j@XnGRh=RQW~EV z!$Q*UHy8}3C11Fz94%S}pfbKFO0{)h-G}{JlNU7W*gll{uuMBLA6$vke7oaVX;mzm z10P3aZX{>if^Dq94tYK|bl8&R9q(A1sGaT380WOoQyJn=HsaYp6wEW zW{O(3!ESK z%uP8!Fa-%(p5drS`Ri!E69lE8ZA#LEM~f=29HKAalBwQ(2Zj5&Or{!1b>B z53EQZy6f4IZRJ_LKzjqWFRLf_Z)g<`517a*J|RxbHFX&3%Mjo6{B)pVdO&Cl;6Q0m z3{y*!ZUxs;e8Q4S|5{AHJK4aUa*}j4w@(H>c+bjKLQxm7e2qV0Tk5WmZS{!0rD#^E zt8@W3$qW_|&xOv)b1{c4=AN2T0hp>h5*k{i`Gb5!o~kNg{HM$xWEd4B z=z#ED<^)N47816_Yz-}`8L3No%y2JMEG*xayQj*<`e$*iEwu@EeDZ%uH1`rY~&O29S?ULLPEGdCXCm3Mx-|*H$UVg47nNL!H zm7s%SilVs~@AolDRF0{E0)cnYZfX_M!&aDa#c@9PA)IhbqZ?guzbq+q{mMz0qodG? zNmXUxrMcyCcuJ3TsXFGeZp_U2{@~t%l!F3AX?9)+q9cZxg(|dBcc_!gXKOW@c+rA( z#f2aC1@|&ZSu2}TCaRE8|J=L$2R&yD6Kk?VK0&!&S^i8utIEo)L#A^S%DN-<839W3 znff0b;nswt5e7Pypk4u2=9Xq=WQ^QqFgs+Kg5`&62E%{Taiie$4ofqW#6Zlrl)Z#j7>-E(fk|Bhr{c6;{Xx{E5t$EEMi@ z(Xu?1tGACr`4lOcDkBs*&~OayycsGIM-N_rFxcLsZ%AiL4*{mnB=c)c;F9&zmQfe7 zG8ln?%nIVkJpwfy^vv;-nR(t{U4tIj|7Wb}A!N?;QCeX+h}HlQIKwy1U2L?;!AfvI zqxIg`sn@Tt9=N(1mW6OVb2E^7HHOQHwBG7CTQ2m&3j98=NxYjVEy)hk4Yx+KSf*Ik zBmSA%(Rkfcy&4mXXof3 zSLw@2Tzt9*hQCVCHMTwyewj*ogA|ZLw@5=~hW+Iw-mVd7bVtJ66@^~V9KnPNf)2-s zx6>&*L#~u)J_kS%PMAgf1IcTJI=aA1=5U^JD`{>8)#XYX@V^i>GczLr%*97ap?g*T zV_>YfQL3V|jGHybmDQV4)%sm+%ILPGouUvpK2~9za$uX(uR2CIcb=^y=OMA~-d!dc z>NH;R*hvWs8}?+tBur%92+AK2Mp*d|(ORu*!?%kIVw2~HoW{_08-A0*39?~rpO)6Oe1@94O4 zpzF{-F8kUOz{f#^zB2(GK-fzBc3xR&HQHywWwGXlp8R96SZO&Zz^)D+jY{#Bv*+1> zLva0M)bpYfVp``#lpuszDmH{H4l-;7qIo?Oc6KN!D-TRvm5`Pfd-ZY^9&k|Pk7 zV99DDe$X%yp?4UiKpWvAygRy9U{8hy&Ad+L8EhsuBjy1m_J;F}$(2;BEyQDb#NX)R zpjq6%vN~WPE+ZUe0yZ8OPpV|;OIq7@g{tMfuWrL($*0l$>CfvgYweBnLWswxl+mJJ zuI|`N%od4SJUh3Mtc+t6C3SKMu|gicdvLbE-}n+%u4sZrkm#R5)AnUQ+CerQ^kbpM zIini3vaow7`(4 zBg@dq709#m^Fii7F_TRg$VloX`@a3jLH~j@=l=R@Q6$fY!qb1>QG8^S&}c!FXoZenkm-5d(!8p?_K{O;G70YlSA5?&%)HL?O=6=V zzEug=+<(rSB$uXhnr;6Kjt39IA5g+D82hqz`-m%rdn=9%Di7p3g@xUZhyApHYuQp)`DozQgZjzwWLrzCn=K;d|^szt?|{j z<8Xjn&u1Lri~Bftc{5QTOqGhKA8eaF!?5MZ$(&g}T?#rp=f0QF5=OeqZseL3*}%H^~x(`8-#-oJiOwQ4G7Ax_^ zGvw=&rpE?zRfgmMe+o22G2EB#=?$#}`A^+2SZsqZU*bMdfZO%8)|AJ|Qq2TNfTW9LI z8{VyWgAtu&Jff+oc6LuU*i&$F9kJNU0I(($Lh?(aqRHIUF2wf_T9<;Xy{Ih_ns&Z2 zcMdUM=2m$fK;tWIPKCVd%c9m-^v)Xpp1yRDv^8Z|aHJIXW}IHaD{qVGXAn#G>v8sS(Yr+OkAecLar0O}aABF)o`teeN;v z%375#nuaQ4@73J>CL__JC=;%TQZ@vCSv7@20--!mVC`t8NDvW&-F)%7IaZP5Sr`&r zW%PraRCzudg~I{VV)PwdH;1<2q#ZbN_K=)8%G9vBx;_P z<&IgD@ZcUrq$++9+#U)0O3V>E7lw_`G)q%QcII750%A|yo9w@46zO02%`nyXG|990 zk!1QmcX*Tn*($=8x`Z2kN6w|WpD1t#av}yD5?9E{aYXD`8O3(%NI*kRs-2^G^I0pY zFLIH&%!K1Bn#$|b!TRp{nOLJR3%!7q2#G1se!tEd?e8H{8BBz$Qci z9os7(A5VN(eX2KJ{1ywoopZd7Zr$mHjVOf(=&mc^aCp)eW*4*i774_dc|3L#p&m}r zUV5L}5wLT9NXHP%u z?TQ7DCO!_LfTMAr!k|QGva)YO^nuw_8Z|r=P)OUxE_TWMBP_Ac?Pqa$x zsYI|?N^_Xw?OAH-MqNzU2V)v$eV0+ShP9D>C@e2SWD%p(?@2FQ zo1a|ZKNgeVk3By5A@6mk`#4~jh)gBU^Q!qZ#NmKF)VC@-T7K}Zrhf2_TOdjY{^apu z@H9a%Dx)o9FpF2vi$i@Jt3xkUn8wuznK0sV-D0HRqX}VBPJ5@!GFOEU_S@U*I!*yv zyjOKs@UWGXv(lAI@23||@phQ`(^1;vw$2M?>@06#(+JsX<y9er)C_Gc?Cit23mGE&TO0d_cc`66zmp*fP$~RMK7*VrSkV zQuef>tMg6MELQx@JZ@+j3+#u^$8F8eS0>6_U-(*b18L45Z9sht2^{Owlw`uN$=?i; zZa|`$%;>$I<>#wZzhFltrhVRcDXVy=gJH?_>x#8+q zNOlRV5Hu;4Afr-l73P5Svl$#TSoFAo`(j$~gm6*p__LmCr}m89`hYKp>dlT}e}2%P zh#>Y_^1f00=XW2RNa1hl)?3IoOi}$+68)DBBF}w(ODY}sJerEak;)OEZ7XxQQI+z5 zW4pw)t9PSq$33~Lt98l8=b~s9Uczxynhsi5G+vuWV^t}xHiz}-UOLXL^T)@X1?$*w z`JGZeuO?!Fb%x5NXIxrSCNY->a=EAz5&mfBP1VaGoRq++7M4g3HhH(iKpdkMagq`v z0{R{a6+POU+w$!u*V%1GmH!7}K%T#&zWP;c-dTbsZ4wqHq=F$!+J)2T61@wAKycniHr5rBYfEw1=6vU6shw5jmQPp}KbIVy^ z)*qsY{Vy*+O9UhW5&?<8&Q8^t&*<%;-#Toj!~bBv#$6qGV|8J z-1ANR^sPPUxOFDFGtkfW#|3YX6D^fJ@I(<82FKKe(AawHM2z8|DWNucm)ZKojiRNT z&Ol@B6y(#$D0gfIa&yNb(#jMjIr+$p{uGmSO3a#GfW!zp!vZ8i)suxuOf#)vyZHYx z6xvp4>0QUR=!Ahe@5iPevFO8-5s}(~g@Jppac3=TCJW+|Ek`}?h!>SVN(3YV5`j^M zfZT45vIlg$8sX`G{lTAUC_VzxB+gT4>@bHX;NmMg@!t;%v0+CohRNYO_%`wziGV~v zA|Me6A~0~)KO7WcC?Y(WYTLLcW)a4=DkDYwrryQj!0~=}2fce-Xlip)WuRg@3m!%Z zfF&X{m^k!GsNCR7BBBoq&EmZHW#vA|s3kp|v%c|j%pRYCEc;MHC=d*5 zpa@El4$wOVB}xR7F}W#O5~zw7f8+PTu|@K8$Q3TwsuTZ@LPHW5ioEleqUE8rs7Q}Q z^*I?x8KGI#iLa2nqC`L)OG(SoYdQnYouV6r8_7Rt!R z;h_Vsb;kYWhs)6o4{cMtv@=obr~=YavT!tys1u4qZ#*DpcMmiSKzPWdz3(P;k@wMc zz1sl~`H4nvBw0`g0~+=o!JKE^beG?=gA$cGv};r(4;J{jpr5)Th))N~_B6mBqe4PK z9Q3^TVA4h@QB)|xQ^U|!QHd^h4#^VR#1tVt%~fdgSm0LM5gTfN((h!O_A^}w4awtE z5JfBK)`mtfngEn$#&5FfIiNgjJ7Y%esYX=FScI5p+&zG;kyz3#a##z@ek~!V~qqtERSXdzvI6(!4x^qw~NT!1Emju}p;wKV3F^pUu+Gq`9n>FzI zpYJabFf$^3CJc?Q!y(3Xm!B%fzJdJtu6??k9bifw2SYVD=*g(jn_)IFbixRwa;Hlh z4zGtugX8IO!0BcOrqor8VI$KE4IU$hpUHGmZYR8q8RjG&;`!^DqDQOkuLc((HyB2P zYH4wK5o=6IdpSMlvXNYW@EzqhrxF42?7S}adEvRs*+fa9h1tmYZ3GW5n19m8c~BUR zius7?tO7o!R`TdzHPgnlH_pnbY|e4qD}XM>=WDDgLq+)>lVGOW?xgD*j+*^ufs&6_yN=n#bkebSf&va|o zivWoSF5mx6B$z!?;KW16_S(E0=~zGG3wd1~Xm4&q$+mLD&zX%V6XWyrJ{Dd|B(v>6 zXL~F5?k1^q0+yImgxKv!jb%(BHaOsKr3?Lbyn6o=i1_Zkn3)oRa0?|bA_DYK4G>Zi zapmAR8}fkQ@4d&c4g4V5aKt0UV0F}B<9-j+$yUtFr3C2URr-I>AvP}$f?VI4Ac@-{L%$QQ~l%i5H6&~B` zz2USdOp+aNM{!XTs=kv{L{eT$N*QtD6Mm11|`U6OyStp*2o7o);QBZh=OHZ}rQ1}zmN-{)c6v2OmpuLKR8Xle}18iva_!u5x{ z?@-^5eC`|S>|_6KWcM5Se0J~6-&KubR}SV*j6o!`6rA2gJU>55H(G6bZ;HB zHdyS@$eWOZs?>3qG+_c}XGWj?6BQ#s2TN2eRAa|cdce)xNG1t-e|1zASdFqycmA!lFZUW9>6P#K!U_ylh&6y9<|G1hVCGUUa2zw}eL>#E(2jgDwcvBhE{@f^A+5t2F$xuz&QSn_K;^xZ#TY=#C| zNj@xlp$F&PdIKg+%?YMkQMGlVa(_9>I6Ap~4p+We3-wMw=TO#JFyr^zy#g>vrT$eq}v;KT{I`wA< zXtC8(hR1Jv3chFtw@p*w`3D}rcb;5^S(%B*2^}VG)v2%PG2O9o`*LjFxDO9J-HC7i zd>&d~e*hH@{wVIz002M$NklKu5 ziPf<`edVE7Nu<6E<3%h$v}>I<3!pYdLGu!2<#q;7PDkX}h(R0S&;1|{T;M3gNgPFy zurQ9LI?B=3d)CI6mLs3irs>(yNEU>YX&-zvDt6TFW$KGtk&zOE2oAO*tf{>h`U3y; zQ#|RZDaB^KS4D)toDq)@j;~=mS--lrS8hP@#&_^cUBM+fI#MCM9n!D7iNbY{Q1xa2U_>A4r%q7tVG*siGRhWYqY8Sd&Jt+Gm0bjrID~PdDl1LS% z*W*Hus~vk@UjtQD71mdui?~z+C3r?k9WyXx$@lTw>4K~!A~Yf#2~2)#pLr>+O__%| z*D^(kG67=~VxXjoEW#3w2U8cY<3%GrJr&7OeUZ5jVSZviv4^YZ&zGu1k;Z}T3@8dD zpV(V`L09v+x={D&(|EngjCtcSvH0u+1UhZVjIzP@WemH(Im6$!1AlpX8H%et7=P(^ zF+Mv39_@Ts3isfRfBXh-WIuvMxiJXuAMcF#2Rxlj*1Q#W|NeO(<0eeVo`CULDM-F> zA*xptWBW6Y;I#=4Bdh!=tgr3B=9IH>%ltG1y6RBA^#c@bTZgwvIB#B*&Gksn`Ry1V zDmQ<^KDMT$5JhV?VAu8vG%may-=EKUmd+6;wa~o8-CcvHfAAZaFT9Z0~UH1|7U?IBepoFQ_o{5}rs(nf}qkQi~>}hl$Inl_Q)5fIBiP~+|$UirlZqB+R zijPNBTXr75--VXCmZ0a4uo)S)2=y1)vCe9z#Dx-uqcS$ynNU34RI&;CsbW)xhaj2R z-vz%u>Zv@&*;<3<>Rl)?T}f$EB2r>Z&;}f^&z=U=-G4z(VHqgPk_0~b?zdc>8*tO|XtlcmRf&6qBlEY{lbf67< zW}aB-ok zHE#xOS!na23D$#k(S>3Bf^$h;1g{sl-2zCPvJgqkH#eb&yG)XO1JyTb?nc#2+oJBP zf4^J%dz#SI+KG~?BrHCEF@s|oVNy^E#lh_8uEmP=tC?Q70Ua)(x)mofj#Ee?#?8M1 zndHf2D3nYwHytOSK;Aqgji=lzm_$xR^&UHi-wuCbIwiN_VBulMdQkOpa*KFQdf3w} zRP*{#Q`gSX+q+>n@B~lp?N8Fx1Dr2>ZjR}FTTrE62t`x|#-xvh@j@FSA}y2@9>A5y zx#=}ZH-ccRH6mpXKZ?!v!9sN^O%{V+D*eL#gU^xu<5b&8iE-g<*p5#&)u1sDjvt+0 zK*t9X{E*pfg93?VFXH2pCKQO|)Fe&=n&9a|XYF>p^GO44xpWMs%pQ-Ja6O`@FGR-r zGVCZ{iTCz2LdUpiJ(jTuUpOC^UzUqNM+J)P?XWq@@aFOjXzZjJ0u2d6MRLOt6rab* zR6rf*YHLGveJ$!LOR;Br5%%q@hGQx>RKfl~f(w1FLpUCN+%T5zq{Mdvvk5Q}btE^d z=05vVVbeutrn1dg``LQz>(--t4Cm0^K|F#x3p+(x6A2TK6IhNFyPn1(6cv@>lbsIy z`ZrUM7;k_{X@y;PHqw9mckJ9-$#Ia3IV4VlpPn1_h1*b5*$PkY`Ix(K3^fR1EC?@P zB|@13YLHj+fwl^1p4gasX+KI3pgEE{H;Ac-y(dgR#3U)qM>zkIPl!3Uce5%sqXK{a z%zU2OgXERZiKYyWwidKfc_Eg#|3f2Lu;)mfl%VSEn zT(u}?uou^GjRJ^xazR_pTEVr;zqoYd_Dd)FBJ*)L*W?vs-v|s+3K{*alKcE z=9R1AV+s-WoW7sgH#zY$QSP31K7&4gKB6fVi=}!{JnYa+ey;08V)ygdRnvlq3NH*k z6XwmDfaqugW}lOa&#E1GbZaf{DhL}S>Qq{j5SFgPJ-4jEJ->Sbm6x0k#SIrCpX5=+ zCD_$gf&IHT;%oo+7^d8GKjzJugh@xC{9=J{IqMOKod{KkJ{bA>P-BMp#6cp$3E1pf z5*A@cMYS2FMg0&U93(78LF)Sojl?O+GU~WQ2lrgBf6Xz*J0$`?p8Nivv4~*|LXjIS$SA03>SaJMG zD*`1w;wGoVx=suC&KfFo86ttN6Ftwu+C98{rM$Vz0t65ghoM1)1ep&-eDKX0qRwKI}2CW48V`=KHn zK57}bwab-{gs2!K3&JHP8Eb0LzA-1d3xB3vNUm-&CQO}(^QKRL-Awg?VGJfrSpbc% z2mXIQO;2eDZS}bQIGFdS-%Z3vv50cMA-J@)5spNqDBZOYg`3vliC5Ple#R2yWzWSq z7o}iaKAnb+ByAG&mLRR-6c3Dobbo z73bPim>I4_0cuCu%kb7i|A&{Ib79Sxga_uvLw9h&9_pfOq96;jQ*=|b@8K%05q7L% zUgyieV7*6~P6l7}b7EJ!=QA|d(oPZu$Ywk?1N(+rX@Vhi45l;r_EY<5FdbHpZ_kbo z&i#ifAf8t%*1xm{TlX@J)uL2vFAYIn4%Z@^iIOH^6h4GqDxZ(optzk*G&k3Qel=8$ z(JMJ30!EEL=t(c;VNGzY7UYU+ILDle9`{`VJ) zP~XULOI4}bgt++dp!1S=>T0bKi8%$Ziz**#K<_7#FR>1Yc~x*Stu+oY&thPh*|Ozsu$0~xk=^`oY{MGV;CbwCuIShFXFD76}Wh5J{HUgLGd4djkB)1 z3v{^vn;(bqVJ^IT&kcC2IunZcxp?H} zrI;9Hq1tJ1dwQj75uj!b4(^zV)Id}MF6LOP!L~vgl4j|s%HpJX;0Prba2+KrA^uKm z+ue>!Vv>R$Hf23rN0{8zYzZJbRDpshd(f6=;DyB;LC-;ZJmy?=Cw}aC3@bK&fFFKy zCmwnJUW|1W;;rYG;nn4=MypyC28QoJgb?TJg&79>TxYmC|FAJ6b`|Dc$Yy zDzW&+n{nAqHzRwX)_hP+PUsh0SlgTG;H81PJ~o@Sdj|-FSTGnD%oOTJTTwZ>yQY9N z9{sloVh7*e(g@_tVUSiUqD3AaQ7CEEnz+zgd}!HTjdAx~glsy5*k}YCJc1s38Ur^k z78?(qfGB=%J(9G^Pt$^$eb~QaE8e{SulUd%j>L(SGEbe4pa1q+B*Y~k+)h&lD`T)x z8!&7?;~W4FwHaGCQwrLG;(8bCjC4Pas-|!Tn&q-`425fj#)yRc^YNX#0@%7?8=m^{ zEl_faVbOaAlIScezekeT2|=yMmaqut3P@hi>qSbUAi8P z42;@a$pDOGAZXHch>VHB<*8z2vXNfqQ|#Qi3vVpRfIVyyMk+I)wUuM#;TDTi+W4^; z!slDN{4Ffa;>L&GA1$%cb02*J_l%A5+VEVI}dPf*Vn_-h{wd zcO--+poHnCoWyHgh;o)%g^pK+ZA&6F{6>xv!qIoQ2q z8NU0HN}u=j`1_61F(EMo9=&L^)-MTR=`uWd*KWMDU@^Yq`FCb+yon50F3YCDCK6RMb0EBR>UHH`=wJrBCZYHVM%0NYGyD98^$6LYTp zWUx=SmOB}D<2s*6Ot^{wXWy;ZxOo@;@ZjC>wHGnepGxJVTX5aA(~!u>y|ZHmY;>{I z5u}*oiZF9@DA{XkyeINdWoGF#(g-ldo6ljSp?GL{hSK&tg5Cn#Yal;$JltVty^V%Y(WXpdY zYB}`>6{ecvWBB~(*RW0#51qe1u1xj9(G}0*<&9UtFFFOkoj=rN747*r;}zXJ5R*Oy z9{v%uYB;d^l|NzkM>4v27yu(5j{EMs33G-;A&{2jGdLTQ9`5J$HbtOz8Nl3b4 z9@0{cShebHWR_cz=S-r7hR>oWjXN*06Z1J?9l2Sg-H2rTmH`67*K&E@H;oK#)HLLb zAV%Zqv#E=u*BFhr3%OPZp0VgZbVMbVOW}tc>d*|AjHry61AaV2Qqi= zq$M#AbN+lQ;^B_cJ^Qi$sU_T`+<@O*>4`A^wm=gFe8VFVRF)5O#da*KPsY@1ry!2W z&|}7xVe#uP5bKNTJ*`0y+H)P@3A?%k_oJ7x))AHM?2cGIX zuCOPx24XyY+2N{JI;m%~3Q3E}2bJ-gjW=ltEax(GowzH+v$~ zBzgzA5hkV~;yC@|$Btri#v$&6GD+^If;o9SExM=KKYm;zxdRaZ?y7q?Xh`b=02RV<4kaGcXI?XlXY8!WrJm26Gff-lN#KsTq#I`(=cTrhMzT-vQGb9N^ zB78Uy#8mSmORF~J@(FV^pGt^*Mp_8z4!WUa=vXIr_Ehp}imRYz zK!KXkhG)2}>r~PHi&Dt6Z3;4A%5{E7DlJE2D~FE3j2z|Yq2+W5R%8u#KiQW2qI>qNFNAe z)M(7RauzBJn&2N2=n5XWs5eIUS3`9%$0GH!tn8g19o;viA!r~`YgZjp z7_nXF5_jT?5N%htwK|vh)f3o%*n;8H)8R`lAE8vYFHYj88Y*(J`nx6ge8Db+4;h7# z)0o0&-dMzhc)RFWl$4=TtOY&jQ`XvIlxOe8xBuOU!r4iPjSE6ttQneWn#g>kHpd6{gIYh&6A|$I6NZH2TM5@Qr`O<-=nb@IlM#85$|b zovWzSZCbkmJ5MMuV{{D0&Y6r9zb0fEi3Q@?Q4!$hBF^n3rmh-9(Ej<7o#-27WDj5j zu3Kjz3zwac6~8Ch?rH6!H%Flh#L#K8i8o?DsV&6;Qn+L@m*(EX6NyBX%(^P!B;NNJHA47O#B*s1v=mOiG;d(v)Nkm4}Wa0gL@4?Et29%xUOjB4g#?JpM zp1PU~f9D;NIG60$Oi_=2J^U=z?Ds;k?sB~U#5~0K7^v)Z?s#Xun4_T-wYi6|=wHWh z*+Wd%QLziP`_|&6Rqx@EH$!mmwc~NmoMgHKx+%i#sB(iLI2JMCHtZ{}=R_puE;)v# zaYl`GAgAl5jd3gWz z6nN3<(79VU7*SfuB-yWg{5{GlQ!v7uiqRv7BPA{vI?@dYWvn-)B6}|~H!Q`*>Qwx0 z)_9DW5RX8;9fJm^L9yyMs&kAe;l29O6?V2c>9p%|{3=O;>Om6Q_=rY)$GO(Y_C>_S z5>U_nah3|3%XZ`N-VOM_k2Yc6pB7-!uxJblqz6V`jDmy2IR%@k5X3M~X3rM+^C>&= ze4X;nbD`K6xAu+BKeZPQv6yZQC~(ti>9#c@edewB6D^PHH*Uf2URr^JC+ZPPH?6T9 zBXCtg7Ai?HX{AL<$u&Zw4~CaH0Et6Lys2n*DOv3~=!6HzjZx5EbeF|X7=gH`U_>#A zx|&9oNPh)98hzn(=NcHuyq#>1+3bNJx}R+soW~_(z=qunA3X@5aKpGZCPiKq`ir@b!NU z&#ib1+XJn{Fh$~us5b4p?cBEaCPoV6;rr+A$0w%ikTBnXYlD?o`raR~Nc#w~(*}1# zRnT_+S>Cyb$kj#!aDu4ep&ew$@5F*Cbl?C+i3t{A0h;zE^?;3tS&>hzr@7A@<@>Pg zi!ZTk@jBf6<;dDoZP$4#(ySBj^{R4#7BpXp!(dk z_|3Dq@JSef-@Gsdi41z_%4#mt1;Hldid+e0~W? zjtPc8m9DdwYUFP@h>Xv7qh`vlkx1n$g_~I=gIko0u#(Yo<{ zv>np+&b2@!KG$&*kvMV`X;!QlivOV6a(V=$(Hudq4l#Gl8?kv;F(OCkVPmF{;w(AR z<})&r$;>-Id&Qc|m#|A{8K|S7+qOlqq9u!*i#4nGe+ok4M;dyJ7OhuLYOr!ZoTc$JfFA#&e8J^_QL zj6v83n@|!N0!vU7f@l^ydCWOCjyo5%2?>+9>+4Bft`0!qce?_xWen9!op}X{oXa8K zxC>u@_%5PN_aQFW8|EIH^ceD-oky1REQH*i&WIH=0t|kznSC+$n&VjZ^w2+p4c1VfDSu-$skT1pr&_c9hKlW~1j*7xumC=1??c>?G`6?Uh@C250&MR`{DS(VrYpiqd-(Kd&2o_Gd+BEju=PMO>bz5M?d7u( zXZ43^)lRJCMEJow-{7uWr*H?sC=HjT@(k^5{YhBI&ZKt>D~gf3BVR^wNaf5D&~c&? zmc{N$Q+*}P^tGI9)vkr})TG( zJ5J=pG4Z|(?sVgnoFLYbz+0}KEmNGJZJ?X7k@p%zpfs^ka%(l}OY`vcdz%_d_tBPkcycj;M|`wg2n<$&Shb zpRbx0Z)ZtSOWzOz7S>7jTf#=+^rTV1$Ji2e*1i$ld{&VVSj(3P3(#@LE9)e1LvRxO zgUgU;`x2{HE{4Ym4P{w|`lwl$Hzo@H9vo-g)ZMD7pZv8&VHeNnlu|ErJ@LILEx)vU z?&-g-pr5m9OuP!ydu4pK7?s8#AR-Y{lLeT)ccsg|%u&g_Mb)S-$)~oR2fukTR|*c1 z&!)xa$-e_45Rx(iX+*|uNu{<&o*=KwT+#+hwG9m=4*I!`E-hL?*MMB_iP%vSk)Zw?2`L$tTPqx8 zos00r=Hbu}E3tOjGHegHAOD`7MuI*@oG9(M;ei{G{iio@jQMt!aVH$+MRyQE zI@fyg?~}r3r&myM5?nppvDK47*UJ7PtUt|7{7hEsdO2CM84l{^Qt?mLaMllk;=h>- zZc)}&EcpC8xFt@);H$60q8HwiQm5QF~g5zke(ch7-636Gzh!8kidpD z^Cbq&$y;f6pilF14SR~su#L`x+wpMg}}|=2{kd4HkARz^$sphRCEN4ftG=?a?Zn}gSeY#`x*5m z(xy}qLhU7Z^k_wJ(|f?JjP8}{I+Qm!U?wI9q#3BMV{k|{T_xi~=&~fkc3BQ`_U**` zpXTGv_iiCkW&pgEB6nQ_vNLm_4fKb%SX580img^_A+wMe=8p_U%+RSAKeZSKwy(wV z^;@xOR}SQfQ^;>;LtJ&U#I~r@{op}XV~tCZVzvvXU{P0*lS{?m zfqFDC5=XeTwZxSwsBnpVcUF=SH|jizZDarGG-qpkBS?dhk0jCtY~1}FzB{TWN0J|W z=G=nIhXs<%_w(VOgws9)B)x`JWck#LH_twMC&zsl` zIZCnSr5A80Y&@K^jOS5ta+KrHhDBJr@JqbBFAHfOe}?Mm)1VxiPS;k8A|od@#v^zL zZog|Ve4@C(M}>81);&LWd%kKRmk;wWg%6tq9m6;;Bdx-RkA4i>&#y$_PbVV0NBy6P zX30xr46`+Kmk!XG<*ZpTNz zzltDiDqqyt=sbgW!espF_s!V3bq8K}{BA}Ge#X=-VFcxOuRMym%r&2h{wBtac;`1t zTI)vMa|7Obc{{4}s*!bL8sd3>`CFFY(3UJ5l;417BI#Q`H5-Z(&sv<8LKJ21z|0$d zgHg9Vh3R9{Flk5>46d+GBZ87A!QDR!Pg|eI|2^^t0;{jVjrUxO)EYd zNu8Xd+qFoz5H%X&3;2@CxklP-hD_T|EKOPAW&XD)KS$ zLI%Ek>3T{C*o&Cj1Ni%Ei!kez>!BuQ&5iD$V;dJ>k2Mt&8R#%`C@nM!!D_|P$iAlQ zsRi}|-H^c21rNUriTXbvzq%Uh4^|*K-3#)HEVBJ);ltx{+&dx)p$zw{Ej)nDpFWE} zI&Z>1ZXAQ5W*>wNpMgQn2XQz%mpS{$R!@$b=Hh+Wl2e3*MJoJuTntRjIavDXr}*^a zZ=t;DF$5c^I93%g?-`YsyzlV9=SEyLOO1OYL%Y071+gyTrJ<7MLCcW0e<+g2&&3^; z6(~G@6x+Ug1dFrkkZ%dZjZeIf`J)KBXS7sXX)HdDh>0Z1rN;-2RUHM*E#2eRS<4Y^WzmYy;_Vlnh&w(}I<|^%HDa@*4hIT8)M& z>F|mVM>z4IKc<|k>;luKBX;$Nh-lb|)qBd2Fx-a`?RBse?!iBgG-K+G!5Enm#EotZ zw!ZsIyx24i?u-h2^Xfs!T=5Y$lrxaRCm2`G83r$UCbHN52YdDv;J~EcBAuyPJWhpi zx^AzTfdi%0wOHde1CKxW0Fp>qo{PK(Z~IiSl0CZk$X2Y&tcRRQX4M9! z<`^~^qe;BBb;CB4RMeuH_<)1z15o7a}& z`)wXjtck#rGsAjtF%6<8Uk)YBpxfX71AhMKJPeBTMgl=?2fx^i^jm&U9;Z>565iSL zE2?G`+u*A(*EbqhCJn{VV2^g@YcZe=wBk*I-ZzrKJrl~=89QtJq86vXBa~-h$@0zE zx#oKuJbauxP&Gb$`R~|2WHe&JLNGo(0-;mx$Ip(xgwIzbZI5H#b<+`QHo>RGe;}I1eqf~H6oaWZGmoEYExZy!xa$-e zU3Y~8hHix*PC!k2NUD}pb&_|ayECNk&s_pCG>}!8d8{aRKlXu6o6B>*z(uXWM)&u2 z?58F7@%Im-qPz;LR%WBoZ7*g|y9N_zy`6RgQ|3^4_{T>t;5WA(L1L^L;lWK`nTp*Z{;G*6WFGj3}+CLrlKXMy( z(~ZC2;alLmc`gc9FGFpU4AXx1DsD~>V)g+!YD($yI=%`AoU>5J#L_ZGgt|wJ#gl)h zReRC9_#;=~kZK($A|LCV!wQL(!?=6AG_5vPW)nefmfe?;{ zBE;VLwkyi5jRvZF5pez@R?OgO=F0~`A$HC~5r_))#e|}ARMa$cUeLFYaJH+Yt6|9X_*v>ic!!1} zg^Iw*Iz&{N)`X~$bMe5>u!JIkNN!LWT!T#aRb``{~!}yd+0_eZkYooX(*0=|1E~!_bjes z&eQ}FV>+3Wt}Jgg4mTvgTNO^r4tM%*b6W80eD_)*v!$V!HaZ#U zaV;4=evDMRJcoJ)?>jRr#NSBA5?aPyWsl$OXH+T?iW$G$rwexzLTWZxJa?CWid3nJQ=yPfyx4VLj36nhn zqA+@f8hJJkT5`G=l>(2U(sGCA%`_g9xtpwp-(Uq|X%hE0k(NOa&9Nh^Jj0m3Z9IH} z3sAq&3ccQmNQMp@yn--uY8Z^dY~JqLJ^3h8GPQ|!I4+;d=s8Bfxd{T3PDPl54gLw3 zGLz<3gEx;klSDa*(XHS`oS9-bA&vyWO69^!fPvbKx*`CYkwwC=a;7JA;ahXAR}er` z9X!k-NSk^SQkq5XLQ)d=F^d72szsoLe_Sd7um;>%TZ^3~+##D~@bpz6B|QzZW{^OT zpY>c|Oabw@?3UZmKybB&ld8ACZS*qg_FV7g)cJfWD$Y}*CP3>Gh=M97*}V;DibzHP z-6;vPr!%i30o;se(l9hUX7u&A6R`*;NvoVnms0DEq0{Fen=qx4>ITX}2VZi?B_s_; zBw+=C%)M9r8v=+WblGHA_)_&y$fTw+Qo;M*+#A( z@WGJFZbm@88=7?fjDq8L3Lk{0j>A|6nMLy0aPs3BG#%3jwYB5i-ubi$Q;8i%H=THL zTql1_k@3dQ(UnMla_h9)Hu>6$R%0{s*4_K26^q}z5y^P(q2Z==M6Cutd5An?p%j z|CYKt+#Y`yKK%LyMhcOKqnSGho1Gn%E-XPMpyC9m;ch^P)81HzMn)8sSJrc4WLt@S z636)v-}IwA5w2@HTv^lwK8m;9ZLu>A25*+HGlzv*Ym0E`<6AKEy~()s)=BvN10xC8 z?Y3I!hjW&I1N+{)4XO6 z48$3B;6l65x6`S9R}QWw3z@*niAzzyM(zj|sTNG!fawMMJ7-{#4y2KQ{~AJjJ&AE@ z;ZWn;Y;S5gkNLr@#I%TW^-OMUFdCqzm8Fph!!1?@rnGrcI$hgHqFy)7RV_InJN?+h zKV6ZI0#8O&=Ttf>E;~*O-DyMc;ju{kpqYa&p1vFbboq-dxSjK-rw6G?m?}yrG@_1X zOC<>ycc7TowcMHpR8@MAJ8A-ggM4X8>C_k=FXmc>h|=Za*xhs@@_q{Fjh%AoD&>kG z5^c0thzVoFrJEiqOBSQZHe>XxC-MB6?HHdNjwElP*frzW58q%K%%hM}N zYVU>U(;C;Qt!MbNYuTMT!G$?x->)n!MicMB!L_KFiibCYmGr!Kmomups}rWVQ3&NodTpLmF;AMBYwa>)LVZD*QyOTE_c7MP^|&HUvC~pN;h9 z8YS}85iHLr#bYa8!hbclP*EC;SFVi}C%AA_A}?eOgA+v25GN;;HX^Kuvuj`g0G}(@ z2AzR&mDz}?W1dsG^TgI!OR`}R@$DwYuIudn_0Q?%f?l_e){jo-)RE)EM$lyd-A2CD zf{kjr{QQb>t#KEQ6k8EZP2P_AD52FIBe;7-+_pFaif3nL;T`JPu@&z%gD z=CWpio;m9R;)+^hgqL>!3__6*a{ynbt`^I0=b1x*`vR#j5Rq-oCr8O{`IOZEIJb;L+(xkuztQXHXL4g@;gA z77K2I7>U=DGo@pCF9CrdYeWtiddr<7Atwex;DFBB=X-yli+Bd@XUtip6)!>px-8r^ zC^$)b_%elvHzSca0>rDMm4T5;p1v-5bXi9qeJRGenv0#U*60eJ5Y~M`DRRm{!q0>~ z=m?$Y2oMl1Am$P?2XgFFxgtPUY-C(a-mMdW#@+0i^DgAA39?)Yx}$}ii@5;l9$ZC` zGA)CVqf@A45I5_Z^w@6RT>Cl7LFM4+l4r5hK8zH3gaO z*@^(si>a);=}cf^RfHcHOk#qUqipADlLR2r8x`?EYLzm$GYDp~#J?q_XK76yBOZoIkRi9W00JFB*4(#M_;xBCy;{uZ!px zyt9^dq22EtK5~tNEf##-g+)sdcw%ly z_$T3SoeGsSedl$HV^??nbINtP@Ok_5JSa}5w?(DZ!(La7V@nR9=2vOdVEG{J4390Q zS&r<`I)O$d=+3BPh^pB2U39HUv{?)U8F?p2ZdYCgM|L(!h$i(FYke>Jy6D(_()`oK z-u*YONw&MGq5IP=)-S>WX9|vi-2NZ(?a-}Dqe0}^=eywk4Znk=}(chVgpvWa(T zTs-Zp{_=&GCK<)Fp%z}zYK)Ha?{?AXFD*Xb?GR*{y%^%>`|>}sKDLl&zp zh;#c@N9AH{uSQ;tgE&YNk_U%!qe!K$E7u9B39Qve@Xr@481YAcghkS=xc@LhuDq7+ zS^e3Qg7;cpolYRvS+lhqKYY6gE52ib_U|_HfMjgR$Yub641>c6*k_L_J-8S}azE4$ zzX#V`b{TwpJ!llTNLv!lLlj@{MSW#hT*0z!0s{>0?oMzC?(XjH65QS0-66OHhv4o` zaCZg`?ki(u>70gTU5vDmlEDvN+b40X>Z@=!#)iHx@pP%zi zxEzW$J*;E>HKXTqN;-=pQXqKSLClG6|MSNTrig=*mv{mk3Rd}6$Q?HVaj!QN7 z!0h_EYv4VNG1Jrm+VaKw^vXa5!$`fyOub)>LF1KyIXUL2t-%S=&M`cCIwREs4+-}-U9_=hES zf5=H>l!ZG96dJeblJEh^9r{jxLE+j$sG9CEiLPcF961pfVltp|*n(Ooa&87Cv^ChZ z#OX*_5!#8Z)k*4x*}<8=P?66All96ekLRA3IufStn|cVh9+qex)lr{#?VV;rta+WFX!4NT?-e;4%2R@Yfi<9pYE(*fTO&;lr9lI9-W$RI;Dy72ctIHpQ z23J8gzGr$=c0I9E9y&fDo4*J1H*=O>|0qNR-zXy`@_emt>BqpJsOtTRCt>?Kfx%d7 z@Imhf(7}lPX58=2fY~5=c-ZBs6UE4Efy}+*3MgG5u4@59Z*(;yAS#CH6r+HoO<#{_ zCS@xRimDyH)AxkZLmHGUv8QCxLNVKT0nXCFl@&|N__Lw|v^=p)u>96wv201bs)ph+ znz2sd+V9Or41gr0xbGX?MlB_s~3`G%9{??&8}4}=rJ!ldJE%u1wvUiO65KAJRwVJs|V zkJhC_K``POLohO*Hj#mo70a~y$c6G`VCd6=i*A~GL0ZH0MzNyQsgQz1bS6*T)Zd-u z+zq6X>#HpzqMkUCrUt9)FSaD(DYHq{KRXr6?=LR0GS#GS$Q4bc115t4O%I za!uakTuvctm8VOn&T3+66#d%O@d0h^02k_DL4Drh4Q7-M@p`#P;pv(Yq3sKyB!mSJ zq}BhRCs`0$cOh+#qN8%2`G%b5(!!UU3BkA`%%^fICq{ zhb_q9K$lpw3Pfp8wnFch&8bs<6cy|x1d8WGhcKWnv^`)-_l(~EtU*lvdL>7qbq5-G z^=^E5U2^KZ(7%juUfY`dc#~k&`;DSNY%(GNuwDTdzW2ndYQsO5A)ZG6dNkM}Dy~dd z?$~6E?1U?}?n8qz93%Xlv>xpma_{_`fNc}Rb#LLe{Jnd^Y>7T*7{uZ;%&C?a+*P45 z^gY?mhQJ#2{RtEqYqd0V_%9)4MhaP`W(A3GzLRjWVt{hUG-&2fSL3qdmk-nT5Qj|b zsgKId`Tc(Ebp88>viCkdbTCtS3S1K-N%g>9KEe>p`_vbwvy#hRAR9ZWKph144V}er z*dEO-3~gQXF=lpSpF*%7qlW3JC?J^r#s%};Z8i!gzD3|e#MNb9>vQ0R(4-=ooEJQ5 za!yZ^4NkOVtcVT}bs)$1=j`7^0DT7_xHyRTj?7affm@C^oC|_Jk{%BEa)BW-ym}vR zI$^Uwzd^=w03yDpM>Si-85z1m>S^+nZz5PP#?ex4!k9LNFYz-;FH&f+r}5&EB~N3d z3IO;_JBx0c!80*>8}+K-NZjP{Y@Z+^J!9&KGYB9nJC`*FKLej^53XE}axj1<{(a^Q z-P6xZF|HSW6kVgc zj^U;8_XcT)g0-dIb#+WCejA z*3{Mu9^0CosLozcI@&C|42Zgruy6R!uwPfU*l#thAL*E5zv_*8Va1WSPQ=Xc;{wFB zyB+2Wn<{}`zRR&v#vEvalzC2W;zxUBKyuQzIH_{)>Z!C*8$;eex12{{qeH#@;O-J> zq~p3DD}@0TBb@Pk`aN%=-6l>y4W6Y(N`C zSBLles%S-@84yBMt4Z z=7*oMwM}GDtuL;|fBNVcJ)RhsjF_Yxoig^)T2F(QkIE}5eiJ!0bBpQvL5Ru9h&y_V zNKf~Qo@>aJ1W<7{p?a~?54ZJYw3zBJ4-GvYxMOX7`9j+#DI%!iU)EVf@@Xsoe=&DR z6c7OGg4Bf?g7NPCV34^3yQ1>?2!F9j_YY5=evK}&SYg1V`I zu$Fr*@($hj@<6?rh<8>REI9Xro_c}m6G+dOCi9{mul!TK)<9q0gUjua#sTLUr%iNNr8cDJAewUx5uf8c9^wc8FiF$ zo^_$plH6xmXai=fR2*L7c{QpzputO{4>o4E*$DdRd^^`!2USD6Q z)p)~jpmX1pq?9VPoR5};EP5#80bWYve@8$v=xlLlIGw==Db#siEWZt&M>I}F@lAYu z%nY@faSyaQl?8zWf1N6~R^OLU2g^JO%{KXeqZb+UZPn-a1tN3L&XlV2Ix{ob`(|)e zZ^&mzgYZ@Nb1!eMSzfZO?SGU=d(z zTqX0s|H}PORYG#cT4W@E|50XEz9mIhndSo6fej|@0wH1gJjMUj`*iaQGR9hT%ICe{ zFF;BE56BrfvY>9h*6luVzwSz zSG69WI?qYwwD~TH7eh+^|Ihu&0(?mW0xCG5;UkEhNz{MlQKPjU1C;doLLaiazOjn@ z*RB6!5bl45EK{!LYE7=F-g1#E6Z}6QdEJu#!Vx4X(R%!>?U%et`acno2zYJ;K-PlD zyj@&XP!~)bOe-pc!9B7cKl~XGP_$O6TuX8jko3X3SR}yy+oVrSpR?vNAU!xFP1&Jb zob;ng5Wle`pqv^=KKjE>NVpLH-fS#?1sai|F!<@1QKyLizxJ^ICe;J2EsSr?MpKS! zt#BM|zw{#?Wpsqxz^;by=!;r56-_>I14i#Y*@PWc_Vh_ELT zb%87d@?9luJzuWg_NSAF6{=Y# z{?~atslJM{5Pu6(E1Ymb>KLK~G4#tB?C-)VvN55DysKn8^Hxf5ofiEwp$PU!^7OSV zgr$retBQ~`(wGNB14LNkR~HwTUlq+gpTz3hf5AJ&AYz_Dy~B8FZOhcsiZ!hL$~D26 zY6bVA8cEr*cT}|1{<0;Zv$EiJ`gRr`Ys@4amQjv%Z}m0thprIWQez?&foi4L@lqyU zt&+J6y3pSj)bgs^PzLXq-80{Is?~*S2$ttIieJ7@RqdPSd`v1e_rtVr#I`}wAQs)} znu)V~(9<;$k#PZSPnF*`3`ln&Kba1QiI~v@Z7l)guyspL_;A+kCA&%v7={x3&5{QG zQ)CF3SnJ>3Q#d7pMrW0aBPMncvLMKxo~UXng-l)OaL%NTym7ZL4&nI;5#{Df5x<#R zQ5aHk-(aS%HR5dsnU}y77)Z<*y zgrLTMp)7E98^NyvW~Nu{7j#?=)x_XKuC>tiMYV{jB0?;yTH)exz#fp-gnqxgitVp% zqQFO*f4^3o(*57{!Z3%T0_ZMeQe;$HF_ZXV%^{tS?&g~nAtp@Dj2h($dfh2TkmUeh zTWzk~h{tKM+9cP<%;5A}=UlI<7Z~fp0*B6YkG8r%K2oF#DuOAez2+~%WS>e7&P9L@&sG=f*QY0VbHUw*)3MPc+P$%rPO2JEwCL$TT&&L(ij-AIn5s$&-M8k zdkxuoH!#CCcQ?ZA_N6R>=r!_)#ABchW4(%rhdfMy>D@4l_DgEzO{p%$I}RxS5MoysVZ*y z^8wy*`|8tjb^fE}qt_Yh*=>$N>m+z~&!RF&)!07~CZT+dhTFjAcfXlS-}cN~^upO+ zpV$7CgKmx_+y?V$sJO~U@P90lr5FyK_GKD!R53Z1-B%D3&cM~ZF1l0@Uh=+~QU46& zwC1#+$M3bq%S$HXVf?__d9GQS8|l!`xeH8 zHV0;(&$_S9`TO2iT85~huV-i-SM^M#Z}jwA8Yywc+I;2V;(e^RVmv4^WFKf-c^ARYQA|MXt){tR@c~&S%%Z zIQ0<{Sn@qx$=vAt)cqGoI3f91{-j)GmCT@uW-!*xZgAY?!RYx>Wu1|4mKC${ZSy|o zqo4cHQWW2p!@3Waa3YN14@)FVhQ+Gf>&!*;Ggm?!{&<(5`t5K?#QLeU)g^WKw7$iC`*SB`H+q6S8S$w)(-KlsVl`?hM=Q! zP&cnc{?^n>8GNCU!+RUxXsti7+7^=n<8?mO<;_IRmaS!1C3fQJE%DMC$1<+E+i`T$$W@N4F65lBUB*-o^a^wrB zWAG|DZ_PEgR2R>cwg)rOVvm=#WuwSS`&z(q_jb2_=i=Rz|}DGBx_1x8O3 z*@&j8U9X6X1yv)$@F+@Y1XEQ)aNd>_Wo#@AU&-c}!aAOBDA5#pj^R=I3km9T+trL- zY#>+zd&uTchqy3B!)w*xRGs9=!Pvxk2kTYHaP2o>4ULtE@v|=@I7Q$*!m5x{hMPe* z49!Fp)W9}>s4X2 zb8pPlRt&+H#{7LJb#~(C{E9f_wtS-x#hV4qvLAjq9Gi<4AxecMMnivizJcRp;!U?U zYk-?}V0tNocasvR&kygeV%Qch0y~vr?3IV%J+JdTgN{UpG2q=pvq%$C*`3>k9B* zv$g<9Z>wjo3w&F!tc_Qklq%n#w1Pud zJHM3ws|XN-vB~|E*lx*gQ`kt3(J^u^Qvhax~26G=@vPxi#4er6D4N7FO!o=~oqOBsz zTuGoJ9UEX1xZ5)QEJ5t@Q*<$@`*XS=8|b$He_sQOLo4(3(lCK+!3JjnJp;X;?&>)l zydj&+Cwpqd*tQ=&7D-%%NPOMKCCZIUajn;*6C|>{paM~pXI_t{u5Q#*T7E1_tg{jW zOiwm@^!3IB8vCNd^xsfRW;(a!LdxgN!c%@%Nx{od#ENBMaWLDn%+@J5{7%Izh&|Y+ z*i2uP6$uWXArI0r7ZCVNgtd5KkN`nKKMRid8rgLrdcvgP7L1yMQb_PK=nEYwJoh5? z8@XhjpHz=x*wC>Kt;d5fZ8;got2@T+3C3D(;C0-ujj zE48lFCwxAsJP2~&g#W6UeAI%uy*u#xzQ<8ASxS6I3F4K@4O`vFs?QLlB7eC&C-e>4 zWo9W~@6Vso3ng^)Umj&QdPQ&E>2e4-n>;!vrQ`BM6@rWzG(|2;XWW6I#*BV#WDGAZ zk5v0*jb>&&d>w~iu=c(ij?aXP%p{r4Vf($LC@jfMZl+-R*7@By6d-M02wPY4N4EIU zP?mU1x;|e0ld^|U7Y@HF=?6=7f3OETs7rFDbjv@8==u(}&Sl^2v78HehZ2LNbOQD% zhB(;qi(%Ra-Y#T_p-6J+$@(>~^yS9!MXmD&#py&rdBzae$_1VWIelbr`iXC>iZOZM zF#@QOfmvs3w4jv4;&K1+AmT6G+jKD%^Yqbox^tBqJU~6Bqm9QN9V8PcT+90+*}VFo zF=$T$0P&p7rSLp&41H_caM!Z>aR=T??{(hOwgG!}_b$uv`h!J=g` z$KQ0$k(XQi2x(dv3t3{ImzQ#P}0dH zRO?!Ep$p@?*_(Iz9!5#|NuwOWLXZ4)WPvm|l|L{z;@0045g_9Ul^;Z}Ck_8PQ{a7a zxZHK#?LNwd8MncM3;m8$a#tNXqZUoc_rh&CUL){hPM(pU4`2B(e#`6%vT`dW3h6AU z#m5&fbAu%BvM40&!SyPI0^|#GZ?qQ3zcUy@obIp&7c4f{mROGy_kNq(@={mI^xcIK zg~xM^nVd&hiRqb|RS1-{{dkH03QA=+D9c9|KM(WDDHP&lg6R6520TtYk1V9e3>kLa zJ=aIM;XJ^B!%y}P7QmNEvl|Xv$U+iW`qf_JB4%La5kcM*Kfvd{EJ3-Fbkvx9hzR3|aQfrvDlSy%9FU_z*dP2(Bv%x^S#ePd)xO^suaKxP! zHGH9kCb#$`br`4Ml*qZb2v5>?8phOWTsn#>?eM8I8-X%QDlnALoeb$}zXW0ddK_XjTud;L`NyRCv36e&;W_J^8fND}Lv{d;}8P?>zr zAY#K&#Vrt*8IRbRpN(~~fQ%k4G|;GWqYbnD!OUQzmpK}K#zi5!-07Z(p&6}Jl|TXy zEeufnwGsQ(c228O^_gU37>N2buo{_V4g>=aL_#GisOe|4Jfe!0h89n5BM301xjZ=D zuy?u-{8!- zvVfmHW}uWn%O-TuK5KB5YDcn4LH3>K2u)?*xiwVi zaOiB6DCT!egapnW7Ei39r_s8~CKRvxp8})-O%w+f^Ru8l@=ymMEi$2KBXjvz}8v^u1orXuUJo&qemKK7oWHlRYgjEoApMIl%MGj|5`lzZVxI-VjeU1wb zBL)jNH=plX-Dt9xTs5q!5RlX(zOsZ;jCVuQ{v^&#@!G3}DC*?NH1`pSh42Z08YX5S5)Wo91it-n%TQ}G z%;lX?I^3xI5e%F(r5C%F!>napB(m#YbH7c|31+r_E@tFLRg^Zj?XUV$d zg#6vGE)`E)(3BiO+Z2n!b=9UF<=(AzbwIZpuT6-WD26Q-CHBkCA_lUd^F$++CSHGa zjF_|!=F8S^Qf>w3M~>slIVR6vz^NsHKfmfB#a_-1-ozpnTHYep$05}Ytp|5(Dz4_b zRkwR7-$M^N{!sDV;`m+%vh%$@i3GccUuINGYYr(@{+Z}$j*)eLP5lPEn`ODKMP6`; zKJvL>%%s>vBz53@=UvD$5cRl6sPw*Sc4sApC@dW&CF6lawe^KeJ9#^bCC|&yAZ20C zqCgCs+`!Tl->;UA4Bnjd)7>OViB?<6hl)@MlU*GYX%)XLSDh?t+_nAzBS!*P=pO*p zAaO=3s>8(z7G+H}s$@7H^zCw+qH#BHt)QpjR@}^T`#_cAnQS8ll90d4X%S;1VJoU& z@i^ZAzrf9{D$zVBm#xS?9$EZ~#qx4Z&!27#9WL7JQi zxmCkSBw!qJrU3^VFo}7I$BxQ=Fd=m3CtY{jqo{)FKG2gm*N}@ttvmc+)0>;S79r^5 z8(3Gk%g8f`$!Zn~;a3OKYUK(dzQ6ovx5escnd7+0rt_t=EmyuV?ci@LC48N?#Ps<2 z^C>cTT<-hO;{CxUrE+WNeQ^+2?-Y9yw84^D@)?WgE10fyv*?;ZZw=Stthw-0S-@0fKKbXiVzF^UAV=A_!KZ zta6Mh-H8~K@D9{Ngb}LWDEMx&$hqqrZ=hwmKjbEUvI36F6_W9QVk=NnyB~bcM)yZ( z6Zklet9Ycr3P1gTjw%H27#X;HJ(wQwSRWM@MItjsv&Ioj`$^_V zppvb?wK*Z=BrK6hVsM!~2S;;-sB9$gy2oY{mF-=Mdr1>Ri;@BwS}q$+jLDDJ;fmS2 z5+}Ew@zO~7eP{Fm76%fgR|JwyUm8B&4~Y3H`#!OCs*=qp{iz6Env10L9NmqW2U3!K z5jNPX7^_u`T%EV4+mm~ZhS`8a+5hY~;O8FvASA>VPFT@hk!)9TY)foN+G!$jFbWBR z+kTZlg&C+88QQP{1T1cD@1&&L2DX1>Pw2>)D9=O0r%| z1&Om3mQ`a=-kbLSVTj!pV3+VzR+ra&KA%nU*Ki%^n`K5>Z32fW#D3ot6Tzw+8DH;L zxS&ca$XAU29YnPIiqp24QA*VlSM9R20-9_kO4^8VmiNBs2U!a^$RS6{tAKS;INk%@ ziqIQbQ#exV2>-MRxZ^lq@}PRQM;*YrrKd+Rv)T6M^utr7gn-P| zqc1RbQa;)JD^!&X=ZrOi)2s+AyPcz)5_ z=;iFh7ajaD2qn|@j;J#>Bb5k^(TSC1RG^^vRw5`m+#c6Y)(RRnU9B=Ez5(M#O;u06 zk1}l0B@NvG;i5WV#C_>W-1cn=*JQ>WqvuP@F9hd?_hsA)1trC}-D0_5(IYu0<8nAX zM&^mFenSyMAL8q{@ooIf$oPQ-EL6$!qUw?Cfz=smg}O91pOTWj2DWQoQ9CsKrcD}j zKf(HKYMZUbcd|}h9cZ}ErDf`FGsfgVrHPtFvF5A z5vabuW4Wve1J~Qp;r;vw;<}DLPdw(tIA2#Fnaz~h6D36rsp$s(&SXB_Gsv1Z30fGd zHR!`n4x9_ln}F_@oOdmP(f7#>fD(HaDk-B7^+Ra#O^67$@|Ei58s&zvXE-8L`8y@8 z24-X~=Z(sa+$TIY5F_iOOiEf;Ip7K)rryNd4b{H74Wz7fI9FIk?L*q{RUz>p^WgdA ze{l)a;bup-g-iWq1@fNu4s_}@L{m?il9a9{tG4(#d>w*`uKJnxI{_S{%YsR+k?{>$ z*ZGeq)x>Jte(rgo=ki+-DztdC`UPa&PyfU0JGg|8jW$*DGj zz=4p*zNvclWty>WGE{9$p1?G` zr7?M$#>$lr1!@U-jAvrXjW^3uVkizub7H2TiK@*unO$j$qJ5g1meDG^Q)X>g_NyQ;xW0r_&nJ_1r(mk4Ckk=e^K6ftG zzYLX5Y_jqhEcj6v1K}Hz8RA-g6J%)kZ^6D6MbwGjBt$Bp_x@!X~9_0+Syz&*2hD{Wfg3yFZl^+h$+-}(#7SL^HP%9jf5aX z)di_Cv~T6bMRFTdEz+R2fvOYW(qJs?R~beuMyz@S@czXQA1o{X00VA2n0^oBuTvB4 z7n@sN4->72Iij&hsNs1OAAXG@VeTC?^z8QU0KMmhZym2M6;vGFV3dAJQQ0Qr<&*JI z@V|zd+?Q>Mk(4Yc4K>0J$CU&x<`JiQ!!P$HGJrv zPmB7|6vt+FQ5q5^s=2-rxvF+El3_p`J&|~diNbHyNm;-!fP(NTfD2_W$9?sCi!e=X!_1rY6_nwu(K<@ zq3^cV#+AtH7#S;?sK4G_JaB8U#Kb;KWPP88=V>baq9&F?mtxmIQ2r(L<;kodN5YrM_iKMO+!~q!djMj=dx(X)IMV!kuByXhfl1jTuEbxt819FwCAbWo;H`0BzcDV z*!|*C+_tP1!_{)V4X4||AVNnFGPRd0aQ;<#~Z_1&H$ zj0uS!KTiOiwS$(wxiOiDnJcQJ4!*_vl1Ib6TJKO86ED%07~@0&oOV;mUg3cOSIH0g zp9dnP7Gg}&L<5XfT`+D46yX#1^AM$~rcwxtwVpAtv5*HvlG5gAAzD?Hk9Z+~6bANs zzfzOKne}l%y41+@)R=%_*|pQJGv_lN-$|n>p;0}k^<7_)KWW!2+16@{9EpH5nvpTs ztduXLsnHQ5UJZ~rKi9Wra(r#0exYE(JuNn^Xk?PQ9TJ45I=#sL!KTNCYd^A<<>#kE zhdPw8cBH4anr);*v5_2YwE(?5kX#9ci+^7FZ1@iU@&nz~WILktSfRJTvVQ$skuQaU zrNX*A1d+0BjQX6gJ4Tw&H9wc!R4jC8W{WfU*k)oBt(%!bPSif5btKZ1TdJ=znF$s= zChs-86oi^qi_#PD7`CFf1Vw8 zj&^nv^LV!h*Br1=-)cWVG55qvjIKG@0ol!0@aSD`#c~CqbI!w;>mBLgr=p_!opm>u zq1a-q=wKhMIA<+H%RlOD^kN!$`8qOb=8X!$+whBPKUL1hie!h{hsUFp>vojsUoF}E z&%DQ%L-vk}Un3d^dIvlT&w8D>AhhpjIjshZV7=M5?Womch<^|Dj!s0B_%8BcJY%Dd zH-Ix)j$Lhy=?lM5XuimJr~|DDz>ZthuuK0^by${W=*P^s%vAodP(x^W&5rDX$=c|g`&r?XCg5A zUGL=wczGPYwrRC8ByA{4HRp2sZzJ^j1`6;$D)h!>;j=Z?zw05ELOmT~?Yotet5XCr zNUa*vqfBrDCfVgcyv7usQkIuzl+@ot?lu`0PltoLB$X`lTT)*OD;F^O7X7X4Y39Z( zWX3lRMMR$~>6yzw6V8S2XD5uRX9M@0&Q#_A16urrl)+K+bWy~QNvE}K14GcD@cv|! z8h;c6;1z*lsqmNmSRE6v@{?_isqL2?1Bu1TD6OdvMaligRg7BpgjoN!iK8~+GLLg8s|d5OWC`-&HfU(uhG1HkBpzm=Z7@#XP<)qZg5~6;M$CDk;w_|v|M9W|wDuU3++j&S zlQ3Gg*q9+Snsk66Y(Oa7VZSK2zXEe_!2@E5KHD$vTN4ujf_t<8kD~HhqqF_|eXt4S zjO1+wYOoCkrH@dI6P{KdEee68-QoQy`Z;2Acf@3>KC)}a(4KO&t^^=fQ(h)YbHgR4 z;RJ4`2nVgcji*-o!C?!-$1zIhhC7naQ_QF-s;tZU$&gSi;C8PNhn{)Uc;e!>KH~Z! zTEj%to~1{qW@46dfvb_*58~e=Y05P%GTTuF>yv8^ajr9BL&5<5Az z?;NK(5!JJ>7bkwwwV{p>1A_gLfJ|St(y&%iRW-v@Ry$es(-u5?lE2I;vtYHLLVa8k zt!D9wm~R1$q~LD%+i){V>hYA>9`paU9}R@k%c2FJp40J zqj_$Qw?oHer$hq>3Imh8xF~+xCkW2{BwxumXm*$s3QyHVf?C?O@Q??o9ds%mx%xtno5f9H_=2<3Uy~Z2Nn>sLMQAJn5v!- z`xyB$3WoL4&4SBP>_XB4Xr6Cr_5oBX$YI>Mhy zjw>L=EaYFEe=hU>PZZ8zG=E_JSKN;Hr-sY+Qf89>Q6MBh z30A=I7oe7j{vSdAs`kZwir;aQHx>CmopJyXhgs;#?=*n_;QD+KO!z6j?;>X`{C`S- zUw;BW??a(#{80N}s6hTt@gZBhDailVC@$pBD?pUBvz7k~70LHgJWRJ2H7UyfqHrd; Z2.0.CO;2}, Author = {Zhang, Guang J. and Wu, Xiaoqing}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {2003/05/01}, Date-Added = {2016-06-14 23:39:50 +0000}, @@ -2142,13 +2161,13 @@ @article{zhang_and_wu_2003 Url = {http://dx.doi.org/10.1175/1520-0469(2003)060<1120:CMTAPP>2.0.CO;2}, Volume = {60}, Year = {2003}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(2003)060%3C1120:CMTAPP%3E2.0.CO;2}} @article{fritsch_and_chappell_1980, Abstract = {Abstract A parameterization formulation for incorporating the effects of midlatitude deep convection into mesoscale-numerical models is presented. The formulation is based on the hypothesis that the buoyant energy available to a parcel, in combination with a prescribed period of time for the convection to remove that energy, can be used to regulate the amount of convection in a mesoscale numerical model grid element. Individual clouds are represented as entraining moist updraft and downdraft plumes. The fraction of updraft condensate evaporated in moist downdrafts is determined from an empirical relationship between the vertical shear of the horizontal wind and precipitation efficiency. Vertical transports of horizontal momentum and warming by compensating subsidence are included in the parameterization. Since updraft and downdraft areas are sometimes a substantial fraction of mesoscale model grid-element areas, grid-point temperatures (adjusted for convection) are an area-weighted mean of updraft, downdraft and environmental temperatures.}, Annote = {doi: 10.1175/1520-0469(1980)037<1722:NPOCDM>2.0.CO;2}, Author = {Fritsch, J. M. and Chappell, C. F.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1980/08/01}, Date = {1980/08/01}, @@ -2169,12 +2188,12 @@ @article{fritsch_and_chappell_1980 Volume = {37}, Year = {1980}, Year1 = {1980}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1980)037%3C1722:NPOCDM%3E2.0.CO;2}} @article{bechtold_et_al_2008, Abstract = {Advances in simulating atmospheric variability with the ECMWF model are presented that stem from revisions of the convection and diffusion parametrizations. The revisions concern in particular the introduction of a variable convective adjustment time-scale, a convective entrainment rate proportional to the environmental relative humidity, as well as free tropospheric diffusion coefficients for heat and momentum based on Monin--Obukhov functional dependencies.The forecasting system is evaluated against analyses and observations using high-resolution medium-range deterministic and ensemble forecasts, monthly and seasonal integrations, and decadal integrations with coupled atmosphere-ocean models. The results show a significantly higher and more realistic level of model activity in terms of the amplitude of tropical and extratropical mesoscale, synoptic and planetary perturbations. Importantly, with the higher variability and reduced bias not only the probabilistic scores are improved, but also the midlatitude deterministic scores in the short and medium ranges. Furthermore, for the first time the model is able to represent a realistic spectrum of convectively coupled equatorial Kelvin and Rossby waves, and maintains a realistic amplitude of the Madden--Julian oscillation (MJO) during monthly forecasts. However, the propagation speed of the MJO is slower than observed. The higher tropical tropospheric wave activity also results in better stratospheric temperatures and winds through the deposition of momentum.The partitioning between convective and resolved precipitation is unaffected by the model changes with roughly 62% of the total global precipitation being of the convective type. Finally, the changes in convection and diffusion parametrizations resulted in a larger spread of the ensemble forecasts, which allowed the amplitude of the initial perturbations in the ensemble prediction system to decrease by 30%. Copyright {\copyright} 2008 Royal Meteorological Society}, Author = {Bechtold, Peter and K{\"o}hler, Martin and Jung, Thomas and Doblas-Reyes, Francisco and Leutbecher, Martin and Rodwell, Mark J. and Vitart, Frederic and Balsamo, Gianpaolo}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-06-14 23:11:58 +0000}, Date-Modified = {2016-06-14 23:11:58 +0000}, Doi = {10.1002/qj.289}, @@ -2188,12 +2207,12 @@ @article{bechtold_et_al_2008 Url = {http://dx.doi.org/10.1002/qj.289}, Volume = {134}, Year = {2008}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/qj.289}} @article{han_and_pan_2011, Annote = {doi: 10.1175/WAF-D-10-05038.1}, Author = {Han, Jongil and Pan, Hua-Lu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Weather and Forecasting}, Da = {2011/08/01}, Date = {2011/08/01}, @@ -2214,22 +2233,22 @@ @article{han_and_pan_2011 Volume = {26}, Year = {2011}, Year1 = {2011}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/WAF-D-10-05038.1}} @article{pan_and_wu_1995, Author = {Pan, H. -L. and W.-S. Wu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Date-Added = {2016-06-14 23:06:41 +0000}, Date-Modified = {2016-06-14 23:06:41 +0000}, Journal = {NMC Office Note, No. 409}, Pages = {40pp}, Title = {Implementing a Mass Flux Convection Parameterization Package for the NMC Medium-Range Forecast Model}, - Year = {1995}} + Year = {1995}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}} @article{grell_1993, Annote = {doi: 10.1175/1520-0493(1993)121<0764:PEOAUB>2.0.CO;2}, Author = {Grell, Georg A.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Monthly Weather Review}, Da = {1993/03/01}, Date = {1993/03/01}, @@ -2250,11 +2269,11 @@ @article{grell_1993 Volume = {121}, Year = {1993}, Year1 = {1993}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1993)121%3C0764:PEOAUB%3E2.0.CO;2}} @article{arakawa_and_schubert_1974, Author = {Arakawa, A and Schubert, WH}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Date-Added = {2016-06-14 23:04:30 +0000}, Date-Modified = {2018-07-18 19:00:17 +0000}, Isi = {A1974S778800004}, @@ -2267,6 +2286,7 @@ @article{arakawa_and_schubert_1974 Title = {Interaction of a cumulus cloud ensemble with the large-scale environment, Part I}, Volume = {31}, Year = {1974}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1974S778800004}} @article{harshvardhan_et_al_1989, @@ -2500,7 +2520,6 @@ @article{akmaev_1991 @article{siebesma_et_al_2007, Abstract = {A better conceptual understanding and more realistic parameterizations of convective boundary layers in climate and weather prediction models have been major challenges in meteorological research. In particular, parameterizations of the dry convective boundary layer, in spite of the absence of water phase-changes and its consequent simplicity as compared to moist convection, typically suffer from problems in attempting to represent realistically the boundary layer growth and what is often referred to as countergradient fluxes. The eddy-diffusivity (ED) approach has been relatively successful in representing some characteristics of neutral boundary layers and surface layers in general. The mass-flux (MF) approach, on the other hand, has been used for the parameterization of shallow and deep moist convection. In this paper, a new approach that relies on a combination of the ED and MF parameterizations (EDMF) is proposed for the dry convective boundary layer. It is shown that the EDMF approach follows naturally from a decomposition of the turbulent fluxes into 1) a part that includes strong organized updrafts, and 2) a remaining turbulent field. At the basis of the EDMF approach is the concept that nonlocal subgrid transport due to the strong updrafts is taken into account by the MF approach, while the remaining transport is taken into account by an ED closure. Large-eddy simulation (LES) results of the dry convective boundary layer are used to support the theoretical framework of this new approach and to determine the parameters of the EDMF model. The performance of the new formulation is evaluated against LES results, and it is shown that the EDMF closure is able to reproduce the main properties of dry convective boundary layers in a realistic manner. Furthermore, it will be shown that this approach has strong advantages over the more traditional countergradient approach, especially in the entrainment layer. As a result, this EDMF approach opens the way to parameterize the clear and cumulus-topped boundary layer in a simple and unified way.}, Author = {Siebesma, A. Pier and Soares, Pedro M. M. and Teixeira, Joao}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {DOI 10.1175/JAS3888.1}, @@ -2514,12 +2533,12 @@ @article{siebesma_et_al_2007 Title = {A combined eddy-diffusivity mass-flux approach for the convective boundary layer}, Volume = {64}, Year = {2007}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000245742600011}} @article{soares_et_al_2004, Abstract = {Recently, a new consistent way of parametrizing simultaneously local and non-local turbulent transport for the convective atmospheric boundary layer has been proposed and tested for the clear boundary layer. This approach assumes that in the convective boundary layer the subgrid-scale fluxes result from two different mixing scales: small eddies, that are parametrized by an eddy-diffusivity approach, and thermals, which are represented by a mass-flux contribution. Since the interaction between the cloud layer and the underlying sub-cloud layer predominantly takes place through strong updraughts, this approach offers an interesting avenue of establishing a unified description of the turbulent transport in the cumulus-topped boundary layer. This paper explores the possibility of such a new approach for the cumulus-topped boundary layer. In the sub-cloud and cloud layers, the mass-flux term represents the effect of strong updraughts. These are modelled by a simple entraining parcel, which determines the mean properties of the strong updraughts, the boundary-layer height, the lifting condensation level and cloud top. The residual smaller-scale turbulent transport is parametrized with an eddy-diffusivity approach that uses a turbulent kinetic energy closure. The new scheme is implemented and tested in the research model MesoNH. Copyright {\copyright} 2004 Royal Meteorological Society}, Author = {Soares, P. M. M. and Miranda, P. M. A. and Siebesma, A. P. and Teixeira, J.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1256/qj.03.223}, @@ -2533,11 +2552,11 @@ @article{soares_et_al_2004 Url = {http://dx.doi.org/10.1256/qj.03.223}, Volume = {130}, Year = {2004}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Bdsk-Url-1 = {http://dx.doi.org/10.1256/qj.03.223}} @article{troen_and_mahrt_1986, Author = {Troen, IB and Mahrt, L.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1007/BF00122760}, @@ -2551,13 +2570,13 @@ @article{troen_and_mahrt_1986 Url = {http://dx.doi.org/10.1007/BF00122760}, Volume = {37}, Year = {1986}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1007/BF00122760}} @article{macvean_and_mason_1990, Abstract = {Abstract In a recent paper, Kuo and Schubert demonstrated the lack of observational support for the relevance of the criterion for cloud-top entrainment instability proposed by Randall and by Deardorff. Here we derive a new criterion, based on a model of the instability as resulting from the energy released close to cloud top, by Mixing between saturated boundary-layer air and unsaturated air from above the capping inversion. The condition is derived by considering the net conversion from potential to kinetic energy in a system consisting of two layers of fluid straddling cloud-top, when a small amount of mixing occurs between these layers. This contrasts with previous analyses, which only considered the change in buoyancy of the cloud layer when unsaturated air is mixed into it. In its most general form, this new criterion depends on the ratio of the depths of the layers involved in the mixing. It is argued that, for a self-sustaining instability, there must be a net release of kinetic energy on the same depth and time scales as the entrainment process itself. There are two plausible ways in which this requirement may be satisfied. Either one takes the depths of the layers involved in the mixing to each be comparable to the vertical scale of the entrainment process, which is typically of order tens of meters or less, or alternatively, one must allow for the efficiency with which energy released by mixing through a much deeper lower layer becomes available to initiate further entrainment. In both cases the same criterion for instability results. This criterion is much more restrictive than that proposed by Randall and by Deardorff; furthermore, the observational data is then consistent with the predictions of the current theory. Further analysis provides estimates of the turbulent fluxes associated with cloud-top entrainment instability. This analysis effectively constitutes an energetically consistent turbulence closure for models of boundary layers with cloud. The implications for such numerical models are discussed. Comparisons are also made with other possible criteria for cloud-top entrainment instability which have recently been suggested.}, Annote = {doi: 10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Author = {MacVean, M. K. and Mason, P. J.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1990/04/01}, Date-Added = {2016-05-20 17:16:05 +0000}, @@ -2576,11 +2595,11 @@ @article{macvean_and_mason_1990 Url = {http://dx.doi.org/10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Volume = {47}, Year = {1990}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1990)047%3C1012:CTEITS%3E2.0.CO;2}} @article{louis_1979, Author = {Louis, JF}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:15:52 +0000}, Date-Modified = {2016-05-20 17:15:52 +0000}, Isi = {A1979HT69700004}, @@ -2593,12 +2612,12 @@ @article{louis_1979 Title = {A PARAMETRIC MODEL OF VERTICAL EDDY FLUXES IN THE ATMOSPHERE}, Volume = {17}, Year = {1979}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1979HT69700004}} @article{lock_et_al_2000, Abstract = {A new boundary layer turbulent mixing scheme has been developed for use in the UKMO weather forecasting and climate prediction models. This includes a representation of nonlocal mixing (driven by both surface fluxes and cloud-top processes) in unstable layers, either coupled to or decoupled from the surface, and an explicit entrainment parameterization. The scheme is formulated in moist conserved variables so that it can treat both dry and cloudy layers. Details of the scheme and examples of its performance in single-column model tests are presented.}, Author = {Lock, AP and Brown, AR and Bush, MR and Martin, GM and Smith, RNB}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Date-Added = {2016-05-20 17:15:36 +0000}, Date-Modified = {2016-05-20 17:15:36 +0000}, Isi = {000089461100008}, @@ -2611,13 +2630,13 @@ @article{lock_et_al_2000 Title = {A new boundary layer mixing scheme. {P}art {I}: Scheme description and single-column model tests}, Volume = {128}, Year = {2000}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000089461100008}} @article{hong_and_pan_1996, Abstract = {Abstract In this paper, the incorporation of a simple atmospheric boundary layer diffusion scheme into the NCEP Medium-Range Forecast Model is described. A boundary layer diffusion package based on the Troen and Mahrt nonlocal diffusion concept has been tested for possible operational implementation. The results from this approach are compared with those from the local diffusion approach, which is the current operational scheme, and verified against FIFE observations during 9?10 August 1987. The comparisons between local and nonlocal approaches are extended to the forecast for a heavy rain case of 15?17 May 1995. The sensitivity of both the boundary layer development and the precipitation forecast to the tuning parameters in the nonlocal diffusion scheme is also investigated. Special attention is given to the interaction of boundary layer processes with precipitation physics. Some results of parallel runs during August 1995 are also presented.}, Annote = {doi: 10.1175/1520-0493(1996)124<2322:NBLVDI>2.0.CO;2}, Author = {Hong, Song-You and Pan, Hua-Lu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Booktitle = {Monthly Weather Review}, Da = {1996/10/01}, Date = {1996/10/01}, @@ -2638,13 +2657,13 @@ @article{hong_and_pan_1996 Volume = {124}, Year = {1996}, Year1 = {1996}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1996)124%3C2322:NBLVDI%3E2.0.CO;2}} @article{han_and_pan_2006, Abstract = {Abstract A parameterization of the convection-induced pressure gradient force (PGF) in convective momentum transport (CMT) is tested for hurricane intensity forecasting using NCEP's operational Global Forecast System (GFS) and its nested Regional Spectral Model (RSM). In the parameterization the PGF is assumed to be proportional to the product of the cloud mass flux and vertical wind shear. Compared to control forecasts using the present operational GFS and RSM where the PGF effect in CMT is taken into account empirically, the new PGF parameterization helps increase hurricane intensity by reducing the vertical momentum exchange, giving rise to a closer comparison to the observations. In addition, the new PGF parameterization forecasts not only show more realistically organized precipitation patterns with enhanced hurricane intensity but also reduce the forecast track error. Nevertheless, the model forecasts with the new PGF parameterization still largely underpredict the observed intensity. One of the many possible reasons for the large underprediction may be the absence of hurricane initialization in the models.}, Annote = {doi: 10.1175/MWR3090.1}, Author = {Han, Jongil and Pan, Hua-Lu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Monthly Weather Review}, Da = {2006/02/01}, Date-Added = {2016-05-20 17:11:17 +0000}, @@ -2663,11 +2682,11 @@ @article{han_and_pan_2006 Url = {http://dx.doi.org/10.1175/MWR3090.1}, Volume = {134}, Year = {2006}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/MWR3090.1}} @article{businger_et_al_1971, Author = {Businger, JA and Wyngaard, JC and Izumi, Y and Bradley, EF}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:10:50 +0000}, Date-Modified = {2018-07-18 18:58:08 +0000}, Isi = {A1971I822800004}, @@ -2680,6 +2699,7 @@ @article{businger_et_al_1971 Title = {Flux-profile relationships in the atmospheric surface layer}, Volume = {28}, Year = {1971}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1971I822800004}} @article{xu_and_randall_1996, @@ -2870,18 +2890,17 @@ @article{kim_and_arakawa_1995 @techreport{hou_et_al_2002, Author = {Y. Hou and S. Moorthi and K. Campana}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}, Date-Added = {2016-05-19 19:52:22 +0000}, Date-Modified = {2016-05-20 15:14:59 +0000}, Institution = {NCEP}, Number = {441}, Title = {Parameterization of Solar Radiation Transfer}, Type = {office note}, - Year = {2002}} + Year = {2002}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}} @article{hu_and_stamnes_1993, Author = {Y.X. Hu and K. Stamnes}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}, Date-Added = {2016-05-19 19:31:56 +0000}, Date-Modified = {2016-05-20 15:13:12 +0000}, Journal = {J. Climate}, @@ -2889,276 +2908,303 @@ @article{hu_and_stamnes_1993 Pages = {728-742}, Title = {An accurate parameterization of the radiative properties of water clouds suitable for use in climate models}, Volume = {6}, - Year = {1993}} + Year = {1993}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}} @article{alexander_et_al_2010, - author = {Alexander, M. J. and Geller, M. and McLandress, C. and Polavarapu, S. and Preusse, P. and Sassi, F. and Sato, K. and Eckermann, S. and Ern, M. and Hertzog, A. and Kawatani, Y. and Pulido, M. and Shaw, T. A. and Sigmond, M. and Vincent, R. and Watanabe, S.}, - title = {Recent developments in gravity-wave effects in climate models and the global distribution of gravity-wave momentum flux from observations and models}, - journal = {Quarterly Journal of the Royal Meteorological Society}, - volume = {136}, - number = {650}, - pages = {1103-1124}, - keywords = {atmosphere, gravity wave, momentum flux, drag, force, wind tendency, climate, global model}, - doi = {10.1002/qj.637}, - url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, - eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.637}, - year = {2010}} + Author = {Alexander, M. J. and Geller, M. and McLandress, C. and Polavarapu, S. and Preusse, P. and Sassi, F. and Sato, K. and Eckermann, S. and Ern, M. and Hertzog, A. and Kawatani, Y. and Pulido, M. and Shaw, T. A. and Sigmond, M. and Vincent, R. and Watanabe, S.}, + Doi = {10.1002/qj.637}, + Eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.637}, + Journal = {Quarterly Journal of the Royal Meteorological Society}, + Keywords = {atmosphere, gravity wave, momentum flux, drag, force, wind tendency, climate, global model}, + Number = {650}, + Pages = {1103-1124}, + Title = {Recent developments in gravity-wave effects in climate models and the global distribution of gravity-wave momentum flux from observations and models}, + Url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + Volume = {136}, + Year = {2010}, + Bdsk-Url-1 = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + Bdsk-Url-2 = {https://doi.org/10.1002/qj.637}} @article{plougonven_and_zhang_2014, - author = {Plougonven, R. and Zhang, F.}, - title = {Internal gravity waves from atmospheric jets and fronts}, - journal = {Reviews of Geophysics}, - volume = {52}, - number = {1}, - pages = {33-76}, - keywords = {gravity waves, stratosphere, atmosphere, jets, fronts, weather}, - doi = {10.1002/2012RG000419}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2012RG000419}, - year = {2014}} + Author = {Plougonven, R. and Zhang, F.}, + Doi = {10.1002/2012RG000419}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2012RG000419}, + Journal = {Reviews of Geophysics}, + Keywords = {gravity waves, stratosphere, atmosphere, jets, fronts, weather}, + Number = {1}, + Pages = {33-76}, + Title = {Internal gravity waves from atmospheric jets and fronts}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + Volume = {52}, + Year = {2014}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + Bdsk-Url-2 = {https://doi.org/10.1002/2012RG000419}} @article{weinstock_1984, - author = {Weinstock, J.}, - title = {Simplified derivation of an algorithm for nonlinear gravity waves}, - journal = {Journal of Geophysical Research: Space Physics}, - volume = {89}, - number = {A1}, - pages = {345-350}, - doi = {10.1029/JA089iA01p00345}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/JA089iA01p00345}, - year = {1984}} + Author = {Weinstock, J.}, + Doi = {10.1029/JA089iA01p00345}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/JA089iA01p00345}, + Journal = {Journal of Geophysical Research: Space Physics}, + Number = {A1}, + Pages = {345-350}, + Title = {Simplified derivation of an algorithm for nonlinear gravity waves}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + Volume = {89}, + Year = {1984}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + Bdsk-Url-2 = {https://doi.org/10.1029/JA089iA01p00345}} @article{holton_1983, - author = {Holton, James R.}, - title = {The Influence of Gravity Wave Breaking on the General Circulation of the Middle Atmosphere}, - journal = {Journal of the Atmospheric Sciences}, - volume = {40}, - number = {10}, - pages = {2497-2507}, - year = {1983}, - doi = {10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, - URL = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, - eprint = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}} + Author = {Holton, James R.}, + Doi = {10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + Eprint = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {10}, + Pages = {2497-2507}, + Title = {The Influence of Gravity Wave Breaking on the General Circulation of the Middle Atmosphere}, + Url = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + Volume = {40}, + Year = {1983}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(1983)040%3C2497:TIOGWB%3E2.0.CO;2}} @article{geller_et_al_2013, - author = {Geller, M. A. and Alexander, M. Joan and Love, P. T. and Bacmeister, J. and Ern, M. and Hertzog, A. and Manzini, E. and Preusse, P. and Sato, K. and Scaife, A. A. and Zhou, T.}, - title = {A Comparison between Gravity Wave Momentum Fluxes in Observations and Climate Models}, - journal = {Journal of Climate}, - volume = {26}, - number = {17}, - pages = {6383-6405}, - year = {2013}, - doi = {10.1175/JCLI-D-12-00545.1}, - URL = {https://doi.org/10.1175/JCLI-D-12-00545.1}, - eprint = {https://doi.org/10.1175/JCLI-D-12-00545.1}} + Author = {Geller, M. A. and Alexander, M. Joan and Love, P. T. and Bacmeister, J. and Ern, M. and Hertzog, A. and Manzini, E. and Preusse, P. and Sato, K. and Scaife, A. A. and Zhou, T.}, + Doi = {10.1175/JCLI-D-12-00545.1}, + Eprint = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Journal = {Journal of Climate}, + Number = {17}, + Pages = {6383-6405}, + Title = {A Comparison between Gravity Wave Momentum Fluxes in Observations and Climate Models}, + Url = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Volume = {26}, + Year = {2013}, + Bdsk-Url-1 = {https://doi.org/10.1175/JCLI-D-12-00545.1}} @article{garcia_et_al_2017, - author = {Garcia, R. R. and Smith, A. K. and Kinnison, D. E. and Cámara, Á. and Murphy, D. J.}, - title = {Modification of the Gravity Wave Parameterization in the Whole Atmosphere Community Climate Model: Motivation and Results}, - journal = {Journal of the Atmospheric Sciences}, - volume = {74}, - number = {1}, - pages = {275-291}, - year = {2017}, - doi = {10.1175/JAS-D-16-0104.1}, - URL = {https://doi.org/10.1175/JAS-D-16-0104.1}, - eprint = {https://doi.org/10.1175/JAS-D-16-0104.1}} + Author = {Garcia, R. R. and Smith, A. K. and Kinnison, D. E. and C{\'a}mara, {\'A}. and Murphy, D. J.}, + Doi = {10.1175/JAS-D-16-0104.1}, + Eprint = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {1}, + Pages = {275-291}, + Title = {Modification of the Gravity Wave Parameterization in the Whole Atmosphere Community Climate Model: Motivation and Results}, + Url = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Volume = {74}, + Year = {2017}, + Bdsk-Url-1 = {https://doi.org/10.1175/JAS-D-16-0104.1}} @inproceedings{yudin_et_al_2016, - title={Gravity wave physics in the NOAA Environmental Modeling System}, - author={Yudin, V.A. and Akmaev, R.A. and Fuller-Rowell, T.J. and Alpert, J.C.}, - booktitle={International SPARC Gravity Wave Symposium}, - volume={48}, - number={1}, - pages={012024}, - year={2016}, - organization={}} + Author = {Yudin, V.A. and Akmaev, R.A. and Fuller-Rowell, T.J. and Alpert, J.C.}, + Booktitle = {International SPARC Gravity Wave Symposium}, + Number = {1}, + Pages = {012024}, + Title = {Gravity wave physics in the NOAA Environmental Modeling System}, + Volume = {48}, + Year = {2016}} @inproceedings{alpert_et_al_2018, - title={Integrating Unified Gravity Wave Physics Research into the Next Generation Global Prediction System for NCEP Research to Operations}, - author={Alpert, Jordan C and Yudin, Valery and Fuller-Rowell, Tim and Akmaev, Rashid A}, - booktitle={98th American Meteorological Society Annual Meeting}, - year={2018}, - organization={AMS}} + Author = {Alpert, Jordan C and Yudin, Valery and Fuller-Rowell, Tim and Akmaev, Rashid A}, + Booktitle = {98th American Meteorological Society Annual Meeting}, + Organization = {AMS}, + Title = {Integrating Unified Gravity Wave Physics Research into the Next Generation Global Prediction System for NCEP Research to Operations}, + Year = {2018}} @article{eckermann_2011, - author = {Eckermann, Stephen D.}, - title = {Explicitly Stochastic Parameterization of Nonorographic Gravity Wave Drag}, - journal = {Journal of the Atmospheric Sciences}, - volume = {68}, - number = {8}, - pages = {1749-1765}, - year = {2011}, - doi = {10.1175/2011JAS3684.1}, - URL = {https://doi.org/10.1175/2011JAS3684.1}, - eprint = {https://doi.org/10.1175/2011JAS3684.1}} + Author = {Eckermann, Stephen D.}, + Doi = {10.1175/2011JAS3684.1}, + Eprint = {https://doi.org/10.1175/2011JAS3684.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {8}, + Pages = {1749-1765}, + Title = {Explicitly Stochastic Parameterization of Nonorographic Gravity Wave Drag}, + Url = {https://doi.org/10.1175/2011JAS3684.1}, + Volume = {68}, + Year = {2011}, + Bdsk-Url-1 = {https://doi.org/10.1175/2011JAS3684.1}} @article{lott_et_al_2012, - author = {Lott, F. and Guez, L. and Maury, P.}, - title = {A stochastic parameterization of non-orographic gravity waves: Formalism and impact on the equatorial stratosphere}, - journal = {Geophysical Research Letters}, - volume = {39}, - number = {6}, - pages = {}, - keywords = {Quasi-Biennial Oscillation, Rossby-gravity waves, gravity waves, stochastic parameterization, stratospheric dynamics}, - doi = {10.1029/2012GL051001}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2012GL051001}, - year = {2012}} + Author = {Lott, F. and Guez, L. and Maury, P.}, + Doi = {10.1029/2012GL051001}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2012GL051001}, + Journal = {Geophysical Research Letters}, + Keywords = {Quasi-Biennial Oscillation, Rossby-gravity waves, gravity waves, stochastic parameterization, stratospheric dynamics}, + Number = {6}, + Title = {A stochastic parameterization of non-orographic gravity waves: Formalism and impact on the equatorial stratosphere}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + Volume = {39}, + Year = {2012}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + Bdsk-Url-2 = {https://doi.org/10.1029/2012GL051001}} @conference{yudin_et_al_2018, - author = {Yudin, V. A and Akmaev, R. A. and Alpert, J. C. and Fuller-Rowell T. J., and Karol S. I.}, - Booktitle = {25th Conference on Numerical Weather Prediction}, - Date-Added = {2018-06-04 10:50:44 -0600}, - Date-Modified = {2018-06-04 10:54:39 -0600}, - Editor = {Am. Meteorol. Soc.}, - Title = {Gravity Wave Physics and Dynamics in the FV3-based Atmosphere Models Extended into the Mesosphere}, - Year = {2018}} + Author = {Yudin, V. A and Akmaev, R. A. and Alpert, J. C. and Fuller-Rowell T. J., and Karol S. I.}, + Booktitle = {25th Conference on Numerical Weather Prediction}, + Date-Added = {2018-06-04 10:50:44 -0600}, + Date-Modified = {2018-06-04 10:54:39 -0600}, + Editor = {Am. Meteorol. Soc.}, + Title = {Gravity Wave Physics and Dynamics in the FV3-based Atmosphere Models Extended into the Mesosphere}, + Year = {2018}} @article{hines_1997, - title = "Doppler-spread parameterization of gravity-wave momentum deposition in the middle atmosphere. Part 2: Broad and quasi monochromatic spectra, and implementation", - journal = "Journal of Atmospheric and Solar-Terrestrial Physics", - volume = "59", - number = "4", - pages = "387 - 400", - year = "1997", - issn = "1364-6826", - doi = "https://doi.org/10.1016/S1364-6826(96)00080-6", - url = "http://www.sciencedirect.com/science/article/pii/S1364682696000806", - author = "Colin O. Hines"} + Author = {Colin O. Hines}, + Doi = {https://doi.org/10.1016/S1364-6826(96)00080-6}, + Issn = {1364-6826}, + Journal = {Journal of Atmospheric and Solar-Terrestrial Physics}, + Number = {4}, + Pages = {387 - 400}, + Title = {Doppler-spread parameterization of gravity-wave momentum deposition in the middle atmosphere. Part 2: Broad and quasi monochromatic spectra, and implementation}, + Url = {http://www.sciencedirect.com/science/article/pii/S1364682696000806}, + Volume = {59}, + Year = {1997}, + Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S1364682696000806}, + Bdsk-Url-2 = {https://doi.org/10.1016/S1364-6826(96)00080-6}} @article{alexander_and_dunkerton_1999, - author = {Alexander, M. J. and Dunkerton, T. J.}, - title = {A Spectral Parameterization of Mean-Flow Forcing due to Breaking Gravity Waves}, - journal = {Journal of the Atmospheric Sciences}, - volume = {56}, - number = {24}, - pages = {4167-4182}, - year = {1999}, - doi = {10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, - URL = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, - eprint = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}} + Author = {Alexander, M. J. and Dunkerton, T. J.}, + Doi = {10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + Eprint = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {24}, + Pages = {4167-4182}, + Title = {A Spectral Parameterization of Mean-Flow Forcing due to Breaking Gravity Waves}, + Url = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + Volume = {56}, + Year = {1999}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(1999)056%3C4167:ASPOMF%3E2.0.CO;2}} @article{scinocca_2003, - author = {Scinocca, John F.}, - title = {An Accurate Spectral Nonorographic Gravity Wave Drag Parameterization for General Circulation Models}, - journal = {Journal of the Atmospheric Sciences}, - volume = {60}, - number = {4}, - pages = {667-682}, - year = {2003}, - doi = {10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, - URL = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, - eprint = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}} + Author = {Scinocca, John F.}, + Doi = {10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + Eprint = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {4}, + Pages = {667-682}, + Title = {An Accurate Spectral Nonorographic Gravity Wave Drag Parameterization for General Circulation Models}, + Url = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + Volume = {60}, + Year = {2003}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(2003)060%3C0667:AASNGW%3E2.0.CO;2}} @article{shaw_and_shepherd_2009, - author = {Shaw, Tiffany A. and Shepherd, Theodore G.}, - title = {A Theoretical Framework for Energy and Momentum Consistency in Subgrid-Scale Parameterization for Climate Models}, - journal = {Journal of the Atmospheric Sciences}, - volume = {66}, - number = {10}, - pages = {3095-3114}, - year = {2009}, - doi = {10.1175/2009JAS3051.1}, - URL = {https://doi.org/10.1175/2009JAS3051.1}, - eprint = {https://doi.org/10.1175/2009JAS3051.1}} - -@Article{molod_et_al_2015, - AUTHOR = {Molod, A. and Takacs, L. and Suarez, M. and Bacmeister, J.}, - TITLE = {Development of the GEOS-5 atmospheric general circulation model: evolution from MERRA to MERRA2}, - JOURNAL = {Geoscientific Model Development}, - VOLUME = {8}, - YEAR = {2015}, - NUMBER = {5}, - PAGES = {1339--1356}, - URL = {https://www.geosci-model-dev.net/8/1339/2015/}, - DOI = {10.5194/gmd-8-1339-2015}} + Author = {Shaw, Tiffany A. and Shepherd, Theodore G.}, + Doi = {10.1175/2009JAS3051.1}, + Eprint = {https://doi.org/10.1175/2009JAS3051.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {10}, + Pages = {3095-3114}, + Title = {A Theoretical Framework for Energy and Momentum Consistency in Subgrid-Scale Parameterization for Climate Models}, + Url = {https://doi.org/10.1175/2009JAS3051.1}, + Volume = {66}, + Year = {2009}, + Bdsk-Url-1 = {https://doi.org/10.1175/2009JAS3051.1}} + +@article{molod_et_al_2015, + Author = {Molod, A. and Takacs, L. and Suarez, M. and Bacmeister, J.}, + Doi = {10.5194/gmd-8-1339-2015}, + Journal = {Geoscientific Model Development}, + Number = {5}, + Pages = {1339--1356}, + Title = {Development of the GEOS-5 atmospheric general circulation model: evolution from MERRA to MERRA2}, + Url = {https://www.geosci-model-dev.net/8/1339/2015/}, + Volume = {8}, + Year = {2015}, + Bdsk-Url-1 = {https://www.geosci-model-dev.net/8/1339/2015/}, + Bdsk-Url-2 = {https://doi.org/10.5194/gmd-8-1339-2015}} @article{richter_et_al_2010, - author = {Richter, Jadwiga H. and Sassi, Fabrizio and Garcia, Rolando R.}, - title = {Toward a Physically Based Gravity Wave Source Parameterization in a General Circulation Model}, - journal = {Journal of the Atmospheric Sciences}, - volume = {67}, - number = {1}, - pages = {136-156}, - year = {2010}, - doi = {10.1175/2009JAS3112.1}, - URL = {https://doi.org/10.1175/2009JAS3112.1}, - eprint = {https://doi.org/10.1175/2009JAS3112.1}} + Author = {Richter, Jadwiga H. and Sassi, Fabrizio and Garcia, Rolando R.}, + Doi = {10.1175/2009JAS3112.1}, + Eprint = {https://doi.org/10.1175/2009JAS3112.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {1}, + Pages = {136-156}, + Title = {Toward a Physically Based Gravity Wave Source Parameterization in a General Circulation Model}, + Url = {https://doi.org/10.1175/2009JAS3112.1}, + Volume = {67}, + Year = {2010}, + Bdsk-Url-1 = {https://doi.org/10.1175/2009JAS3112.1}} @article{richter_et_al_2014, - author = {Richter, Jadwiga H. and Solomon, Abraham and Bacmeister, Julio T.}, - title = {Effects of vertical resolution and nonorographic gravity wave drag on the simulated climate in the Community Atmosphere Model, version 5}, - journal = {Journal of Advances in Modeling Earth Systems}, - volume = {6}, - number = {2}, - pages = {357-383}, - keywords = {climate modeling, vertical resolution, modeling, climate, global circulation model, general circulation model}, - doi = {10.1002/2013MS000303}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2013MS000303}, - year = {2014}} + Author = {Richter, Jadwiga H. and Solomon, Abraham and Bacmeister, Julio T.}, + Doi = {10.1002/2013MS000303}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2013MS000303}, + Journal = {Journal of Advances in Modeling Earth Systems}, + Keywords = {climate modeling, vertical resolution, modeling, climate, global circulation model, general circulation model}, + Number = {2}, + Pages = {357-383}, + Title = {Effects of vertical resolution and nonorographic gravity wave drag on the simulated climate in the Community Atmosphere Model, version 5}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + Volume = {6}, + Year = {2014}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + Bdsk-Url-2 = {https://doi.org/10.1002/2013MS000303}} @article{gelaro_et_al_2017, - author = {Gelaro, et al.}, - title = {The Modern-Era Retrospective Analysis for Research and Applications, Version 2 (MERRA-2)}, - journal = {Journal of Climate}, - volume = {30}, - number = {14}, - pages = {5419-5454}, - year = {2017}, - doi = {10.1175/JCLI-D-16-0758.1}, - URL = {https://doi.org/10.1175/JCLI-D-16-0758.1}, - eprint = {https://doi.org/10.1175/JCLI-D-16-0758.1}} + Author = {Gelaro, et al.}, + Doi = {10.1175/JCLI-D-16-0758.1}, + Eprint = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Journal = {Journal of Climate}, + Number = {14}, + Pages = {5419-5454}, + Title = {The Modern-Era Retrospective Analysis for Research and Applications, Version 2 (MERRA-2)}, + Url = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Volume = {30}, + Year = {2017}, + Bdsk-Url-1 = {https://doi.org/10.1175/JCLI-D-16-0758.1}} @article{garcia_et_al_2007, - author = {Garcia, R. R. and Marsh, D. R. and Kinnison, D. E. and Boville, B. A. and Sassi, F.}, - title = {Simulation of secular trends in the middle atmosphere, 1950–2003}, - journal = {Journal of Geophysical Research: Atmospheres}, - volume = {112}, - number = {D9}, - pages = {}, - keywords = {global change, ozone depletion, water vapor trends, temperature trends}, - doi = {10.1029/2006JD007485}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007485}, - year = {2007}} + Author = {Garcia, R. R. and Marsh, D. R. and Kinnison, D. E. and Boville, B. A. and Sassi, F.}, + Doi = {10.1029/2006JD007485}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007485}, + Journal = {Journal of Geophysical Research: Atmospheres}, + Keywords = {global change, ozone depletion, water vapor trends, temperature trends}, + Number = {D9}, + Title = {Simulation of secular trends in the middle atmosphere, 1950--2003}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + Volume = {112}, + Year = {2007}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + Bdsk-Url-2 = {https://doi.org/10.1029/2006JD007485}} @article{eckermann_et_al_2009, - title = "High-altitude data assimilation system experiments for the northern summer mesosphere season of 2007", - journal = "Journal of Atmospheric and Solar-Terrestrial Physics", - volume = "71", - number = "3", - pages = "531 - 551", - year = "2009", - note = "Global Perspectives on the Aeronomy of the Summer Mesopause Region", - issn = "1364-6826", - doi = "https://doi.org/10.1016/j.jastp.2008.09.036", - url = "http://www.sciencedirect.com/science/article/pii/S1364682608002575", - author = "Stephen D. Eckermann and Karl W. Hoppel and Lawrence Coy and John P. McCormack and David E. Siskind and Kim Nielsen and Andrew Kochenash and Michael H. Stevens and Christoph R. Englert and Werner Singer and Mark Hervig", - keywords = "Data assimilation, Polar mesospheric cloud, Tide, Planetary wave, Mesosphere",} + Author = {Stephen D. Eckermann and Karl W. Hoppel and Lawrence Coy and John P. McCormack and David E. Siskind and Kim Nielsen and Andrew Kochenash and Michael H. Stevens and Christoph R. Englert and Werner Singer and Mark Hervig}, + Doi = {https://doi.org/10.1016/j.jastp.2008.09.036}, + Issn = {1364-6826}, + Journal = {Journal of Atmospheric and Solar-Terrestrial Physics}, + Keywords = {Data assimilation, Polar mesospheric cloud, Tide, Planetary wave, Mesosphere}, + Note = {Global Perspectives on the Aeronomy of the Summer Mesopause Region}, + Number = {3}, + Pages = {531 - 551}, + Title = {High-altitude data assimilation system experiments for the northern summer mesosphere season of 2007}, + Url = {http://www.sciencedirect.com/science/article/pii/S1364682608002575}, + Volume = {71}, + Year = {2009}, + Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S1364682608002575}, + Bdsk-Url-2 = {https://doi.org/10.1016/j.jastp.2008.09.036}} @inproceedings{alpert_et_al_2019, - title={Atmospheric Gravity Wave Sources Correlated with Resolved-scale GW Activity and Sub-grid Scale Parameterization in the FV3gfs Model}, - author={Alpert, Jordan C and Yudin, Valery A and Strobach, Edward}, - booktitle={AGU Fall Meeting 2019}, - year={2019}, - organization={AGU}} - -@Article{ern_et_al_2018, - AUTHOR = {Ern, M. and Trinh, Q. T. and Preusse, P. and Gille, J. C. and Mlynczak, M. G. and Russell III, J. M. and Riese, M.}, - TITLE = {GRACILE: a comprehensive climatology of atmospheric gravity wave parameters based on satellite limb soundings}, - JOURNAL = {Earth System Science Data}, - VOLUME = {10}, - YEAR = {2018}, - NUMBER = {2}, - PAGES = {857--892}, - URL = {https://www.earth-syst-sci-data.net/10/857/2018/}, - DOI = {10.5194/essd-10-857-2018}} + Author = {Alpert, Jordan C and Yudin, Valery A and Strobach, Edward}, + Booktitle = {AGU Fall Meeting 2019}, + Organization = {AGU}, + Title = {Atmospheric Gravity Wave Sources Correlated with Resolved-scale GW Activity and Sub-grid Scale Parameterization in the FV3gfs Model}, + Year = {2019}} + +@article{ern_et_al_2018, + Author = {Ern, M. and Trinh, Q. T. and Preusse, P. and Gille, J. C. and Mlynczak, M. G. and Russell III, J. M. and Riese, M.}, + Doi = {10.5194/essd-10-857-2018}, + Journal = {Earth System Science Data}, + Number = {2}, + Pages = {857--892}, + Title = {GRACILE: a comprehensive climatology of atmospheric gravity wave parameters based on satellite limb soundings}, + Url = {https://www.earth-syst-sci-data.net/10/857/2018/}, + Volume = {10}, + Year = {2018}, + Bdsk-Url-1 = {https://www.earth-syst-sci-data.net/10/857/2018/}, + Bdsk-Url-2 = {https://doi.org/10.5194/essd-10-857-2018}} @inproceedings{yudin_et_al_2019, - title={Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, - author={Yudin V.A. , S. I. Karol, R.A. Akmaev, T. Fuller-Rowell, D. Kleist, A. Kubaryk, and C. Thompson}, - booktitle={Space Weather Workshop}, - year={2019},} + Author = {Yudin V.A. , S. I. Karol, R.A. Akmaev, T. Fuller-Rowell, D. Kleist, A. Kubaryk, and C. Thompson}, + Booktitle = {Space Weather Workshop}, + Title = {Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, + Year = {2019}} diff --git a/physics/docs/pdftxt/HWRF_FAMP.txt b/physics/docs/pdftxt/HWRF_FAMP.txt new file mode 100644 index 000000000..4fb555d84 --- /dev/null +++ b/physics/docs/pdftxt/HWRF_FAMP.txt @@ -0,0 +1,91 @@ +/** +\page HWRF_famp HWRF Ferrier-Aligo (FA) Microphysics Scheme +\section des_famp Description + +The Ferrier-Aligo (FA) microphysics (Aligo et al. 2018 \cite aligo_et_al_2018) is a single +moment scheme predicting mass mixing ratios of rain water (\f$q_r\f$), cloud water (\f$q_c\f$), +cloud ice (\f$q_i\f$), and snow-graupel (\f$q_s\f$). The FA scheme is currently used operationally +in the North American Mesoscale Forecast System (NAM; including the parent 12-km domain, the 3-km +NAM nests, and the 1.5km fire weather nest), the Hurricane Weather Research and Forecasting Model (HWRF), +the Hurricanes in a Multi-scale Ocean-coupled Non-hydrostatic Model (HMON), and the High-Resolution +Window (HiResW) Non-dydrostatic Multiscale Model on the B grid (NMMB). The FA scheme advects each +species separately in the NAM nests, and advects the total condensate in the 12-km parent NAM,HiResW NMMB, +HWRF, and HMON. + +Unique to the FA scheme is the calculation of a diagnostic array called the "rime factor" (RF), which +represents the degree of riming onto snow-graupel, and takes into account the temperature of the ice particle, +the impact velocity of the cloud droplet on the ice particle, and the size of the cloud droplet. For all +practical purposes, one can categorize precipitation ice as snow, graupel, or hail, similar to the ice +species predicted in other microphysical schemes based on the value of the RF. For example, an RF = 1 +represents unrimed snow; lightly rimed snow occurs when 1 < RF < 2; heavily rimed snow when 2< RF \f$\leq\f$ 5; +graupel when 5 < RF < 10; and frozen drops or hail when RF \f$geqslant\f$ 10. In reality, the RF knows +no arbitrary cutoff between different ice categories, and the categorizations above are somewhat subjective. +Figure 1 is a schematic illustration of the FA scheme processes and each process is described in Table 1. + +\image html FA_MP_schematic.png "Figure 1: Schematic illustration of FA scheme processes with a description of each process in Table 1." width=10cm + +Table 1. List of microphysical processes and their description. All processes are in units of \f$kg kg^{-1}\f$. +\tableofcontents +| Microphysical Source/Sinks | Description | +|----------------------------------|--------------------------------------------------------| +| PIHOM | Homogeneous freezing of cloud water to ice. | +| PIDEP | Net ice deposition (> 0) or sublimation (< 0). | +| PINIT | Initiation (nucleation) of cloud ice. | +| PIACW | Cloud water collection by precipitation ice. | +| PIACWI | Cloud water riming onto precipitation ice at < 0 | +| PIACR | Freezing of supercooled rain to precipitation ice. | +| PIMLT | Melting of precipitation ice to form rain. | +| PICND | Condensation onto wet, melting ice. | +| PIEVP | Evaporation from wet, melting ice. | +| PCOND | Net cloud water condensation (> 0) or evaporation (< 0)| +| PRAUT | Droplet self-collection (Autoconversion) to form rain. | +| PRACW | Cloud water collection (Accretion) by rain. | +| PREVP | Rain evaporation. | +| PIACWR | Accreted cloud water shed to form rain at > 0 | +\tableofcontents + +Owing to operational computation constraints, and unique to the FA scheme, the sedimentation process +does not use finite differencing of precipitation fluxes in the vertical in order to circumvent the +requirement that small time steps be used in order to maintain numerical stability, particularly since +the vertical resolution often increases dramatically near the ground. The algorithm is instead based upon +a partitioning of precipitation already present in the grid box at the beginning of the time step and the +precipitation entering the grid box from above at the end of the time step. A more detailed description +of the sedimentation algorithm can be found in Aligo et al. (2018, appendix D). + +An algorithm was developed in FA to improve stratiform rainfall by allowing the rain intercept parameter, +\f$N_{or}\f$, to vary with height and the mean drop diameter to be fixed below melting layers. This is +different from other single-moment microphysics schemes (WSM6 and Lin) that assume a constant value for +\f$N_{or}\f$. The algorithm in the FA scheme, simular to what is done in the Thompson scheme \cite Thompson_2008, +assumes that a snow-graupel particle about to enter the melting layer from above has the same mean mass +as a drop formed from melting below the melting layer. The mean drop diameter calculated below the melting layer +acts as the lower limit for the mean drop sizes as the rain descends to lower levels. This algorithm is only +active if 1) the snow-graupel density above the melting level (i.e.\f$T_c<0^{o}C\f$) is \f$<225kg m^{-3}\f$ +(which corresponds to an RF=10), 2) the rain content does not exceed \f$1gm^{-3}\f$, and 3) there is vertical +continuity of the rain at lower levels with the rain that formed from melting ice. + +The FA scheme also uses a drizzle parameterization in order to minimize the spatial extent of light (<20dBZ) +reflectivity echoes that developed at the top of moist boundary layers, over the Southeastern U.S., within +warm conveyor belts, and over ocean areas covered by stratocumulus in the NMMB. The drizzle parameterization +uses a variable \f$N_{or}\f$ following Westbrook et al. (2010) \cite westbrook_et_al_2010, and approach +conceptually similar to that described in Thompson et al.(2008) \cite Thompson_2008 for drizzle. Figure 2a +shows an example of drizzle forming in a single low-level liquid cloud layer above \f$0^oC\f$, in which the +smaller, more numerous drizzle drops produce lower radar reflectivities, compared to rain, with \f$N_{or}=8\times10^6m\f$, +for example. For multiple cloud layers, drizzle from low clouds must be completely disconnected from rain formed +aloft from melting ice, such that a rain-free layer must seperate any stratiform rain layer aloft from drizzle formed +within liquid clouds at lower levels.Supercooled drizzle is also allowed to form from warm-rain processes below \f$0^oC\f$. +The quantity \f$N_{or}\f$ is modified only when the rainwater content is \f$< 0.5 gm^{-3}\f$, such that \f$N_{or}\f$ is +assumed to vary (red line in Fig.2b) with rain content (\f$\rho_\alpha\times q_r\f$) as + +\image html FA_NOR_EQ.png " " width=10cm + +\image html FA_DRI.png " Figure 2. (a) Schematic illustration of the drizzle parameterization for a single cloud layer in which drizzle forms from a low-level liquid water cloud at > 0C only when it is completely disconnected from rain formed from melting ice aloft. (b) The scatterplot from Westbrook at al.(2010) shows retrieved rain rate (R,mm/h) vs the mornalized rain intercept paramter (Nl in 1/m^4, where Nl=Nor for exponential distributions) based on lidar observations of drizzle. The different values of Nor described in (1) are overlaid on the figure with the red line showing the variation of Nor as a funciton of rain rate for rain contents between 0.02 and 0.5 g/m^3. " width=10cm + + +\section intra_famp Intraphysics Communication +\ref arg_table_mp_fer_hires_run + +\section gen_famp General Algorithm +\ref gen_al_famp + + +*/ diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index 02a09481b..f45ffa04f 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -1,9 +1,9 @@ !>\file module_MP_FER_HIRES.F90 !! "Modified" fer_hires microphysics - 11 July 2016 version !! -! (1) Ice nucleation: Fletcher (1962) replaces Meyers et al. (1992) -! (2) Cloud ice is a simple function of the number concentration from (1), and it -! is no longer a fractional function of the large ice. Thus, the FLARGE & +!! (1) Ice nucleation: Fletcher (1962) replaces Meyers et al. (1992) +!! (2) Cloud ice is a simple function of the number concentration from (1), and it +!! is no longer a fractional function of the large ice. Thus, the FLARGE & ! FSMALL parameters are no longer used. ! (3) T_ICE_init=-12 deg C provides a slight delay in the initial onset of ice. ! (4) NLImax is a function of rime factor (RF) and temperature. @@ -242,37 +242,41 @@ MODULE MODULE_MP_FER_HIRES !! version, and QRIMEF is only in the advected version. The innards !! are all the same. SUBROUTINE FER_HIRES (DT,RHgrd, & - & dz8w,rho_phy,p_phy,pi_phy,th_phy,t_phy, & + & prsi,p_phy,t_phy, & & q,qt, & - & LOWLYR,SR, & + & LOWLYR,SR,TRAIN_PHY, & & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & & QC,QR,QS, & & RAINNC,RAINNCV, & & threads, & - & ims,ime, jms,jme, lm, & + & ims,ime, lm, & & d_ss, & & refl_10cm,DX1 ) !----------------------------------------------------------------------- IMPLICIT NONE !----------------------------------------------------------------------- - INTEGER,INTENT(IN) :: D_SS,IMS,IME,JMS,JME,LM,DX1 + INTEGER,INTENT(IN) :: D_SS,IMS,IME,LM,DX1 REAL, INTENT(IN) :: DT,RHgrd INTEGER, INTENT(IN) :: THREADS - REAL, INTENT(IN), DIMENSION(ims:ime, jms:jme, lm):: & - & dz8w,p_phy,pi_phy,rho_phy - REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme, lm):: & - & th_phy,t_phy,q,qt - REAL, INTENT(INOUT), DIMENSION(ims:ime,jms:jme, lm ) :: & + REAL, INTENT(IN), DIMENSION(ims:ime, lm+1):: & + & prsi + REAL, INTENT(IN), DIMENSION(ims:ime, lm):: & + & p_phy + REAL, INTENT(INOUT), DIMENSION(ims:ime, lm):: & + & q,qt,t_phy + REAL, INTENT(INOUT), DIMENSION(ims:ime, lm ):: & !Aligo Oct 23,2019: dry mixing ratio for cloud species & qc,qr,qs - REAL, INTENT(INOUT), DIMENSION(ims:ime, jms:jme,lm) :: & + REAL, INTENT(INOUT), DIMENSION(ims:ime, lm) :: & & F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY - REAL, INTENT(OUT), DIMENSION(ims:ime, jms:jme,lm) :: & + REAL, INTENT(OUT), DIMENSION(ims:ime, lm) :: & & refl_10cm - REAL, INTENT(INOUT), DIMENSION(ims:ime,jms:jme) :: & + REAL, INTENT(INOUT), DIMENSION(ims:ime) :: & & RAINNC,RAINNCV - REAL, INTENT(OUT), DIMENSION(ims:ime,jms:jme):: SR + REAL, INTENT(OUT), DIMENSION(ims:ime):: SR + REAL, INTENT(OUT), DIMENSION( ims:ime, lm ) :: & + & TRAIN_PHY ! - INTEGER, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT) :: LOWLYR + INTEGER, DIMENSION( ims:ime ),INTENT(INOUT) :: LOWLYR !----------------------------------------------------------------------- ! LOCAL VARS @@ -282,24 +286,22 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & ! the microphysics scheme. Instead, they will be used by Eta precip ! assimilation. - REAL, DIMENSION( ims:ime, jms:jme,lm ) :: & - & TLATGS_PHY,TRAIN_PHY - REAL, DIMENSION(ims:ime,jms:jme):: APREC,PREC,ACPREC + REAL, DIMENSION(ims:ime):: APREC,PREC,ACPREC - INTEGER :: I,J,K,KK + INTEGER :: I,K,KK REAL :: wc !------------------------------------------------------------------------ ! For subroutine EGCP01COLUMN_hr !----------------------------------------------------------------------- INTEGER :: LSFC,I_index,J_index,L - INTEGER,DIMENSION(ims:ime,jms:jme) :: LMH + INTEGER,DIMENSION(ims:ime) :: LMH REAL :: TC,QI,QRdum,QW,Fice,Frain,DUM,ASNOW,ARAIN REAL,DIMENSION(lm) :: P_col,Q_col,T_col,WC_col, & RimeF_col,QI_col,QR_col,QW_col, THICK_col,DPCOL,pcond1d, & pidep1d,piacw1d,piacwi1d,piacwr1d,piacr1d,picnd1d,pievp1d, & pimlt1d,praut1d,pracw1d,prevp1d,pisub1d,pevap1d,DBZ_col, & NR_col,NS_col,vsnow1d,vrain11d,vrain21d,vci1d,NSmICE1d, & - INDEXS1d,INDEXR1d,RFlag1d,RHC_col + INDEXS1d,INDEXR1d,RFlag1d,RHC_col ! !----------------------------------------------------------------------- !********************************************************************** @@ -309,7 +311,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & ! MZ: HWRF start !---------- !2015-03-30, recalculate some constants which may depend on phy time step - CALL MY_GROWTH_RATES_NMM_hr (DT) + CALL MY_GROWTH_RATES_NMM_hr (DT) !--- CIACW is used in calculating riming rates ! The assumed effective collection efficiency of cloud water rimed onto @@ -331,93 +333,79 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & ! BRAUT=DT*1.1E10*BETA6/NCW - !write(*,*)'dt=',dt - !write(*,*)'pi=',pi - !write(*,*)'c1=',c1 - !write(*,*)'ciacw=',ciacw - !write(*,*)'ciacr=',ciacr - !write(*,*)'cracw=',cracw - !write(*,*)'araut=',araut - !write(*,*)'braut=',braut !! END OF adding, 2015-03-30 !----------- ! MZ: HWRF end ! - DO j = jms,jme DO i = ims,ime - ACPREC(i,j)=0. - APREC (i,j)=0. - PREC (i,j)=0. - SR (i,j)=0. + ACPREC(i)=0. + APREC (i)=0. + PREC (i)=0. + SR (i)=0. ENDDO + DO k = 1,lm DO i = ims,ime - TLATGS_PHY (i,j,k)=0. - TRAIN_PHY (i,j,k)=0. + TRAIN_PHY (i,k)=0. ENDDO ENDDO - ENDDO !----------------------------------------------------------------------- !-- Start of original driver for EGCP01COLUMN_hr !----------------------------------------------------------------------- ! - DO J=JMS,JME - DO I=IMS,IME - LSFC=LM-LOWLYR(I,J)+1 ! "L" of surface - DO K=1,LM - DPCOL(K)=RHO_PHY(I,J,K)*GRAV*dz8w(I,J,K) - ENDDO + DO I=IMS,IME + LSFC=LM-LOWLYR(I)+1 ! "L" of surface + DO K=1,LM + DPCOL(K)=prsi(I,K)-prsi(I,K+1) + ENDDO ! !--- Initialize column data (1D arrays) ! - L=LM + L=LM !-- qt = CWM, total condensate - IF (qt(I,J,L) .LE. EPSQ) qt(I,J,L)=EPSQ - F_ice_phy(I,J,L)=1. - F_rain_phy(I,J,L)=0. - F_RimeF_phy(I,J,L)=1. + IF (qt(I,L) .LE. EPSQ) qt(I,L)=EPSQ + F_ice_phy(I,L)=1. + F_rain_phy(I,L)=0. + F_RimeF_phy(I,L)=1. do L=LM,1,-1 -! -!--- Pressure (Pa) = (Psfc-Ptop)*(ETA/ETA_sfc)+Ptop -! - P_col(L)=P_phy(I,J,L) + P_col(L)=P_phy(I,L) ! !--- Layer thickness = RHO*DZ = -DP/G = (Psfc-Ptop)*D_ETA/(G*ETA_sfc) ! THICK_col(L)=DPCOL(L)*RGRAV - T_col(L)=T_phy(I,J,L) + T_col(L)=T_phy(I,L) TC=T_col(L)-T0C - Q_col(L)=max(EPSQ, q(I,J,L)) - IF (qt(I,J,L) .LE. EPSQ1) THEN + Q_col(L)=max(EPSQ, q(I,L)) + IF (qt(I,L) .LE. EPSQ1) THEN WC_col(L)=0. IF (TC .LT. T_ICE) THEN - F_ice_phy(I,J,L)=1. + F_ice_phy(I,L)=1. ELSE - F_ice_phy(I,J,L)=0. + F_ice_phy(I,L)=0. ENDIF - F_rain_phy(I,J,L)=0. - F_RimeF_phy(I,J,L)=1. + F_rain_phy(I,L)=0. + F_RimeF_phy(I,L)=1. ELSE - WC_col(L)=qt(I,J,L) + WC_col(L)=qt(I,L) !-- Debug 20120111 ! TC==TC will fail if NaN, preventing unnecessary error messages IF (WC_col(L)>QTwarn .AND. P_col(L)1 g/kg condensate in stratosphere; I,J,L,TC,P,QT=', & - I,J,L,TC,.01*P_col(L),1000.*WC_col(L) + WRITE(0,*) 'WARN4: >1 g/kg condensate in stratosphere; I,L,TC,P,QT=', & + I,L,TC,.01*P_col(L),1000.*WC_col(L) QTwarn=MAX(WC_col(L),10.*QTwarn) Pwarn=MIN(P_col(L),0.5*Pwarn) ENDIF !-- TC/=TC will pass if TC is NaN IF (WARN5 .AND. TC/=TC) THEN - WRITE(0,*) 'WARN5: NaN temperature; I,J,L,P=',I,J,L,.01*P_col(L) + WRITE(0,*) 'WARN5: NaN temperature; I,L,P=',I,L,.01*P_col(L) WARN5=.FALSE. ENDIF ENDIF - IF (T_ICE<=-100.) F_ice_phy(I,J,L)=0. + IF (T_ICE<=-100.) F_ice_phy(I,L)=0. ! ! ! !--- Determine composition of condensate in terms of ! ! cloud water, ice, & rain @@ -426,8 +414,8 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & QI=0. QRdum=0. QW=0. - Fice=F_ice_phy(I,J,L) - Frain=F_rain_phy(I,J,L) + Fice=F_ice_phy(I,L) + Frain=F_rain_phy(I,L) ! IF (Fice .GE. 1.) THEN QI=WC @@ -447,8 +435,8 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & QW=QW-QRdum ENDIF ENDIF - IF (QI .LE. 0.) F_RimeF_phy(I,J,L)=1. - RimeF_col(L)=F_RimeF_phy(I,J,L) ! (real) + IF (QI .LE. 0.) F_RimeF_phy(I,L)=1. + RimeF_col(L)=F_RimeF_phy(I,L) ! (real) QI_col(L)=QI QR_col(L)=QRdum QW_col(L)=QW @@ -469,8 +457,8 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !--- Perform the microphysical calculations in this column ! I_index=I - J_index=J - CALL EGCP01COLUMN_hr ( ARAIN, ASNOW, DT, RHC_col, & + J_index=1 + CALL EGCP01COLUMN_hr ( ARAIN, ASNOW, DT, RHC_col, & & I_index, J_index, LSFC, & & P_col, QI_col, QR_col, Q_col, QW_col, RimeF_col, T_col, & & THICK_col, WC_col,LM,pcond1d,pidep1d, & @@ -483,11 +471,10 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !--- Update storage arrays ! do L=LM,1,-1 - TRAIN_phy(I,J,L)=(T_col(L)-T_phy(I,J,L))/DT - TLATGS_phy(I,J,L)=T_col(L)-T_phy(I,J,L) - T_phy(I,J,L)=T_col(L) - q(I,J,L)=Q_col(L) - qt(I,J,L)=WC_col(L) + TRAIN_phy(I,L)=(T_col(L)-T_phy(I,L))/DT + T_phy(I,L)=T_col(L) + q(I,L)=Q_col(L) + qt(I,L)=WC_col(L) !---convert 1D source/sink terms to one 4D array !---d_ss is the total number of source/sink terms in the 4D mprates array !---if d_ss=1, only 1 source/sink term is used @@ -496,20 +483,20 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !--- REAL*4 array storage ! IF (QI_col(L) .LE. EPSQ) THEN - F_ice_phy(I,J,L)=0. - IF (T_col(L) .LT. T_ICEK) F_ice_phy(I,J,L)=1. - F_RimeF_phy(I,J,L)=1. + F_ice_phy(I,L)=0. + IF (T_col(L) .LT. T_ICEK) F_ice_phy(I,L)=1. + F_RimeF_phy(I,L)=1. ELSE - F_ice_phy(I,J,L)=MAX( 0., MIN(1., QI_col(L)/WC_col(L)) ) - F_RimeF_phy(I,J,L)=MAX(1., RimeF_col(L)) + F_ice_phy(I,L)=MAX( 0., MIN(1., QI_col(L)/WC_col(L)) ) + F_RimeF_phy(I,L)=MAX(1., RimeF_col(L)) ENDIF IF (QR_col(L) .LE. EPSQ) THEN DUM=0 ELSE DUM=QR_col(L)/(QR_col(L)+QW_col(L)) ENDIF - F_rain_phy(I,J,L)=DUM - REFL_10CM(I,J,L)=DBZ_col(L) !jul28 + F_rain_phy(I,L)=DUM + REFL_10CM(I,L)=DBZ_col(L) !jul28 ENDDO ! !--- Update accumulated precipitation statistics @@ -517,63 +504,57 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !--- Surface precipitation statistics; SR is fraction of surface ! precipitation (if >0) associated with snow ! - APREC(I,J)=(ARAIN+ASNOW)*RRHOL ! Accumulated surface precip (depth in m) !<--- Ying - PREC(I,J)=PREC(I,J)+APREC(I,J) - ACPREC(I,J)=ACPREC(I,J)+APREC(I,J) - IF(APREC(I,J) .LT. 1.E-8) THEN - SR(I,J)=0. + APREC(I)=(ARAIN+ASNOW)*RRHOL ! Accumulated surface precip (depth in m) !<--- Ying + PREC(I)=PREC(I)+APREC(I) + ACPREC(I)=ACPREC(I)+APREC(I) + IF(APREC(I) .LT. 1.E-8) THEN + SR(I)=0. ELSE - SR(I,J)=RRHOL*ASNOW/APREC(I,J) + SR(I)=RRHOL*ASNOW/APREC(I) ENDIF ! !####################################################################### !####################################################################### ! enddo ! End "I" loop - enddo ! End "J" loop ! !----------------------------------------------------------------------- !-- End of original driver for EGCP01COLUMN_hr !----------------------------------------------------------------------- ! - DO j = jms,jme do k = lm, 1, -1 DO i = ims,ime - th_phy(i,j,k) = t_phy(i,j,k)/pi_phy(i,j,k) - WC=qt(I,J,K) - QS(I,J,K)=0. - QR(I,J,K)=0. - QC(I,J,K)=0. -! - IF(F_ICE_PHY(I,J,K)>=1.)THEN - QS(I,J,K)=WC - ELSEIF(F_ICE_PHY(I,J,K)<=0.)THEN - QC(I,J,K)=WC + WC=qt(I,K) + QS(I,K)=0. + QR(I,K)=0. + QC(I,K)=0. +! + IF(F_ICE_PHY(I,K)>=1.)THEN + QS(I,K)=WC + ELSEIF(F_ICE_PHY(I,K)<=0.)THEN + QC(I,K)=WC ELSE - QS(I,J,K)=F_ICE_PHY(I,J,K)*WC - QC(I,J,K)=WC-QS(I,J,K) + QS(I,K)=F_ICE_PHY(I,K)*WC + QC(I,K)=WC-QS(I,K) ENDIF ! - IF(QC(I,J,K)>0..AND.F_RAIN_PHY(I,J,K)>0.)THEN - IF(F_RAIN_PHY(I,J,K).GE.1.)THEN - QR(I,J,K)=QC(I,J,K) - QC(I,J,K)=0. + IF(QC(I,K)>0..AND.F_RAIN_PHY(I,K)>0.)THEN + IF(F_RAIN_PHY(I,K).GE.1.)THEN + QR(I,K)=QC(I,K) + QC(I,K)=0. ELSE - QR(I,J,K)=F_RAIN_PHY(I,J,K)*QC(I,J,K) - QC(I,J,K)=QC(I,J,K)-QR(I,J,K) + QR(I,K)=F_RAIN_PHY(I,K)*QC(I,K) + QC(I,K)=QC(I,K)-QR(I,K) ENDIF ENDIF ENDDO !- i ENDDO !- k - ENDDO !- j ! !- Update rain (convert from m to kg/m**2, which is also equivalent to mm depth) ! - DO j=jms,jme DO i=ims,ime - RAINNC(i,j)=APREC(i,j)*1000.+RAINNC(i,j) - RAINNCV(i,j)=APREC(i,j)*1000. - ENDDO + RAINNC(i)=APREC(i)*1000.+RAINNC(i) + RAINNCV(i)=APREC(i)*1000. ENDDO ! !----------------------------------------------------------------------- @@ -639,16 +620,38 @@ END SUBROUTINE FER_HIRES !!\param qi_col vertical column of model ice mixing ratio (kg/kg) !!\param qr_col vertical column of model rain ratio (kg/kg) !!\param q_col vertical column of model water vapor specific humidity (kg/kg) -!!\param qw_col -!!\param rimef_col -!!\param t_col -!!\param thick_col -!!\param wc_col -!!\param lm -!!\param pcond1d -!!\param pidep1d -!!\param piacw1d -!!\param piacwi1d +!!\param qw_col vertical column of model cloud water mixing ratio (kg/kg) +!!\param rimef_col vertical column of rime factor for ice in model (ratio, defined below) +!!\param t_col vertical column of model temperature (deg K) +!!\param thick_col vertical column of model mass thickness (density*height increment) +!!\param wc_col vertical column of model mixing ratio of total condensate (kg/kg) +!!\param lm vertical dimension +!!\param pcond1d net cloud water condensation (>0) or evaporation (<0) (kg/kg) +!!\param pidep1d net ice deposition (>0) or sublimation (<0) (kg/kg) +!!\param piacw1d cloud water collection by precipitation ice (kg/kg) +!!\param piacwi1d cloud water riming onto precipitation ice at <0 (kg/kg) +!!\param piacwr1d accreted cloud water shed to form rain at >0 (kg/kg) +!!\param piacr1d freezing of supercooled rain to precipitation ice (kg/kg) +!!\param picnd1d condensation onto wet, melting ice (kg/kg) +!!\param pievp1d evaporation from wet, melting ice (kg/kg) +!!\param pimlt1d melting of precipitation ice to form rain (kg/kg) +!!\param praut1d droplet self_collection (autoconversion) to form rain (kg/kg) +!!\param pracw1d cloud water collection (accretion) by rain (kg/kg) +!!\param prevp1d rain evaporation (kg/kg) +!!\param pisub1d +!!\param pevap1d +!!\param DBZ_col vertical column of radar reflectivity (dBZ) +!!\param NR_col vertical column of rain number concentration (m^-3) +!!\param NS_col vertical column of snow number concentration (m^-3) +!!\param vsnow1d fall speed of rimed snow w/ air resistance correction +!!\param vrain11d fall speed of rain into grid from above (m/s) +!!\param vrain21d fall speed of rain out of grid box to the level below (m/s) +!!\param vci1d Fall speed of 50-micron ice crystals w/ air resistance correction +!!\param NSmICE1d number concentration of small ice crystals at current level +!!\param INDEXS1d +!!\param INDEXR1d +!!\param RFlag1d +!!\param DX1 SUBROUTINE EGCP01COLUMN_hr ( ARAIN, ASNOW, DTPH, RHC_col, & & I_index, J_index, LSFC, & & P_col, QI_col, QR_col, Q_col, QW_col, RimeF_col, T_col, & diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index 95e521141..19cfa117a 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -1,5 +1,5 @@ !>\file mp_fer_hires.F90 -!! This file contains +!! This file contains the Ferrier-Aligo microphysics scheme driver. ! module mp_fer_hires @@ -113,7 +113,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & end subroutine mp_fer_hires_init -!>\defgroup hafs_famp HAFS Ferrier-Aligo Cloud Microphysics Scheme +!>\defgroup hafs_famp HWRF Ferrier-Aligo Microphysics Scheme !> This is the CCPP-compliant FER_HIRES driver module. !> \section arg_table_mp_fer_hires_run Argument Table !! \htmlinclude mp_fer_hires_run.html @@ -124,9 +124,8 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ,T,Q,CWM & ,TRAIN,SR & ,F_ICE,F_RAIN,F_RIMEF & - ,QC,QR,QI,QG & ! wet mixing ratio - !,qc_m,qi_m,qr_m & - ,PREC &!,ACPREC -MZ:not used + ,QC,QR,QI,QG & + ,PREC & ,mpirank, mpiroot, threads & ,refl_10cm & ,RHGRD,dx & @@ -171,7 +170,6 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys), intent(inout) :: qg(1:ncol,1:nlev) ! QRIMEF real(kind_phys), intent(inout) :: prec(1:ncol) -! real(kind_phys) :: acprec(1:ncol) !MZ: change to local real(kind_phys), intent(inout) :: refl_10cm(1:ncol,1:nlev) real(kind_phys), intent(in ) :: rhgrd real(kind_phys), intent(in ) :: dx(1:ncol) @@ -185,27 +183,19 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & integer :: I,J,K,N integer :: lowlyr(1:ncol) integer :: dx1 - !real(kind_phys) :: mprates(1:ncol,1:nlev,d_ss) - real(kind_phys) :: DTPHS,PCPCOL,RDTPHS,TNEW + real(kind_phys) :: PCPCOL real(kind_phys) :: ql(1:nlev),tl(1:nlev) real(kind_phys) :: rainnc(1:ncol),rainncv(1:ncol) real(kind_phys) :: snownc(1:ncol),snowncv(1:ncol) real(kind_phys) :: graupelncv(1:ncol) - real(kind_phys) :: dz(1:ncol,1:nlev) - real(kind_phys) :: pi_phy(1:ncol,1:nlev) - real(kind_phys) :: rr(1:ncol,1:nlev) - real(kind_phys) :: th_phy(1:ncol,1:nlev) - real(kind_phys) :: R_G, CAPPA + real(kind_phys) :: train_phy(1:ncol,1:nlev) ! Dimension - integer :: ims, ime, jms, jme, lm + integer :: ims, ime, lm !----------------------------------------------------------------------- !*********************************************************************** !----------------------------------------------------------------------- - R_G=1./G - CAPPA=R_D/CP - ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 @@ -217,18 +207,9 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & return end if - -!ZM NTSD=ITIMESTEP -!ZM presume nphs=1 DTPHS=NPHS*DT - DTPHS=DT - RDTPHS=1./DTPHS -!ZM AVRAIN=AVRAIN+1. - ! Set internal dimensions ims = 1 ime = ncol - jms = 1 - jme = 1 lm = nlev ! Use the dx of the 1st i point to set an integer value of dx to be used for @@ -266,18 +247,8 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !*** FILL THE SINGLE-COLUMN INPUT !----------------------------------------------------------------------- ! - DO K=LM,1,-1 ! We are moving down from the top in the flipped arrays + DO K=LM,1,-1 !mz* We are moving down from the top in the flipped arrays -! -! TL(K)=T(I,K) -! QL(K)=AMAX1(Q(I,K),EPSQ) -! - RR(I,K)=P_PHY(I,K)/(R_D*T(I,K)*(P608*AMAX1(Q(I,K),EPSQ)+1.)) - PI_PHY(I,K)=(P_PHY(I,K)*1.E-5)**CAPPA - TH_PHY(I,K)=T(I,K)/PI_PHY(I,K) - DZ(I,K)=(PRSI(I,K)-PRSI(I,K+1))*R_G/RR(I,K) - -! !*** CALL MICROPHYSICS !MZ* in HWRF @@ -289,7 +260,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & IF (T(I,K) < T_ICEK) F_ICE(I,K)=1. ELSE F_ICE(I,K)=MAX( 0., MIN(1., QI(I,K)/cwm(I,K) ) ) - F_RIMEF(I,K)=QG(I,K)/QI(I,K) + F_RIMEF(I,K)=QG(I,K)!/QI(I,K) ENDIF IF (QR(I,K) <= EPSQ) THEN F_RAIN(I,K)=0. @@ -297,38 +268,30 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & F_RAIN(I,K)=QR(I,K)/(QR(I,K)+QC(I,K)) ENDIF - end do - enddo - -!--------------------------------------------------------------------- -!*** Update the rime factor array after 3d advection -!--------------------------------------------------------------------- -!MZ* in namphysics -! DO K=1,LM -! DO I=IMS,IME -! IF (QG(I,K)>EPSQ .AND. QI(I,K)>EPSQ) THEN -! F_RIMEF(I,K)=MIN(50.,MAX(1.,QG(I,K)/QI(I,K))) -! ELSE -! F_RIMEF(I,K)=1. -! ENDIF -! ENDDO -! ENDDO + ENDDO + ENDDO +!--------------------------------------------------------------------- +!aligo + cwm(i,k) = cwm(i,k)/(1.0_kind_phys-q(i,k)) + qr(i,k) = qr(i,k)/(1.0_kind_phys-q(i,k)) + qi(i,k) = qi(i,k)/(1.0_kind_phys-q(i,k)) + qc(i,k) = qc(i,k)/(1.0_kind_phys-q(i,k)) +!aligo !--------------------------------------------------------------------- CALL FER_HIRES( & - DT=dtphs,RHgrd=RHGRD & - ,DZ8W=dz,RHO_PHY=rr,P_PHY=p_phy,PI_PHY=pi_phy & - ,TH_PHY=th_phy,T_PHY=t & + DT=DT,RHgrd=RHGRD & + ,PRSI=prsi,P_PHY=p_phy,T_PHY=t & ,Q=Q,QT=cwm & - ,LOWLYR=LOWLYR,SR=SR & + ,LOWLYR=LOWLYR,SR=SR,TRAIN_PHY=train_phy & ,F_ICE_PHY=F_ICE,F_RAIN_PHY=F_RAIN & ,F_RIMEF_PHY=F_RIMEF & ,QC=QC,QR=QR,QS=QI & ,RAINNC=rainnc,RAINNCV=rainncv & ,threads=threads & - ,IMS=IMS,IME=IME,JMS=JMS,JME=JME,LM=LM & + ,IMS=IMS,IME=IME,LM=LM & ,D_SS=d_ss & ,refl_10cm=refl_10cm,DX1=DX1) @@ -336,17 +299,15 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !....................................................................... !MZ* -!Aligo Oct-23-2019 +!Aligo Oct-23-2019 ! - Convert dry qc,qr,qi back to wet mixing ratio -! DO K = 1, LM -! DO I= IMS, IME -! qc_m(i,k) = qc(i,k)/(1.0_kind_phys+q(i,k)) -! qi_m(i,k) = qi(i,k)/(1.0_kind_phys+q(i,k)) -! qr_m(i,k) = qr(i,k)/(1.0_kind_phys+q(i,k)) -! ENDDO -! ENDDO - - + DO K = 1, LM + DO I= IMS, IME + qc(i,k) = qc(i,k)/(1.0_kind_phys+q(i,k)) + qi(i,k) = qi(i,k)/(1.0_kind_phys+q(i,k)) + qr(i,k) = qr(i,k)/(1.0_kind_phys+q(i,k)) + ENDDO + ENDDO !----------------------------------------------------------- DO K=1,LM @@ -366,9 +327,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !*** UPDATE TEMPERATURE, SPECIFIC HUMIDITY, CLOUD WATER, AND HEATING. !----------------------------------------------------------------------- ! - TNEW=TH_PHY(I,K)*PI_PHY(I,K) - TRAIN(I,K)=TRAIN(I,K)+(TNEW-T(I,K))*RDTPHS - T(I,K)=TNEW + TRAIN(I,K)=TRAIN(I,K)+TRAIN_PHY(I,K) ENDDO ENDDO diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 96c3dd664..0d3f75c71 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -868,22 +868,24 @@ end subroutine progcld1 !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops !!\param mbot (IX,3), vertical indices for low, mid, hi cloud bases !!\param de_lgth (IX), clouds decorrelation length (km) -!>\section gen_progcld2 progcld2 General Algorithm +!>\section gen_progcld2 progcld2 General Algorithm for the F-A MP scheme !> @{ subroutine progcld2 & - & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, f_ice,f_rain,r_rime,flgmin, & - & IX, NLAY, NLP1, lmfshal, lmfdeep2, & + & ( plyr,plvl,tlyr,qlyr,qstl,rhly,tvly,clw, & ! --- inputs: + & xlat,xlon,slmsk,dz,delp, & + & ntrac, ntcw, ntiw, ntrw, & + & IX, NLAY, NLP1, & + & lmfshal, lmfdeep2, & & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! ! ! ! subprogram: progcld2 computes cloud related quantities using ! -! ferrier's prognostic cloud microphysics scheme. ! +! Thompson/WSM6 cloud microphysics scheme. ! ! ! ! abstract: this program computes cloud fractions from cloud ! -! condensates, calculates liquid/ice cloud droplet effective radius, ! +! condensates, ! ! and computes the low, mid, high, total and boundary layer cloud ! ! fractions and the vertical indices of low, mid, and high cloud ! ! top and base. the three vertical cloud domains are set up in the ! @@ -908,11 +910,6 @@ subroutine progcld2 & ! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! ! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! ! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! -! clw (IX,NLAY) : layer cloud condensate amount ! -! f_ice (IX,NLAY) : fraction of layer cloud ice (ferrier micro-phys) ! -! f_rain(IX,NLAY) : fraction of layer rain water (ferrier micro-phys) ! -! r_rime(IX,NLAY) : mass ratio of total ice to unrimed ice (>=1) ! -! flgmin(IX) : minimim large ice fraction ! ! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! ! range, otherwise see in-line comment ! ! xlon (IX) : grid longitude in radians (not used) ! @@ -921,6 +918,8 @@ subroutine progcld2 & ! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! ! IX : horizontal dimention ! ! NLAY,NLP1 : vertical layer/level dimensions ! +! lmfshal : logical - true for mass flux shallow convection ! +! lmfdeep2 : logical - true for mass flux deep convection ! ! ! ! output variables: ! ! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! @@ -929,9 +928,9 @@ subroutine progcld2 & ! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! ! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! ! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path (g/m**2) ! +! clouds(:,:,6) - layer rain drop water path not assigned ! ! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path (g/m**2) ! +! *** clouds(:,:,8) - layer snow flake water path not assigned ! ! clouds(:,:,9) - mean eff radius for snow flake (micron) ! ! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! @@ -939,7 +938,7 @@ subroutine progcld2 & ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! ! de_lgth(ix) : clouds decorrelation length (km) ! ! ! -! external module variables: ! +! module variables: ! ! ivflip : control flag of vertical index direction ! ! =0: index from toa to surface ! ! =1: index from surface to toa ! @@ -951,28 +950,24 @@ subroutine progcld2 & ! lcnorm : control flag for in-cld condensate ! ! =t: normalize cloud condensate ! ! =f: not normalize cloud condensate ! -! lnoprec : precip effect in radiation flag (ferrier scheme) ! -! =t: snow/rain has no impact on radiation ! -! =f: snow/rain has impact on radiation ! ! ! ! ==================== end of description ===================== ! ! implicit none -! --- constants - ! --- inputs integer, intent(in) :: IX, NLAY, NLP1 + integer, intent(in) :: ntrac, ntcw, ntiw, ntrw logical, intent(in) :: lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, clw, f_ice, f_rain, r_rime, & - & dz, delp + & tlyr, qlyr, qstl, rhly, tvly, delp, dz + + real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & & slmsk - real (kind=kind_phys), dimension(:), intent(in) :: flgmin ! --- outputs real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds @@ -984,15 +979,14 @@ subroutine progcld2 & ! --- local variables: real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clw2, & - & qcwat, qcice, qrain, fcice, frain, rrime, rsden, clwf + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 - integer :: i, k, id + integer :: i, k, id, nf ! --- constant values ! real (kind=kind_phys), parameter :: xrc3 = 200. @@ -1001,9 +995,15 @@ subroutine progcld2 & ! !===> ... begin here ! + do nf=1,nf_clds + do k=1,nlay + do i=1,ix + clouds(i,k,nf) = 0.0 + enddo + enddo + enddo ! clouds(:,:,:) = 0.0 -!> - Assign water/ice/rain/snow cloud properties for Ferrier scheme. do k = 1, NLAY do i = 1, IX cldtot(i,k) = 0.0 @@ -1012,39 +1012,23 @@ subroutine progcld2 & cip (i,k) = 0.0 crp (i,k) = 0.0 csp (i,k) = 0.0 - rew (i,k) = reliq_def ! default liq radius to 10 micron - rei (i,k) = reice_def ! default ice radius to 50 micron + rew (i,k) = reliq_def + rei (i,k) = reice_def rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = rsnow_def ! default snow radius to 250 micron - fcice (i,k) = max(0.0, min(1.0, f_ice(i,k))) - frain (i,k) = max(0.0, min(1.0, f_rain(i,k))) - rrime (i,k) = max(1.0, r_rime(i,k)) - tem2d (i,k) = tlyr(i,k) - con_t0c + res (i,k) = rsnow_def + clwf(i,k) = 0.0 enddo enddo ! - if ( lcrick ) then - do i = 1, IX - clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) - clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) - enddo - do k = 2, NLAY-1 - do i = 1, IX - clwf(i,K) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) - enddo - enddo - else - do k = 1, NLAY + + do k = 1, NLAY do i = 1, IX - clwf(i,k) = clw(i,k) + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) enddo - enddo - endif - -!> - Compute SFC/low/middle/high cloud top pressure for each cloud -!! domain for given latitude. -! - ptopc(k,i): top pressure of each cld domain (k=1-4 are sfc,l,m, -!! h; i=1,2 are low-lat (<45 degree) and pole regions) + enddo +!> - Find top pressure for each cloud domain for given latitude. +!! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; +!! i=1,2 are low-lat (<45 degree) and pole regions) do i =1, IX rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range @@ -1059,76 +1043,61 @@ subroutine progcld2 & enddo enddo -!> - Seperate cloud condensate into liquid, ice, and rain types, and -!! save the liquid+ice condensate in array clw2 for later calculation -!! of cloud fraction. +!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . do k = 1, NLAY - do i = 1, IX - if (tem2d(i,k) > -40.0) then - qcice(i,k) = clwf(i,k) * fcice(i,k) - tem1 = clwf(i,k) - qcice(i,k) - qrain(i,k) = tem1 * frain(i,k) - qcwat(i,k) = tem1 - qrain(i,k) - clw2 (i,k) = qcwat(i,k) + qcice(i,k) - else - qcice(i,k) = clwf(i,k) - qrain(i,k) = 0.0 - qcwat(i,k) = 0.0 - clw2 (i,k) = clwf(i,k) - endif - enddo + do i = 1, IX + cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) + cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) + crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) + csp(i,k) = 0.0 + enddo enddo -!> - Call module_microphysics::rsipath2(), in Ferrier's scheme, to -!! compute layer's cloud liquid, ice, rain, and snow water condensate -!! path and the partical effective radius for liquid droplet, rain drop, -!! and snow flake. - call rsipath2 & -! --- inputs: - & ( plyr, plvl, tlyr, qlyr, qcwat, qcice, qrain, rrime, & - & IX, NLAY, ivflip, flgmin, & -! --- outputs: - & cwp, cip, crp, csp, rew, rer, res, rsden & - & ) +!> - Compute cloud ice effective radii + + do k = 1, NLAY + do i = 1, IX + tem2 = tlyr(i,k) - con_ttp + if (cip(i,k) > 0.0) then + tem3 = gord * cip(i,k) * plyr(i,k) / (delp(i,k)*tvly(i,k)) - do k = 1, NLAY - do i = 1, IX - tem2d(i,k) = (con_g * plyr(i,k)) & - & / (con_rd* delp(i,k)) + if (tem2 < -50.0) then + rei(i,k) = (1250.0/9.917) * tem3 ** 0.109 + elseif (tem2 < -40.0) then + rei(i,k) = (1250.0/9.337) * tem3 ** 0.08 + elseif (tem2 < -30.0) then + rei(i,k) = (1250.0/9.208) * tem3 ** 0.055 + else + rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 + endif + rei(i,k) = max(10.0, min(rei(i,k), 150.0)) + endif enddo - enddo + enddo + !> - Calculate layer cloud fraction. - clwmin = 0.0e-6 + clwmin = 0.0 if (.not. lmfshal) then do k = 1, NLAY do i = 1, IX -! clwt = 1.0e-7 * (plyr(i,k)*0.001) -! clwt = 1.0e-6 * (plyr(i,k)*0.001) - clwt = 2.0e-6 * (plyr(i,k)*0.001) -! clwt = 5.0e-6 * (plyr(i,k)*0.001) -! clwt = 5.0e-6 + clwt = 1.0e-6 * (plyr(i,k)*0.001) +! clwt = 2.0e-6 * (plyr(i,k)*0.001) + + if (clwf(i,k) > clwt) then - if (clw2(i,k) > clwt) then onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! tem1 = min(max(sqrt(onemrh*qstl(i,k)),0.0001),1.0) -! tem1 = 100.0 / tem1 - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) tem1 = 2000.0 / tem1 -! tem1 = 2400.0 / tem1 -!cnt tem1 = 2500.0 / tem1 -! tem1 = min(max(sqrt(onemrh*qstl(i,k)),0.0001),1.0) -! tem1 = 2000.0 / tem1 + ! tem1 = 1000.0 / tem1 -! tem1 = 100.0 / tem1 - value = max( min( tem1*(clw2(i,k)-clwm), 50.0 ), 0.0 ) + value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) tem2 = sqrt( sqrt(rhly(i,k)) ) cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) @@ -1138,21 +1107,21 @@ subroutine progcld2 & else do k = 1, NLAY do i = 1, IX -! clwt = 1.0e-6 * (plyr(i,k)*0.001) - clwt = 2.0e-6 * (plyr(i,k)*0.001) + clwt = 1.0e-6 * (plyr(i,k)*0.001) +! clwt = 2.0e-6 * (plyr(i,k)*0.001) - if (clw2(i,k) > clwt) then + if (clwf(i,k) > clwt) then onemrh= max( 1.e-10, 1.0-rhly(i,k) ) clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) ! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan + tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan if (lmfdeep2) then tem1 = xrc3 / tem1 else tem1 = 100.0 / tem1 endif ! - value = max( min( tem1*(clw2(i,k)-clwm), 50.0 ), 0.0 ) + value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) tem2 = sqrt( sqrt(rhly(i,k)) ) cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) @@ -1173,16 +1142,6 @@ subroutine progcld2 & enddo enddo -!> - When lnoprec = .true. snow/rain has no impact on radiation. - if ( lnoprec ) then - do k = 1, NLAY - do i = 1, IX - crp(i,k) = 0.0 - csp(i,k) = 0.0 - enddo - enddo - endif -! if ( lcnorm ) then do k = 1, NLAY do i = 1, IX @@ -1197,38 +1156,6 @@ subroutine progcld2 & enddo endif -!> - Calculate effective ice cloud droplet radius following Heymsfield and McFarquhar (1996) -!! \cite heymsfield_and_mcfarquhar_1996 . - - do k = 1, NLAY - do i = 1, IX - tem1 = tlyr(i,k) - con_ttp - tem2 = cip(i,k) - - if (tem2 > 0.0) then - tem3 = tem2d(i,k) * tem2 / tvly(i,k) - - if (tem1 < -50.0) then - rei(i,k) = (1250.0/9.917) * tem3 ** 0.109 - elseif (tem1 < -40.0) then - rei(i,k) = (1250.0/9.337) * tem3 ** 0.08 - elseif (tem1 < -30.0) then - rei(i,k) = (1250.0/9.208) * tem3 ** 0.055 - else - rei(i,k) = (1250.0/9.387) * tem3 ** 0.031 - endif - -! if (lprnt .and. k == l) print *,' reiL=',rei(i,k),' icec=', & -! & icec,' cip=',cip(i,k),' tem=',tem,' delt=',delt - - rei(i,k) = max(10.0, min(rei(i,k), 300.0)) -! rei(i,k) = max(20.0, min(rei(i,k), 300.0)) -!!!! rei(i,k) = max(30.0, min(rei(i,k), 300.0)) -! rei(i,k) = max(50.0, min(rei(i,k), 300.0)) -! rei(i,k) = max(100.0, min(rei(i,k), 300.0)) - endif - enddo - enddo ! do k = 1, NLAY do i = 1, IX @@ -1237,10 +1164,9 @@ subroutine progcld2 & clouds(i,k,3) = rew(i,k) clouds(i,k,4) = cip(i,k) clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) + clouds(i,k,6) = crp(i,k) ! added for Thompson clouds(i,k,7) = rer(i,k) -! clouds(i,k,8) = csp(i,k) !ncar scheme - clouds(i,k,8) = csp(i,k) * rsden(i,k) !fu's scheme + clouds(i,k,8) = csp(i,k) ! added for Thompson clouds(i,k,9) = res(i,k) enddo enddo @@ -1254,9 +1180,11 @@ subroutine progcld2 & enddo endif -!> - Call gethml(), to compute low, mid, high, total, and boundary -!! layer cloud fractions and clouds top/bottom layer indices for low, -!! mid, and high clouds. +!> - Call gethml() to compute low,mid,high,total, and boundary layer +!! cloud fractions and clouds top/bottom layer indices for low, mid, +!! and high clouds. +! --- compute low, mid, high, total, and boundary layer cloud fractions +! and clouds top/bottom layer indices for low, mid, and high clouds. ! The three cloud domain boundaries are defined by ptopc. The cloud ! overlapping method is defined by control flag 'iovr', which may ! be different for lw and sw radiation programs. @@ -1274,6 +1202,8 @@ subroutine progcld2 & return !................................... end subroutine progcld2 +!................................... + !> @} !----------------------------------- From cb2d558dcc2fbd984a82569edcfe04b749bebeb8 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 30 Apr 2020 09:48:20 -0600 Subject: [PATCH 023/274] fix unitialized parameter and dimensions in FA --- physics/GFS_rrtmg_pre.F90 | 8 ++++++-- physics/module_MP_FER_HIRES.F90 | 8 +++++++- physics/mp_fer_hires.F90 | 4 ++++ physics/radiation_clouds.f | 9 ++++----- 4 files changed, 21 insertions(+), 8 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 8acb24a50..af2cb0093 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -566,7 +566,11 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water ccnd(i,k,2) = tracer1(i,k,ntiw) ! ice water ccnd(i,k,3) = tracer1(i,k,ntrw) ! rain water - ccnd(i,k,4) = tracer1(i,k,ntsw) + tracer1(i,k,ntgl) ! snow + grapuel + if (Model%imp_physics == 15 ) then + ccnd(i,k,4) = 0.0 + else + ccnd(i,k,4) = tracer1(i,k,ntsw) + tracer1(i,k,ntgl) ! snow + grapuel + endif enddo enddo endif @@ -859,7 +863,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input call progcld5 (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,tracer1, & ! --- inputs Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & - ntsw-1,ntgl-1, & +!mz ntsw-1,ntgl-1, & im, lmk, lmp, Model%icloud,Model%uni_cld, & Model%lmfshal,Model%lmfdeep2, & cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index f45ffa04f..c758f7951 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -289,7 +289,7 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & REAL, DIMENSION(ims:ime):: APREC,PREC,ACPREC INTEGER :: I,K,KK - REAL :: wc + REAL :: wc, RDIS, BETA6 !------------------------------------------------------------------------ ! For subroutine EGCP01COLUMN_hr !----------------------------------------------------------------------- @@ -331,6 +331,12 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & ! !-- See comments in subroutine etanewhr_init starting with variable RDIS= ! +!-- Relative dispersion == standard deviation of droplet spectrum / mean radius +! (see pp 1542-1543, Liu & Daum, JAS, 2004) + RDIS=0.5 !-- relative dispersion of droplet spectrum + BETA6=( (1.+3.*RDIS*RDIS)*(1.+4.*RDIS*RDIS)*(1.+5.*RDIS*RDIS)/ & + & ((1.+RDIS*RDIS)*(1.+2.*RDIS*RDIS) ) ) + BRAUT=DT*1.1E10*BETA6/NCW !! END OF adding, 2015-03-30 diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index 19cfa117a..4935d8aa6 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -274,10 +274,14 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !--------------------------------------------------------------------- !aligo + DO K = 1, LM + DO I= IMS, IME cwm(i,k) = cwm(i,k)/(1.0_kind_phys-q(i,k)) qr(i,k) = qr(i,k)/(1.0_kind_phys-q(i,k)) qi(i,k) = qi(i,k)/(1.0_kind_phys-q(i,k)) qc(i,k) = qc(i,k)/(1.0_kind_phys-q(i,k)) + ENDDO + ENDDO !aligo !--------------------------------------------------------------------- diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 0d3f75c71..65f483821 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -2275,7 +2275,7 @@ end subroutine progcld4o subroutine progcld5 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw, & ! --- inputs: & xlat,xlon,slmsk,dz,delp, & - & ntrac,ntcw,ntiw,ntrw,ntsw,ntgl, & + & ntrac,ntcw,ntiw,ntrw, & & IX, NLAY, NLP1, icloud, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & @@ -2364,7 +2364,7 @@ subroutine progcld5 & ! --- inputs integer, intent(in) :: IX, NLAY, NLP1, ICLOUD - integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl + integer, intent(in) :: ntrac, ntcw, ntiw, ntrw logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 @@ -2452,7 +2452,7 @@ subroutine progcld5 & do k = 1, NLAY do i = 1, IX - clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) enddo enddo !> - Find top pressure for each cloud domain for given latitude. @@ -2479,8 +2479,7 @@ subroutine progcld5 & cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) - csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * & - & gfac * delp(i,k)) + csp(i,k) = 0.0 enddo enddo From b084396e1fe3947f26b3903029ff28253620e996 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 30 Apr 2020 12:20:25 -0600 Subject: [PATCH 024/274] fix unitialized parameters in samfdeepcnv --- physics/samfdeepcnv.f | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index f64a0b332..d067d7187 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -201,7 +201,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & c physical parameters ! parameter(asolfac=0.89) !HWRF ! parameter(grav=grav) -! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) +! parameter(elocp=hvap/cp,el2orc=hvap*hvap/(rv*cp)) ! parameter(c0s=.002,c1=.002,d0=.01) ! parameter(d0=.01) parameter(d0=.001) @@ -215,7 +215,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & ! as Nccn=100 for sea and Nccn=1000 for land ! parameter(cm=1.0) -! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) +! parameter(fact1=(cvap-cliq)/rv,fact2=hvap/rv-fact1*t0c) parameter(clamd=0.03,tkemx=0.65,tkemn=0.05) parameter(dtke=tkemx-tkemn) parameter(dbeta=0.1) @@ -276,13 +276,13 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & errflg = 0 - if(.not. hwrf_samfdeep) then elocp = hvap/cp el2orc = hvap*hvap/(rv*cp) fact1 = (cvap-cliq)/rv fact2 = hvap/rv-fact1*t0c ! + if(.not. hwrf_samfdeep) then c----------------------------------------------------------------------- !> ## Determine whether to perform aerosol transport do_aerosols = (itc > 0) .and. (ntc > 0) .and. (ntr > 0) From d35fad0f27a7cd3b38e49351ba9d1d3f8e10bbff Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 30 Apr 2020 15:42:18 -0600 Subject: [PATCH 025/274] bug fix in HWRF RRTMG --- physics/radlw_main.F90 | 11 +++++++---- physics/radsw_main.F90 | 4 ++-- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index 4ee7ca22b..f5278ed33 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -670,7 +670,7 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(nlay,nbands) :: htrb real (kind=kind_phys), dimension(nbands,nlay) :: taucld, tauaer - real (kind=kind_phys), dimension(nbands,1,nlay) :: taucld3 + real (kind=kind_phys), dimension(nbands,npts,nlay) :: taucld3 real (kind=kind_phys), dimension(ngptlw,nlay) :: fracs, tautot real (kind=kind_phys), dimension(nlay,ngptlw) :: fracs_r !mz rtrnmc_mcica @@ -1175,7 +1175,7 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & nlay, nlp1, ipseed(iplon), dz, delgth, & + & nlay, nlp1, ipseed(iplon), dz, delgth,iovrlw, & ! --- outputs: & cldfmc, taucld & & ) @@ -1668,7 +1668,7 @@ end subroutine rlwinit !> @{ subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & nlay, nlp1, ipseed, dz, de_lgth, & + & nlay, nlp1, ipseed, dz, de_lgth, iovrlw, & & cldfmc, taucld & ! --- outputs & ) @@ -1768,7 +1768,7 @@ subroutine cldprop & use module_radlw_cldprlw ! --- inputs: - integer, intent(in) :: nlay, nlp1, ipseed + integer, intent(in) :: nlay, nlp1, ipseed, iovrlw real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & @@ -1946,6 +1946,8 @@ subroutine cldprop & ! --- ... call sub-column cloud generator +!mz* + if (iovrlw .ne. 4) then call mcica_subcol & ! --- inputs: & ( cldf, nlay, ipseed, dz, de_lgth, & @@ -1962,6 +1964,7 @@ subroutine cldprop & endif enddo enddo + endif !iovrlw endif ! end if_isubclw_block diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index 924d750b1..321414976 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -720,9 +720,9 @@ subroutine rrtmg_sw_run & ! --- locals: !mz* HWRF -- input of mcica_subcol_sw - real(kind=kind_phys),dimension(1,nlay) :: hgt + real(kind=kind_phys),dimension(npts,nlay) :: hgt real(kind=kind_phys) :: dzsum - real(kind=kind_phys),dimension( nbdsw, 1, nlay ) :: taucld3, & + real(kind=kind_phys),dimension( nbdsw, npts, nlay ) :: taucld3, & ssacld3, & asmcld3, & fsfcld3 From ef386967e9cab4a672be603f52a51704f538d226 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Fri, 8 May 2020 10:59:14 -0600 Subject: [PATCH 026/274] add force_read_ferhires capability in FA --- physics/module_MP_FER_HIRES.F90 | 148 ++++++++++++++++++++++---------- physics/mp_fer_hires.F90 | 28 ++++-- physics/mp_fer_hires.meta | 18 ++++ 3 files changed, 145 insertions(+), 49 deletions(-) diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index c758f7951..776898f93 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -148,23 +148,23 @@ MODULE MODULE_MP_FER_HIRES INTEGER, PRIVATE,PARAMETER :: MY_T1=1, MY_T2=35 REAL,PRIVATE,DIMENSION(MY_T1:MY_T2),SAVE :: MY_GROWTH_NMM ! - REAL, PRIVATE,PARAMETER :: DMImin=.05e-3, DMImax=1.e-3, & + REAL, PRIVATE,PARAMETER :: DMImin=.05e-3, DMImax=1.e-3, & & DelDMI=1.e-6,XMImin=1.e6*DMImin REAL, PUBLIC,PARAMETER :: XMImax=1.e6*DMImax, XMIexp=.0536 INTEGER, PUBLIC,PARAMETER :: MDImin=XMImin, MDImax=XMImax - REAL, PRIVATE,DIMENSION(MDImin:MDImax) :: & + REAL, ALLOCATABLE, DIMENSION(:) :: & & ACCRI,VSNOWI,VENTI1,VENTI2 REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: SDENS !-- For RRTM ! - REAL, PRIVATE,PARAMETER :: DMRmin=.05e-3, DMRmax=1.0e-3, & + REAL, PRIVATE,PARAMETER :: DMRmin=.05e-3, DMRmax=1.0e-3, & & DelDMR=1.e-6, XMRmin=1.e6*DMRmin, XMRmax=1.e6*DMRmax INTEGER, PUBLIC,PARAMETER :: MDRmin=XMRmin, MDRmax=XMRmax ! - REAL, PRIVATE,DIMENSION(MDRmin:MDRmax):: & + REAL, ALLOCATABLE, DIMENSION(:):: & & ACCRR,MASSR,RRATE,VRAIN,VENTR1,VENTR2 ! INTEGER, PRIVATE,PARAMETER :: Nrime=40 - REAL, DIMENSION(2:9,0:Nrime),PRIVATE,SAVE :: VEL_RF + REAL, ALLOCATABLE, DIMENSION(:,:) :: VEL_RF ! INTEGER,PARAMETER :: NX=7501 REAL, PARAMETER :: XMIN=180.0,XMAX=330.0 @@ -226,7 +226,7 @@ MODULE MODULE_MP_FER_HIRES !HWRF & ,NCW=300.E6 !- 100.e6 (maritime), 500.e6 (continental) !--- Other public variables passed to other routines: - REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: MASSI + REAL, ALLOCATABLE ,DIMENSION(:) :: MASSI ! CONTAINS @@ -449,8 +449,9 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !GFDL => New. Added RHC_col to allow for height- and grid-dependent values for !GFDL the relative humidity threshold for condensation ("RHgrd") !6/11/2010 mod - Use lower RHgrd_out threshold for < 850 hPa +!mz 05/06/2020 - 10km !------------------------------------------------------------ - IF(DX1 .GE. 10 .AND. P_col(L) \section arg_table_mp_fer_hires_finalize Argument Table !! - subroutine mp_fer_hires_finalize () + subroutine mp_fer_hires_finalize (errmsg,errflg) + implicit none + + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + call ferhires_finalize() + + is_initialized = .false. + + end subroutine mp_fer_hires_finalize end module mp_fer_hires diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index a7a33378a..1782aecf6 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -130,6 +130,24 @@ [ccpp-arg-table] name = mp_fer_hires_finalize type = scheme + +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F ######################################################################## [ccpp-arg-table] name = mp_fer_hires_run From 4233a040a54159e129549afe964cb035057481c9 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 13 May 2020 14:13:57 -0600 Subject: [PATCH 027/274] addition of HWRF Noah LSM and GFDL surface layer; for HWRF Noah LSM 1) edit CMakeLists.txt to remove inoperative set_source_file_properties statement 2) edit GFS_surface_generic.F90 to handle ivegsrc=3,4,5 3) edit sfc_drv.f, sfc_drv_ruc.F90, sfc_noahmp_drv.F to check for valid ivegsrc, isot 4) add Noah working routines module_sf_noahlsm.F90 and module_sf_noahlsm_glacial_only.F90 5) add CCPP-compliant sfc_noah_wrfv4 scheme and associated interstitials; for GFDL surface layer 1) add module_sf_exchcoef.f90 for internal subroutines and 2) gfdl_sfc_layer as CCPP-compliant GFDL surface layer scheme --- CMakeLists.txt | 26 - physics/GFS_surface_generic.F90 | 8 +- physics/gfdl_sfc_layer.F90 | 1779 ++++++++ physics/gfdl_sfc_layer.meta | 801 ++++ physics/module_sf_exchcoef.f90 | 733 +++ physics/module_sf_noahlsm.F90 | 4773 ++++++++++++++++++++ physics/module_sf_noahlsm_glacial_only.F90 | 1285 ++++++ physics/sfc_drv.f | 15 +- physics/sfc_drv_ruc.F90 | 11 + physics/sfc_noah_wrfv4.F90 | 261 ++ physics/sfc_noah_wrfv4.meta | 764 ++++ physics/sfc_noah_wrfv4_interstitial.F90 | 758 ++++ physics/sfc_noah_wrfv4_interstitial.meta | 1098 +++++ physics/sfc_noahmp_drv.f | 13 + 14 files changed, 12296 insertions(+), 29 deletions(-) create mode 100644 physics/gfdl_sfc_layer.F90 create mode 100644 physics/gfdl_sfc_layer.meta create mode 100755 physics/module_sf_exchcoef.f90 create mode 100644 physics/module_sf_noahlsm.F90 create mode 100644 physics/module_sf_noahlsm_glacial_only.F90 create mode 100644 physics/sfc_noah_wrfv4.F90 create mode 100644 physics/sfc_noah_wrfv4.meta create mode 100644 physics/sfc_noah_wrfv4_interstitial.F90 create mode 100644 physics/sfc_noah_wrfv4_interstitial.meta diff --git a/CMakeLists.txt b/CMakeLists.txt index b8d3c3e18..e3560f502 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -174,32 +174,6 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") # Adjust settings for bit-for-bit reproducibility of NEMSfv3gfs if (PROJECT STREQUAL "CCPP-FV3") - SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f - ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f - ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f - ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F - ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F - ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F - ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f - ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_deep.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_sh.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bl_mynn.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNPBL_wrapper.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNSFC_wrapper.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_pre.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_post.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 - ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 - PROPERTIES COMPILE_FLAGS "-r8 -ftz") - # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files set(CMAKE_Fortran_FLAGS_LOPT1 ${CMAKE_Fortran_FLAGS_OPT}) string(REPLACE "-xHOST" "-xCORE-AVX-I" diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index ac366ae54..d6f751cc7 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -148,10 +148,14 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, else soiltyp(i) = 9 endif - if (ivegsrc == 1) then + if (ivegsrc == 0 .or. ivegsrc == 4) then + vegtype(i) = 24 + elseif (ivegsrc == 1) then vegtype(i) = 15 - elseif(ivegsrc == 2) then + elseif (ivegsrc == 2) then vegtype(i) = 13 + elseif (ivegsrc == 3 .or. ivegsrc == 5) then + vegtype(i) = 15 endif slopetyp(i) = 9 else diff --git a/physics/gfdl_sfc_layer.F90 b/physics/gfdl_sfc_layer.F90 new file mode 100644 index 000000000..edd3f0c30 --- /dev/null +++ b/physics/gfdl_sfc_layer.F90 @@ -0,0 +1,1779 @@ +!> \file gfdl_sfc_layer.f +!! This file contains ... + +!> This module contains the CCPP-compliant GFDL surface layer scheme. + module gfdl_sfc_layer + + use machine , only : kind_phys + + implicit none + + public :: gfdl_sfc_layer_init, gfdl_sfc_layer_run, gfdl_sfc_layer_finalize + + private + + contains + +!> \section arg_table_gfdl_sfc_layer_init Argument Table +!! \htmlinclude gfdl_sfc_layer_init.html +!! + subroutine gfdl_sfc_layer_init (icoef_sf, cplwav, cplwav2atm, lcurr_sf, & + pert_cd, ntsflg, errmsg, errflg) + + implicit none + + integer, intent(in) :: icoef_sf, ntsflg + logical, intent(in) :: cplwav, cplwav2atm, lcurr_sf, pert_cd + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +#if HWRF==1 + write(errmsg,'(*(a))') 'The GFDL surface layer scheme does not support '& + //'use of the HWRF preprocessor flag in gfdl_sfc_layer.F90' + errflg = 1 + return +#endif + + if (icoef_sf < 0 .or. icoef_sf > 8) then + write(errmsg,'(*(a))') 'The value of icoef_sf is outside of the ' & + //'supported range (0-8) in gfdl_sfc_layer.F90' + errflg = 1 + return + end if + + if (cplwav .or. cplwav2atm) then + write(errmsg,'(*(a))') 'The GFDL surface layer scheme is not set up ' & + //'to be coupled to waves in gfdl_sfc_layer.F90' + errflg = 1 + return + end if + + if (lcurr_sf) then + write(errmsg,'(*(a))') 'The GFDL surface layer scheme is not set up ' & + //'to be used with the lcurr_sf option in gfdl_sfc_layer.F90' + errflg = 1 + return + end if + + if (pert_cd) then + write(errmsg,'(*(a))') 'The GFDL surface layer scheme is not set up ' & + //'to be used with the pert_cd option in gfdl_sfc_layer.F90' + errflg = 1 + return + end if + + if (ntsflg > 0) then + !GJF: In order to enable ntsflg > 0, the variable 'tstrc' passed into MFLUX2 should be set + ! to the surface_skin_temperature_over_X_interstitial rather than the average of it and + ! surface_skin_temperature_after_iteration_over_X + write(errmsg,'(*(a))') 'Setting ntsflg > 0 is currently not supported'& + //' in gfdl_sfc_layer.F90' + errflg = 1 + return + end if + + !GJF: Initialization notes: In WRF, the subroutine module_sf_myjsfc/myjsfcinit + ! is called for initialization of the GFDL surface layer scheme from + ! the module_physics_init subroutine. It contains the following + ! initializations which should already have been done by other + ! code in UFS-related host models: + ! IF(.NOT.RESTART)THEN + ! DO J=JTS,JTE + ! DO I=ITS,ITF + ! USTAR(I,J)=0.1 + ! ENDDO + ! ENDDO + ! ENDIF + !also initialize surface roughness length + + end subroutine gfdl_sfc_layer_init + + subroutine gfdl_sfc_layer_finalize () + end subroutine gfdl_sfc_layer_finalize + +!> \section arg_table_gfdl_sfc_layer_run Argument Table +!! \htmlinclude gfdl_sfc_layer_run.html +!! + subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & + lsm_noah, lsm_noahmp, lsm_ruc, lsm_noah_wrfv4, icoef_sf, cplwav, & + cplwav2atm, lcurr_sf, pert_Cd, ntsflg, sfenth, z1, shdmax, ivegsrc, & + vegtype, sigmaf, dt, wet, dry, icy, isltyp, rd, grav, ep1, ep2, smois, & + psfc, prsl1, q1, t1, u1, v1, u10, v10, gsw, glw, tsurf_ocn, tsurf_lnd, & + tsurf_ice, tskin_ocn, tskin_lnd, tskin_ice, ustar_ocn, ustar_lnd, & + ustar_ice, znt_ocn, znt_lnd, znt_ice, cdm_ocn, cdm_lnd, cdm_ice, & + stress_ocn, stress_lnd, stress_ice, rib_ocn, rib_lnd, rib_ice, fm_ocn, & + fm_lnd, fm_ice, fh_ocn, fh_lnd, fh_ice, fh2_ocn, fh2_lnd, fh2_ice, & + ch_ocn, ch_lnd, ch_ice, fm10_ocn, fm10_lnd, fm10_ice, qss_ocn, qss_lnd, & + qss_ice, errmsg, errflg) + + use funcphys, only: fpvs + + !#### GJF: temporarily grab parameters from LSM-specific modules -- should go through CCPP #### + ! (fixing this involves replacing the functionality of set_soilveg and namelist_soilveg) + use namelist_soilveg, only: maxsmc_noah => maxsmc, drysmc_noah => drysmc + use namelist_soilveg_ruc, only: maxsmc_ruc => maxsmc, drysmc_ruc => drysmc + use noahmp_tables, only: maxsmc_noahmp => smcmax_table, drysmc_noahmp => smcdry_table + use module_sf_noahlsm, only: maxsmc_noah_wrfv4 => maxsmc, drysmc_noah_wrfv4 => drysmc + !################################################################################################ + + implicit none + + integer, intent(in) :: im, nsoil, km, ivegsrc + integer, intent(in) :: lsm, lsm_noah, lsm_noahmp, & + lsm_ruc, lsm_noah_wrfv4, icoef_sf,& + ntsflg + logical, intent(in) :: cplwav, cplwav2atm !GJF: this scheme has not been tested with these on + logical, intent(in) :: lcurr_sf !GJF: this scheme has not been tested with this option turned on; the variables scurx and scury need to be input in order to use this + logical, intent(in) :: pert_Cd !GJF: this scheme has not been tested with this option turned on; the variables ens_random_seed and ens_Cdamp need to be input in order to use this + logical, dimension(im), intent(in) :: flag_iter, wet, dry, icy + integer, dimension(im), intent(in) :: isltyp, vegtype + real(kind=kind_phys), intent(in) :: dt, sfenth + real(kind=kind_phys), intent(in) :: rd,grav,ep1,ep2 + real(kind=kind_phys), dimension(im,nsoil), intent(in) :: smois + real(kind=kind_phys), dimension(im), intent(in) :: psfc, prsl1, & + q1, t1, u1, v1, u10, v10, gsw, glw, z1, shdmax, sigmaf, xlat, xlon, & + tsurf_ocn, tsurf_lnd, tsurf_ice + + real(kind=kind_phys), intent(inout), dimension(im) :: tskin_ocn, & + tskin_lnd, tskin_ice, ustar_ocn, ustar_lnd, ustar_ice, & + znt_ocn, znt_lnd, znt_ice, cdm_ocn, cdm_lnd, cdm_ice, & + stress_ocn, stress_lnd, stress_ice, rib_ocn, rib_lnd, rib_ice, & + fm_ocn, fm_lnd, fm_ice, fh_ocn, fh_lnd, fh_ice, fh2_ocn, fh2_lnd, & + fh2_ice, ch_ocn, ch_lnd, ch_ice, fm10_ocn, fm10_lnd, fm10_ice, & + qss_ocn, qss_lnd, qss_ice + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !local variables + + integer :: i, its, ite, ims, ime + + !GJF: the vonKarman constant should come in through the CCPP and be defined by the host model + real (kind=kind_phys), parameter :: karman = 0.4 + real (kind=kind_phys), parameter :: log01=log(0.01), log05=log(0.05), & + log07=log(0.07) + + !GJF: if the following variables will be used, they should be turned into intent(in) namelist options + integer :: iwavecpl, ens_random_seed, issflx + logical :: diag_wind10m, diag_qss + real(kind=kind_phys) :: ens_Cdamp + + real(kind=kind_phys), dimension(im) :: wetc, pspc, pkmax, tstrc, upc, & + vpc, mznt, slwdc, wspd, wind10, qfx, qgh, zkmax, z1_cm, z0max, ztmax + real(kind=kind_phys), dimension(im) :: u10_lnd, u10_ocn, u10_ice, & + v10_lnd, v10_ocn, v10_ice + + !GJF: the following variables are identified as: + !"SCURX" "Surface Currents(X)" "m s-1" + !"SCURY" "Surface Currents(Y)" "m s-1 + !"CHARN" "Charnock Coeff" " " + !"MSANG" "Wind/Stress Angle" "Radian" + real(kind=kind_phys), dimension(im) :: charn, msang, scurx, scury + + real(kind=kind_phys), dimension(im) :: fxh, fxe, fxmx, fxmy, xxfh, & + xxfh2, tzot + real(kind=kind_phys), dimension(1:30) :: maxsmc, drysmc + real(kind=kind_phys) :: smcmax, smcdry, zhalf, cd10, & + esat, fm_lnd_old, fh_lnd_old, tem1, tem2, czilc, cdlimit + + !#### This block will become unnecessary when maxsmc and drysmc come through the CCPP #### + if (lsm == lsm_noah) then + maxsmc = maxsmc_noah + drysmc = drysmc_noah + else if (lsm == lsm_noahmp) then + maxsmc = maxsmc_noahmp + drysmc = drysmc_noahmp + else if (lsm == lsm_ruc) then + maxsmc = maxsmc_ruc + drysmc = drysmc_ruc + else if (lsm == lsm_noah_wrfv4) then + maxsmc = maxsmc_noah_wrfv4 + drysmc = drysmc_noah_wrfv4 + else + !GJF: These data were from the original GFDL surface layer scheme, but + ! rather than being hard-coded here, they should be shared with the + ! LSM. These data are kept for legacy purposes. Note that these only + ! have nonzero values for 16 soil types vs 19 for other STAS datasets + data maxsmc/0.339, 0.421, 0.434, 0.476, 0.476, 0.439, & + 0.404, 0.464, 0.465, 0.406, 0.468, 0.468, & + 0.439, 1.000, 0.200, 0.421, 0.000, 0.000, & + 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & + 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ + data drysmc/0.010, 0.028, 0.047, 0.084, 0.084, 0.066, & + 0.067, 0.120, 0.103, 0.100, 0.126, 0.138, & + 0.066, 0.000, 0.006, 0.028, 0.000, 0.000, & + 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & + 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ + end if + !######################################################################## + + !GJF: This code has not been tested with iwavecpl = 1; the variables 'charn' and 'msang' (and others?) need to be input in order to use this + ! if (cplwav .or. cplwav2atm) then + ! iwavecpl = 1 + ! else + ! iwavecpl = 0 + ! end if + iwavecpl = 0 + + !GJF: temporary setting of variables that should be moved to namelist is they are used + ens_random_seed = 0 !used for HWRF ensemble? + ens_Cdamp = 0.0 !used for HWRF ensemble? + + issflx = 0 !GJF: 1 = calculate surface fluxes, 0 = don't + diag_wind10m = .false. !GJF: if one wants 10m wind speeds to come from this scheme, set this to True, + ! put [u,v]10_[lnd/ocn/ice] in the scheme argument list (and metadata), and modify + ! GFS_surface_compsites to receive the individual components and calculate an all-grid value + diag_qss = .false. !GJF: saturation specific humidities are calculated by LSM, sea surface, and sea ice schemes in + ! GFS-based suites + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + its = 1 + ims = 1 + ite = im + ime = im + + do i=its, ite + if (flag_iter(i)) then + !GJF: Perform data preparation that is the same for all surface types + + pspc(i) = psfc(i)*10. ! convert from Pa to cgs + pkmax(i) = prsl1(i)*10. ! convert from Pa to cgs + + upc(i) = u1(i)*100. ! convert from m s-1 to cm s-1 + vpc(i) = v1(i)*100. ! convert from m s-1 to cm s-1 + + !GJF: wind speed at the lowest model layer is calculated in a scheme prior to this (if this scheme + ! is part of a GFS-based suite), but it is recalculated here because this one DOES NOT include + ! a convective wind enhancement component (convective gustiness factor) to follow the original + ! GFDL surface layer scheme; this may not be necessary + wspd(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) + wspd(i) = amax1(wspd(i),1.0) !wspd is in m s-1 + + !Wang: use previous u10 v10 to compute wind10, input to MFLUX2 to compute z0 (for first time step, u10 and v10 may be zero) + wind10(i)=sqrt(u10(i)*u10(i)+v10(i)*v10(i)) !m s-1 + + !Wang: calulate height of the first half level + ! if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then + ! zhalf = -rd*t1(i)*alog(pkmax(i)/pspc(i))/grav !m + ! endif + + !GJF: rather than calculate the height of the first half level, if it is precalculated + ! in a different scheme, pass it in and use it; note that in FV3, calculating via the hypsometric equation + ! occasionally produced values much shallower than those passed in + !zkmax(i) = -rd*t1(i)*alog(pkmax(i)/pspc(i))/grav !m + zkmax(i) = z1(i) + z1_cm(i) = 100.0*z1(i) + + !GJF: this drag coefficient lower limit was suggested by Chunxi Zhang via his module_sf_sfclayrev.f90 + cdlimit = 1.0e-5/zkmax(i) + + !slwdc... GFDL downward net flux in units of cal/(cm**2/min) + !also divide by 10**4 to convert from /m**2 to /cm**2 + slwdc(i)=gsw(i)+glw(i) + slwdc(i)=0.239*60.*slwdc(i)*1.e-4 + + !GJF: these variables should be passed in if these options are used + charn(i) = 0.0 !used with wave coupling (iwavecpl == 1) + msang(i) = 0.0 !used with wave coupling (iwavecpl == 1) + scurx(i) = 0.0 !used with ocean currents? (lcurr_sf == T) + scury(i) = 0.0 !used with ocean currents? (lcurr_sf == T) + + if (diag_qss) then + esat = fpvs(t1(i)) + qgh(i) = ep2*esat/(psfc(i)-esat) + end if + + !GJF: these vars are not needed in a GFS-based suite + !rho1(i)=prsl1(i)/(rd*t1(i)*(1.+ep1*q1(i))) + !cpm(i)=cp*(1.+0.8*q1(i)) + + !GJF: perform data preparation that depends on surface types and call the mflux2 subroutine for each surface type + ! Note that this is different than the original WRF module_sf_gfdl.F where mflux2 is called once for all surface + ! types, with negative roughness lengths denoting open ocean. + if (dry(i)) then + !GJF: from WRF's module_sf_gfdl.F + smcdry=drysmc(isltyp(i)) + smcmax=maxsmc(isltyp(i)) + wetc(i)=(smois(i,1)-smcdry)/(smcmax-smcdry) + wetc(i)=amin1(1.,amax1(wetc(i),0.)) + + !GJF: the lower boundary temperature passed in to MFLUX2 either follows GFS: + tstrc(i) = 0.5*(tskin_lnd(i) + tsurf_lnd(i)) !averaging tskin_lnd and tsurf_lnd as in GFS surface layer breaks ntsflg functionality + !GJF: or WRF module_sf_gfdl.F: + !tstrc(i) = tskin_lnd(i) + + !GJF: Roughness Length Limitation section + ! The WRF version of module_sf_gfdl.F has no checks on the roughness lengths prior to entering MFLUX2. + ! The following limits were placed on roughness lengths from the GFS surface layer scheme at the suggestion + ! of Chunxi Zhang. Using the GFDL surface layer without such checks can lead to instability in the UFS. + + !znt_lnd is in cm, z0max/ztmax are in m at this point + z0max(i) = max(1.0e-6, min(0.01 * znt_lnd(i), zkmax(i))) + + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 + + if( ivegsrc == 1 ) then + if (vegtype(i) == 10) then + z0max(i) = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype(i) == 6) then + z0max(i) = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype(i) == 7) then + ! z0max(i) = exp( tem2*log01 + tem1*log01 ) + z0max(i) = 0.01 + elseif (vegtype(i) == 16) then + ! z0max(i) = exp( tem2*log01 + tem1*log01 ) + z0max(i) = 0.01 + else + z0max(i) = exp( tem2*log01 + tem1*log(z0max(i)) ) + endif + elseif (ivegsrc == 2 ) then + if (vegtype(i) == 7) then + z0max(i) = exp( tem2*log01 + tem1*log07 ) + elseif (vegtype(i) == 8) then + z0max(i) = exp( tem2*log01 + tem1*log05 ) + elseif (vegtype(i) == 9) then + ! z0max(i) = exp( tem2*log01 + tem1*log01 ) + z0max(i) = 0.01 + elseif (vegtype(i) == 11) then + ! z0max(i) = exp( tem2*log01 + tem1*log01 ) + z0max(i) = 0.01 + else + z0max(i) = exp( tem2*log01 + tem1*log(z0max(i)) ) + endif + endif + + z0max(i) = max(z0max(i), 1.0e-6) + + ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil + czilc = 0.8 + + tem1 = 1.0 - sigmaf(i) + ztmax(i) = z0max(i)*exp( - tem1*tem1 & + & * czilc*karman*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) + ztmax(i) = max(ztmax(i), 1.0e-6) + + !GJF: from WRF's module_sf_gfdl.F + if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then + !GJF: why not use wspd(i) to save compute? + wind10(i)=sqrt(u1(i)*u1(i)+v1(i)*v1(i))*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) !m s-1 + end if + wind10(i)=wind10(i)*100.0 !convert from m/s to cm/s + + ztmax(i) = ztmax(i)*100.0 !convert from m to cm + z0max(i) = z0max(i)*100.0 !convert from m to cm + + call mflux2 (fxh(i), fxe(i), fxmx(i), fxmy(i), cdm_lnd(i), rib_lnd(i), & + xxfh(i), ztmax(i), z0max(i), tstrc(i), & + pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & + scurx(i), scury(i), pert_Cd, ens_random_seed, ens_Cdamp, upc(i), vpc(i), t1(i), q1(i), & + dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & + errflg) + if (errflg /= 0) return + + !GJF: this is broken when tstrc is set to an average of two variables + if (ntsflg==1) then + tskin_lnd(i) = tstrc(i) ! gopal's doing + end if + + if (diag_wind10m) then + u10_lnd(i) = u1(i)*(0.01*wind10(i)/wspd(i)) + v10_lnd(i) = v1(i)*(0.01*wind10(i)/wspd(i)) + end if + + !GJF: these variables are not needed in a GFS-based suite, but are found in WRF's module_sf_gfdl.F and kept in comments for legacy + !gz1oz0(i) = alog(zkmax(i)/(0.01*znt_lnd(i))) + !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling + !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling + + fm_lnd(i) = karman/sqrt(cdm_lnd(i)) + fh_lnd(i) = karman*xxfh(i) + + !GJF: Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih + !psim_lnd(i)=gz1oz0(i)-fm_lnd(i) + !psih_lnd(i)=gz1oz0(i)-fh_lnd(i) + + fh2_lnd(i) = karman*xxfh2(i) + ch_lnd(i) = karman*karman/(fm_lnd(i) * fh_lnd(i)) + + !GJF: these bounds on drag coefficients are from Chunxi Zhang's module_sf_sfclayrev.f90 + cdm_lnd(i) = max(cdm_lnd(i), cdlimit) + cdm_lnd(i) = min(cdm_lnd(i), 0.1) + ch_lnd(i) = max(ch_lnd(i), cdlimit) + ch_lnd(i) = min(ch_lnd(i), 0.1) + !GJF: this bound is from WRF's module_sf_gfdl.F (I'm not sure if both are needed or which is more restrictive.) + ch_lnd(i) = min(ch_lnd(i), 0.05/wspd(i)) + + !GJF: from WRF's module_sf_gfdl.F + ustar_lnd(i) = 0.01*sqrt(cdm_lnd(i)* & + (upc(i)*upc(i) + vpc(i)*vpc(i))) + !GJF: from Chunxi Zhang's module_sf_sfclayrev.f90 (I'm not sure it's necessary.) + ustar_lnd(i) = amax1(ustar_lnd(i),0.001) + + stress_lnd(i) = cdm_lnd(i)*wspd(i)*wspd(i) + + !GJF: from WRF's module_sf_gfdl.F + ! convert cd, ch to values at 10m, for output + cd10 = cdm_lnd(i) + if ( wind10(i) .ge. 0.1 ) then + cd10=cdm_lnd(i)* (wspd(i)/(0.01*wind10(i)) )**2 + !tmp9=0.01*abs(tzot(i)) + !ch_out(i)=ch_lnd(i)*(wspd(i)/(0.01*wind10(i)) ) * & + ! (alog(zkmax(i)/tmp9)/alog(10.0/tmp9)) + end if + fm10_lnd(i) = karman/sqrt(cd10) + + !GJF: conductances aren't used in other CCPP schemes, but this limit + ! might be able to replace the limits on drag coefficients above + + !chs_lnd(i)=ch_lnd(i)*wspd (i) !conductance + !chs2_lnd(i)=ustar_lnd(i)*karman/fh2_lnd(i) !2m conductance + + !!!2014-0922 cap CHS over land points + ! chs_lnd(i)=amin1(chs_lnd(i), 0.05) + ! chs2_lnd(i)=amin1(chs2_lnd(i), 0.05) + ! if (chs2_lnd(i) < 0) chs2_lnd(i)=1.0e-6 + + if (diag_qss) then + esat = fpvs(tskin_lnd(i)) + qss_lnd(i) = ep2*esat/(psfc(i)-esat) + end if + + !GJF: not used in CCPP + !flhc_lnd(i)=cpm(i)*rho1(i)*chs_lnd(i) + !flqc_lnd(i)=rho1(i)*chs_lnd(i) + !cqs2_lnd(i)=chs2_lnd(i) + end if !dry + + if (icy(i)) then + !GJF: from WRF's module_sf_gfdl.F + smcdry=drysmc(isltyp(i)) + smcmax=maxsmc(isltyp(i)) + wetc(i)=(smois(i,1)-smcdry)/(smcmax-smcdry) + wetc(i)=amin1(1.,amax1(wetc(i),0.)) + + + !GJF: the lower boundary temperature passed in to MFLUX2 either follows GFS: + tstrc(i) = 0.5*(tskin_ice(i) + tsurf_ice(i)) !averaging tskin_ice and tsurf_ice as in GFS surface layer breaks ntsflg functionality + !GJF: or WRF module_sf_gfdl.F: + !tstrc(i) = tskin_ice(i) + !averaging tskin_ice and tsurf_ice as in GFS surface layer breaks ntsflg functionality + + !GJF: Roughness Length Limitation section + ! The WRF version of module_sf_gfdl.F has no checks on the roughness lengths prior to entering MFLUX2. + ! The following limits were placed on roughness lengths from the GFS surface layer scheme at the suggestion + ! of Chunxi Zhang. Using the GFDL surface layer without such checks can lead to instability in the UFS. + + !znt_ice is in cm, z0max/ztmax are in m at this point + z0max(i) = max(1.0e-6, min(0.01 * znt_ice(i), zkmax(i))) + !** xubin's new z0 over land and sea ice + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 + + if( ivegsrc == 1 ) then + z0max(i) = exp( tem2*log01 + tem1*log(z0max(i)) ) + elseif (ivegsrc == 2 ) then + z0max(i) = exp( tem2*log01 + tem1*log(z0max(i)) ) + endif + + z0max(i) = max(z0max(i), 1.0e-6) + + ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height + ! dependance of czil + czilc = 0.8 + + tem1 = 1.0 - sigmaf(i) + ztmax(i) = z0max(i)*exp( - tem1*tem1 & + & * czilc*karman*sqrt(ustar_ice(i)*(0.01/1.5e-05))) + ztmax(i) = max(ztmax(i), 1.0e-6) + + + !GJF: from WRF's module_sf_gfdl.F + if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then + !GJF: why not use wspd(i) to save compute? + wind10(i)=sqrt(u1(i)*u1(i)+v1(i)*v1(i))*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) + end if + wind10(i)=wind10(i)*100.0 !! m/s to cm/s + + ztmax(i) = ztmax(i)*100.0 !m to cm + z0max(i) = z0max(i)*100.0 !m to cm + + call mflux2 (fxh(i), fxe(i), fxmx(i), fxmy(i), cdm_ice(i), rib_ice(i), & + xxfh(i), ztmax(i), z0max(i), tstrc(i), & + pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & + scurx(i), scury(i), pert_Cd, ens_random_seed, ens_Cdamp, upc(i), vpc(i), t1(i), q1(i), & + dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & + errflg) + if (errflg /= 0) return + + !GJF: this is broken when tstrc is set to an average of two variables + if (ntsflg==1) then + tskin_ice(i) = tstrc(i) ! gopal's doing + end if + + if (diag_wind10m) then + u10_ice(i) = u1(i)*(0.01*wind10(i)/wspd(i)) + v10_ice(i) = v1(i)*(0.01*wind10(i)/wspd(i)) + end if + + !GJF: these variables are not needed in a GFS-based suite, but are found in WRF's module_sf_gfdl.F and kept in comments for legacy + !gz1oz0(i) = alog(zkmax(i)/znt_ice(i)) + !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling + !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling + + fm_ice(i) = karman/sqrt(cdm_ice(i)) + fh_ice(i) = karman*xxfh(i) + + !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih + !psim_ice(i)=gz1oz0(i)-fm_ice(i) + !psih_ice(i)=gz1oz0(i)-fh_ice(i) + + fh2_ice(i) = karman*xxfh2(i) + ch_ice(i) = karman*karman/(fm_ice(i) * fh_ice(i)) + + !GJF: these bounds on drag coefficients are from Chunxi Zhang's module_sf_sfclayrev.f90 + cdm_ice(i) = max(cdm_ice(i), cdlimit) + cdm_ice(i) = min(cdm_ice(i), 0.1) + ch_ice(i) = max(ch_ice(i), cdlimit) + ch_ice(i) = min(ch_ice(i), 0.1) + !GJF: this bound is from WRF's module_sf_gfdl.F (I'm not sure if both are needed or which is more restrictive.) + ch_ice(i) = min(ch_ice(i), 0.05/wspd(i)) + + ustar_ice(i) = 0.01*sqrt(cdm_ice(i)* & + (upc(i)*upc(i) + vpc(i)*vpc(i))) + !GJF: from Chunxi Zhang's module_sf_sfclayrev.f90 (I'm not sure it's necessary.) + ustar_ice(i) = amax1(ustar_ice(i),0.001) + + stress_ice(i) = cdm_ice(i)*wspd(i)*wspd(i) + + !GJF: from WRF's module_sf_gfdl.F + !!! convert cd, ch to values at 10m, for output + cd10 = cdm_ice(i) + if ( wind10(i) .ge. 0.1 ) then + cd10=cdm_ice(i)* (wspd(i)/(0.01*wind10(i)) )**2 + !tmp9=0.01*abs(tzot(i)) + !ch_out(i)=ch_ice(i)*(wspd(i)/(0.01*wind10(i)) ) * & + ! (alog(zkmax(i)/tmp9)/alog(10.0/tmp9)) + end if + fm10_ice(i) = karman/sqrt(cd10) + + !GJF: conductances aren't used in other CCPP schemes + !chs_ice(i)=ch_ice(i)*wspd (i) !conductance + !chs2_ice(i)=ustar_ice(i)*karman/fh2_ice(i) !2m conductance + + if (diag_qss) then + esat = fpvs(tskin_ice(i)) + qss_ice(i) = ep2*esat/(psfc(i)-esat) + end if + + !flhc_ice(i)=cpm(i)*rho1(i)*chs_ice(i) + !flqc_ice(i)=rho1(i)*chs_ice(i) + !cqs2_ice(i)=chs2_ice(i) + end if !ice + + if (wet(i)) then + wetc(i) = 1.0 + + !GJF: the lower boundary temperature passed in to MFLUX2 either follows GFS: + tstrc(i) = 0.5*(tskin_ocn(i) + tsurf_ocn(i)) !averaging tskin_ocn and tsurf_ocn as in GFS surface layer breaks ntsflg functionality + !GJF: or WRF module_sf_gfdl.F: + !tstrc(i) = tskin_ocn(i) + + !GJF: from WRF's module_sf_gfdl.F + if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then + wind10(i)=sqrt(u1(i)*u1(i)+v1(i)*v1(i))*alog(10.0/(0.01*znt_ocn(i)))/alog(z1(i)/(0.01*znt_ocn(i))) + end if + wind10(i)=wind10(i)*100.0 !! m/s to cm/s + + !GJF: mflux2 expects negative roughness length for ocean points + znt_ocn(i) = -znt_ocn(i) + + call mflux2 (fxh(i), fxe(i), fxmx(i), fxmy(i), cdm_ocn(i), rib_ocn(i), & + xxfh(i), znt_ocn(i), mznt(i), tstrc(i), & + pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & + scurx(i), scury(i), pert_Cd, ens_random_seed, ens_Cdamp, upc(i), vpc(i), t1(i), q1(i), & + dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & + errflg) + if (errflg /= 0) return + + !GJF: this is broken when tstrc is set to an average of two variables + if (ntsflg==1) then + tskin_ocn(i) = tstrc(i) ! gopal's doing + end if + + znt_ocn(i)= abs(znt_ocn(i)) + mznt(i)= abs(mznt(i)) + + !GJF: these bounds on ocean roughness lengths are from Chunxi Zhang's module_sf_sfclayrev.f90 (in cm) + znt_ocn(i)=min(2.85e-1,max(znt_ocn(i),1.27e-5)) + + if (diag_wind10m) then + u10_ocn(i) = u1(i)*(0.01*wind10(i)/wspd(i)) + v10_ocn(i) = v1(i)*(0.01*wind10(i)/wspd(i)) + end if + + !GJF: these variables are not needed in a GFS-based suite, but are found in WRF's module_sf_gfdl.F and kept in comments for legacy + !gz1oz0(i) = alog(zkmax(i)/znt_ocn(i)) + !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling + !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling + + fm_ocn(i) = karman/sqrt(cdm_ocn(i)) + fh_ocn(i) = karman*xxfh(i) + + !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih + !psim_ocn(i)=gz1oz0(i)-fm_ocn(i) + !psih_ocn(i)=gz1oz0(i)-fh_ocn(i) + + fh2_ocn(i) = karman*xxfh2(i) + ch_ocn(i) = karman*karman/(fm_ocn(i) * fh_ocn(i)) + + !GJF: these bounds on drag coefficients are from Chunxi Zhang's module_sf_sfclayrev.f90 + cdm_ocn(i) = max(cdm_ocn(i), cdlimit) + cdm_ocn(i) = min(cdm_ocn(i), 0.1) + ch_ocn(i) = max(ch_ocn(i), cdlimit) + ch_ocn(i) = min(ch_ocn(i), 0.1) + !GJF: this bound is from WRF's module_sf_gfdl.F (I'm not sure if both are needed or which is more restrictive.) + ch_ocn(i) = min(ch_ocn(i), 0.05/wspd(i)) + + ustar_ocn(i) = 0.01*sqrt(cdm_ocn(i)* & + (upc(i)*upc(i) + vpc(i)*vpc(i))) + !GJF: from Chunxi Zhang's module_sf_sfclayrev.f90 (I'm not sure it's necessary.) + ustar_ocn(i) = amax1(ustar_ocn(i),0.001) + + stress_ocn(i) = cdm_ocn(i)*wspd(i)*wspd(i) + + !GJF: from WRF's module_sf_gfdl.F + !!! convert cd, ch to values at 10m, for output + cd10 = cdm_ocn(i) + if ( wind10(i) .ge. 0.1 ) then + cd10=cdm_ocn(i)* (wspd(i)/(0.01*wind10(i)) )**2 + !tmp9=0.01*abs(tzot(i)) + !ch_out(i)=ch_ocn(i)*(wspd(i)/(0.01*wind10(i)) ) * & + ! (alog(zkmax(i)/tmp9)/alog(10.0/tmp9)) + end if + fm10_ocn(i) = karman/sqrt(cd10) + + !GJF: conductances aren't used in other CCPP schemes + !chs_ocn(i)=ch_ocn(i)*wspd (i) !conductance + !chs2_ocn(i)=ustar_ocn(i)*karman/fh2_ocn(i) !2m conductance + + if (diag_qss) then + esat = fpvs(tskin_ocn(i)) + qss_ocn(i) = ep2*esat/(psfc(i)-esat) + end if + end if !wet + + !flhc_ocn(i)=cpm(i)*rho1(i)*chs_ocn(i) + !flqc_ocn(i)=rho1(i)*chs_ocn(i) + !cqs2_ocn(i)=chs2_ocn(i) + end if !flag_iter + end do + + !GJF: this code has not been updated since GFS suites don't require this; one would need to have different values of hfx, qfx, lh for each surface type + ! if (isfflx.eq.0) then + ! do i=its,ite + ! hfx(i)=0. + ! lh(i)=0. + ! qfx(i)=0. + ! enddo + ! else + ! do i=its,ite + ! if(islmsk == 0) then + ! !water + ! hfx(i)= -10.*cp*fxh(i) + ! else if (islmsk == 1) then + ! hfx(i)= -10.*cp*fxh(i) + ! hfx(i)=amax1(hfx(i),-250.) + ! end if + ! qfx(j)=-10.*fxe(i) + ! qfx(i)=amax1(qfx(i),0.) + ! lh(i)=xlv*qfx(i) + ! enddo + ! endif + + + end subroutine gfdl_sfc_layer_run + +!--------------------------------- +!GJF (2020/04/21): The starting point for the MFLUX2 subroutine here was module_sf_gfdl.F in WRF + SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !mzoc KWON + pspc,pkmax,wetc,slwdc,z1, & + icoef_sf,iwavecpl,lcurr_sf,alpha,gamma,xcur,ycur, & + pert_Cd, ens_random_seed, ens_Cdamp, & + upc,vpc,tpc,rpc,dt,wind10,xxfh2,ntsflg,sfenth, & + tzot, errmsg, errflg) + +!------------------------------------------------------------------------ +! +! MFLUX2 computes surface fluxes of momentum, heat,and moisture +! using monin-obukhov. the roughness length "z0" is prescribed +! over land and over ocean "z0" is computed using charnocks formula. +! the universal functions (from similarity theory approach) are +! those of hicks. This is Bob's doing. +! +!------------------------------------------------------------------------ + + USE module_sf_exchcoef + IMPLICIT NONE + +!----------------------------------------------------------------------- +! user interface variables +!----------------------------------------------------------------------- + !GJF: This subroutine was converted to expect data from a single point instead of a horizontal array to accommodate a fractional landmask + !integer,intent(in) :: ims,ime + !integer,intent(in) :: its,ite + integer, parameter :: ims = 1 + integer, parameter :: ime = 1 + integer, parameter :: its = 1 + integer, parameter :: ite = 1 + integer,intent(in) :: ntsflg + integer,intent(in) :: icoef_sf + integer,intent(in) :: iwavecpl + logical,intent(in) :: lcurr_sf + logical,intent(in) :: pert_Cd + integer,intent(in) :: ens_random_seed + real(kind=kind_phys),intent(in) :: ens_Cdamp + + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: fxh + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: fxe + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: fxmx + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: fxmy + real(kind=kind_phys), intent (inout), dimension (ims :ime ) :: cdm +! real, intent (out), dimension (ims :ime ) :: cdm2 + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: rib + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: xxfh + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: xxfh2 + real(kind=kind_phys), intent (out), dimension (ims :ime ) :: wind10 + + real(kind=kind_phys), intent ( inout), dimension (ims :ime ) :: zoc,mzoc !KWON + real(kind=kind_phys), intent ( inout), dimension (ims :ime ) :: tzot !WANG + real(kind=kind_phys), intent ( inout), dimension (ims :ime ) :: tstrc + + real(kind=kind_phys), intent ( in) :: dt + real(kind=kind_phys), intent ( in) :: sfenth + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: pspc + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: pkmax + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: wetc + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: slwdc + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: alpha, gamma + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: xcur, ycur + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: z1 + + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: upc + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: vpc + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: tpc + real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: rpc + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +!----------------------------------------------------------------------- +! internal variables +!----------------------------------------------------------------------- + + integer, parameter :: icntx = 30 + + integer, dimension(1 :ime) :: ifz + integer, dimension(1 :ime) :: indx + integer, dimension(1 :ime) :: istb + integer, dimension(1 :ime) :: it + integer, dimension(1 :ime) :: iutb + + real(kind=kind_phys), dimension(1 :ime) :: aap + real(kind=kind_phys), dimension(1 :ime) :: bq1 + real(kind=kind_phys), dimension(1 :ime) :: bq1p + real(kind=kind_phys), dimension(1 :ime) :: delsrad + real(kind=kind_phys), dimension(1 :ime) :: ecof + real(kind=kind_phys), dimension(1 :ime) :: ecofp + real(kind=kind_phys), dimension(1 :ime) :: estso + real(kind=kind_phys), dimension(1 :ime) :: estsop + real(kind=kind_phys), dimension(1 :ime) :: fmz1 + real(kind=kind_phys), dimension(1 :ime) :: fmz10 + real(kind=kind_phys), dimension(1 :ime) :: fmz2 + real(kind=kind_phys), dimension(1 :ime) :: fmzo1 + real(kind=kind_phys), dimension(1 :ime) :: foft + real(kind=kind_phys), dimension(1 :ime) :: foftm + real(kind=kind_phys), dimension(1 :ime) :: frac + real(kind=kind_phys), dimension(1 :ime) :: land + real(kind=kind_phys), dimension(1 :ime) :: pssp + real(kind=kind_phys), dimension(1 :ime) :: qf + real(kind=kind_phys), dimension(1 :ime) :: rdiff + real(kind=kind_phys), dimension(1 :ime) :: rho + real(kind=kind_phys), dimension(1 :ime) :: rkmaxp + real(kind=kind_phys), dimension(1 :ime) :: rstso + real(kind=kind_phys), dimension(1 :ime) :: rstsop + real(kind=kind_phys), dimension(1 :ime) :: sf10 + real(kind=kind_phys), dimension(1 :ime) :: sf2 + real(kind=kind_phys), dimension(1 :ime) :: sfm + real(kind=kind_phys), dimension(1 :ime) :: sfzo + real(kind=kind_phys), dimension(1 :ime) :: sgzm + real(kind=kind_phys), dimension(1 :ime) :: slwa + real(kind=kind_phys), dimension(1 :ime) :: szeta + real(kind=kind_phys), dimension(1 :ime) :: szetam + real(kind=kind_phys), dimension(1 :ime) :: t1 + real(kind=kind_phys), dimension(1 :ime) :: t2 + real(kind=kind_phys), dimension(1 :ime) :: tab1 + real(kind=kind_phys), dimension(1 :ime) :: tab2 + real(kind=kind_phys), dimension(1 :ime) :: tempa1 + real(kind=kind_phys), dimension(1 :ime) :: tempa2 + real(kind=kind_phys), dimension(1 :ime) :: theta + real(kind=kind_phys), dimension(1 :ime) :: thetap + real(kind=kind_phys), dimension(1 :ime) :: tsg + real(kind=kind_phys), dimension(1 :ime) :: tsm + real(kind=kind_phys), dimension(1 :ime) :: tsp + real(kind=kind_phys), dimension(1 :ime) :: tss + real(kind=kind_phys), dimension(1 :ime) :: ucom + real(kind=kind_phys), dimension(1 :ime) :: uf10 + real(kind=kind_phys), dimension(1 :ime) :: uf2 + real(kind=kind_phys), dimension(1 :ime) :: ufh + real(kind=kind_phys), dimension(1 :ime) :: ufm + real(kind=kind_phys), dimension(1 :ime) :: ufzo + real(kind=kind_phys), dimension(1 :ime) :: ugzm + real(kind=kind_phys), dimension(1 :ime) :: uzeta + real(kind=kind_phys), dimension(1 :ime) :: uzetam + real(kind=kind_phys), dimension(1 :ime) :: vcom + real(kind=kind_phys), dimension(1 :ime) :: vrtkx + real(kind=kind_phys), dimension(1 :ime) :: vrts + real(kind=kind_phys), dimension(1 :ime) :: wind + real(kind=kind_phys), dimension(1 :ime) :: windp + real(kind=kind_phys), dimension(1 :ime) :: wind10p !WANG, 10m wind previous step + real(kind=kind_phys), dimension(1 :ime) :: uvs1 +! real(kind=kind_phys), dimension(1 :ime) :: xxfh + real(kind=kind_phys), dimension(1 :ime) :: xxfm + real(kind=kind_phys), dimension(1 :ime) :: xxsh + real(kind=kind_phys), dimension(1 :ime) :: z10 + real(kind=kind_phys), dimension(1 :ime) :: z2 + real(kind=kind_phys), dimension(1 :ime) :: zeta + real(kind=kind_phys), dimension(1 :ime) :: zkmax + + real(kind=kind_phys), dimension(1 :ime) :: pss + real(kind=kind_phys), dimension(1 :ime) :: tstar + real(kind=kind_phys), dimension(1 :ime) :: ukmax + real(kind=kind_phys), dimension(1 :ime) :: vkmax + real(kind=kind_phys), dimension(1 :ime) :: tkmax + real(kind=kind_phys), dimension(1 :ime) :: rkmax + real(kind=kind_phys), dimension(1 :ime) :: zot + real(kind=kind_phys), dimension(1 :ime) :: fhzo1 + real(kind=kind_phys), dimension(1 :ime) :: sfh + + real(kind=kind_phys) :: ux13, yo, y,xo,x,ux21,ugzzo,ux11,ux12,uzetao,xnum,alll + real(kind=kind_phys) :: ux1,ugz,x10,uzo,uq,ux2,ux3,xtan,xden,y10,uzet1o,ugz10 + real(kind=kind_phys) :: szet2, zal2,ugz2 + real(kind=kind_phys) :: rovcp,boycon,cmo2,psps1,zog,enrca,rca,cmo1,amask,en,ca,a,c + real(kind=kind_phys) :: sgz,zal10,szet10,fmz,szo,sq,fmzo,rzeta1,zal1g,szetao,rzeta2,zal2g + real(kind=kind_phys) :: hcap,xks,pith,teps,diffot,delten,alevp,psps2,alfus,nstep + real(kind=kind_phys) :: shfx,sigt4,reflect + real(kind=kind_phys) :: cor1,cor2,szetho,zal2gh,cons_p000001,cons_7,vis,ustar,restar,rat + real(kind=kind_phys) :: wndm,ckg + real(kind=kind_phys) :: windmks,znott,znotm + real(kind=kind_phys) :: ubot, vbot + integer:: i,j,ii,iq,nnest,icnt,ngd,ip + +!----------------------------------------------------------------------- +! internal variables +!----------------------------------------------------------------------- + + real(kind=kind_phys), dimension (223) :: tab + real(kind=kind_phys), dimension (223) :: table + real(kind=kind_phys), dimension (101) :: tab11 + real(kind=kind_phys), dimension (41) :: table4 + real(kind=kind_phys), dimension (42) :: tab3 + real(kind=kind_phys), dimension (54) :: table2 + real(kind=kind_phys), dimension (54) :: table3 + real(kind=kind_phys), dimension (74) :: table1 + real(kind=kind_phys), dimension (80) :: tab22 + + character(len=255) :: message + + equivalence (tab(1),tab11(1)) + equivalence (tab(102),tab22(1)) + equivalence (tab(182),tab3(1)) + equivalence (table(1),table1(1)) + equivalence (table(75),table2(1)) + equivalence (table(129),table3(1)) + equivalence (table(183),table4(1)) + + data amask/ -98.0/ +!----------------------------------------------------------------------- +! tables used to obtain the vapor pressures or saturated vapor +! pressure +!----------------------------------------------------------------------- + + data tab11/21*0.01403,0.01719,0.02101,0.02561,0.03117,0.03784, & + &.04584,.05542,.06685,.08049,.09672,.1160,.1388,.1658,.1977,.2353, & + &.2796,.3316,.3925,.4638,.5472,.6444,.7577,.8894,1.042,1.220,1.425, & + &1.662,1.936,2.252,2.615,3.032,3.511,4.060,4.688,5.406,6.225,7.159, & + &8.223,9.432,10.80,12.36,14.13,16.12,18.38,20.92,23.80,27.03,30.67, & + &34.76,39.35,44.49,50.26,56.71,63.93,71.98,80.97,90.98,102.1,114.5, & + &128.3,143.6,160.6,179.4,200.2,223.3,248.8,276.9,307.9,342.1,379.8, & + &421.3,466.9,517.0,572.0,632.3,698.5,770.9,850.2,937.0,1032./ + + data tab22/1146.6,1272.0,1408.1,1556.7,1716.9,1890.3,2077.6,2279.6 & + &,2496.7,2729.8,2980.0,3247.8,3534.1,3839.8,4164.8,4510.5,4876.9, & + &5265.1,5675.2,6107.8,6566.2,7054.7,7575.3,8129.4,8719.2,9346.5, & + &10013.,10722.,11474.,12272.,13119.,14017.,14969.,15977.,17044., & + &18173.,19367.,20630.,21964.,23373.,24861.,26430.,28086.,29831., & + &31671.,33608.,35649.,37796.,40055.,42430.,44927.,47551.,50307., & + &53200.,56236.,59422.,62762.,66264.,69934.,73777.,77802.,82015., & + &86423.,91034.,95855.,100890.,106160.,111660.,117400.,123400., & + &129650.,136170.,142980.,150070.,157460.,165160.,173180.,181530., & + &190220.,199260./ + + data tab3/208670.,218450.,228610.,239180.,250160.,261560.,273400., & + &285700.,298450.,311690.,325420.,339650.,354410.,369710.,385560., & + &401980.,418980.,436590.,454810.,473670.,493170.,513350.,534220., & + &555800.,578090.,601130.,624940.,649530.,674920.,701130.,728190., & + &756110.,784920.,814630.,845280.,876880.,909450.,943020.,977610., & + &1013250.,1049940.,1087740./ + + data table1/20*0.0,.3160e-02,.3820e-02,.4600e-02,.5560e-02,.6670e-02, & + & .8000e-02,.9580e-02,.1143e-01,.1364e-01,.1623e-01,.1928e-01, & + &.2280e-01,.2700e-01,.3190e-01,.3760e-01,.4430e-01,.5200e-01, & + &.6090e-01,.7130e-01,.8340e-01,.9720e-01,.1133e+00,.1317e-00, & + &.1526e-00,.1780e-00,.2050e-00,.2370e-00,.2740e-00,.3160e-00, & + &.3630e-00,.4170e-00,.4790e-00,.5490e-00,.6280e-00,.7180e-00, & + &.8190e-00,.9340e-00,.1064e+01,.1209e+01,.1368e+01,.1560e+01, & + &.1770e+01,.1990e+01,.2260e+01,.2540e+01,.2880e+01,.3230e+01, & + &.3640e+01,.4090e+01,.4590e+01,.5140e+01,.5770e+01,.6450e+01, & + &.7220e+01/ + + data table2/.8050e+01,.8990e+01,.1001e+02,.1112e+02,.1240e+02, & + &.1380e+02,.1530e+02,.1700e+02,.1880e+02,.2080e+02,.2310e+02, & + &.2550e+02,.2810e+02,.3100e+02,.3420e+02,.3770e+02,.4150e+02, & + &.4560e+02,.5010e+02,.5500e+02,.6030e+02,.6620e+02,.7240e+02, & + &.7930e+02,.8680e+02,.9500e+02,.1146e+03,.1254e+03,.1361e+03, & + &.1486e+03,.1602e+03,.1734e+03,.1873e+03,.2020e+03,.2171e+03, & + &.2331e+03,.2502e+03,.2678e+03,.2863e+03,.3057e+03,.3250e+03, & + &.3457e+03,.3664e+03,.3882e+03,.4101e+03,.4326e+03,.4584e+03, & + &.4885e+03,.5206e+03,.5541e+03,.5898e+03,.6273e+03,.6665e+03, & + &.7090e+03/ + + data table3/.7520e+03,.7980e+03,.8470e+03,.8980e+03,.9520e+03, & + &.1008e+04,.1067e+04,.1129e+04,.1194e+04,.1263e+04,.1334e+04, & + &.1409e+04,.1488e+04,.1569e+04,.1656e+04,.1745e+04,.1840e+04, & + &.1937e+04,.2041e+04,.2147e+04,.2259e+04,.2375e+04,.2497e+04, & + &.2624e+04,.2756e+04,.2893e+04,.3036e+04,.3186e+04,.3340e+04, & + &.3502e+04,.3670e+04,.3843e+04,.4025e+04,.4213e+04,.4408e+04, & + &.4611e+04,.4821e+04,.5035e+04,.5270e+04,.5500e+04,.5740e+04, & + &.6000e+04,.6250e+04,.6520e+04,.6810e+04,.7090e+04,.7390e+04, & + &.7700e+04,.8020e+04,.8350e+04,.8690e+04,.9040e+04,.9410e+04, & + &.9780e+04/ + + data table4/.1016e+05,.1057e+05,.1098e+05,.1140e+05,.1184e+05, & + &.1230e+05,.1275e+05,.1324e+05,.1373e+05,.1423e+05,.1476e+05, & + &.1530e+05,.1585e+05,.1642e+05,.1700e+05,.1761e+05,.1822e+05, & + &.1886e+05,.1950e+05,.2018e+05,.2087e+05,.2158e+05,.2229e+05, & + &.2304e+05,.2381e+05,.2459e+05,.2539e+05,.2621e+05,.2706e+05, & + &.2792e+05,.2881e+05,.2971e+05,.3065e+05,.3160e+05,.3257e+05, & + &.3357e+05,.3459e+05,.3564e+05,.3669e+05,.3780e+05,.0000e+00/ +! +! spcify constants needed by MFLUX2 +! +!GJF: should send through argument list, but these have nonstandard units + real,parameter :: cp = 1.00464e7 + real,parameter :: g = 980.6 + real,parameter :: rgas = 2.87e6 + real,parameter :: og = 1./g + integer :: ntstep = 0 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! +#if HWRF==1 + real*8 :: gasdev,ran1 !zhang + real :: rr !zhang + logical,save :: pert_Cd_local !zhang + CHARACTER(len=3) :: env_memb,env_pp + integer,save :: ens_random_seed_local,env_pp_local !zhang + integer :: ensda_physics_pert !zhang + real,save :: ens_Cdamp_local !zhang + data ens_random_seed_local/0/ + data env_pp_local/0/ + if ( ens_random_seed_local .eq. 0 ) then + CALL nl_get_ensda_physics_pert(1,ensda_physics_pert) + ens_random_seed_local=ens_random_seed + env_pp_local=ensda_physics_pert + pert_Cd_local=.false. + ens_Cdamp_local=0.0 +! env_pp=1: do physics perturbations for ensda members, ens_random_seed must be 99 + if ( env_pp_local .eq. 1 ) then + if ( ens_random_seed .ne. 99 ) then + pert_Cd_local=.true. + ens_Cdamp_local=ens_Cdamp + else +! ens_random_seed=99 do physics perturbation for ensemble forecasts, env_pp must be zero + ens_random_seed_local=ens_random_seed + pert_Cd_local=pert_Cd + ens_Cdamp_local=ens_Cdamp + endif + else + ens_random_seed_local=ens_random_seed + pert_Cd_local=pert_Cd + ens_Cdamp_local=ens_Cdamp + endif + print*, "Cd ===", ens_random_seed_local,pert_Cd_local,ens_Cdamp_local,ensda_physics_pert + endif +#endif + +! character*10 routine +! routine = 'mflux2' +! +!------------------------------------------------------------------------ +! set water availability constant "ecof" and land mask "land". +! limit minimum wind speed to 100 cm/s +!------------------------------------------------------------------------ +! constants for 10 m winds (correction for knots +! + cor1 = .120 + cor2 = 720. +! KWON : remove the artificial increase of 10m wind speed over 60kts +! which comes from GFDL hurricane model + cor1 = 0. + cor2 = 0. +! + + do i = its,ite + z10(i) = 1000. + z2 (i) = 200. + pss(i) = pspc(i) + tstar(i) = tstrc(i) + + if ( lcurr_sf .and. zoc(i) .le. 0.0 ) then + ubot = upc(i) - xcur(i) * 100.0 + vbot = vpc(i) - ycur(i) * 100.0 +! ubot = upc(i) +! vbot = vpc(i) + else + ubot = upc(i) + vbot = vpc(i) + endif + uvs1(i)= amax1( SQRT(ubot*ubot + & + vbot*vbot), 100.0) + if ( iwavecpl .eq. 1 .and. zoc(i) .le. 0.0 ) then + ukmax(i) = ( ubot * cos(gamma(i)) - & + vbot * sin(gamma(i)) ) & + * cos(gamma(i)) + vkmax(i) = ( vbot * cos(gamma(i)) - & + ubot * sin(gamma(i)) ) & + * cos(gamma(i)) + + else + ukmax(i) = ubot + vkmax(i) = vbot + endif + +! ukmax(i) = upc(i) +! vkmax(i) = vpc(i) + tkmax(i) = tpc(i) + rkmax(i) = rpc(i) + enddo + + do i = its,ite + windp(i) = SQRT(ukmax(i)*ukmax(i) + vkmax(i)*vkmax(i)) + wind (i) = amax1(windp(i),100.) + +!! use wind10 previous step + wind10p(i) = wind10(i) !! cm/s + wind10p(i) = amax1(wind10p(i),100.) +!! + + if (zoc(i) .LT. amask) zoc(i) = -0.0185*0.001*wind10p(i)*wind10p(i)*og + if (zoc(i) .GT. 0.0) then + ecof(i) = wetc(i) + land(i) = 1.0 + zot (i) = zoc(i) + else + ecof(i) = wetc(i) + land(i) = 0.0 + windmks=wind10p(i)*.01 + if ( iwavecpl .eq. 1 ) then + call znot_wind10m(windmks,znott,znotm,icoef_sf) + !Check if Charnock parameter ratio is received in a proper range. + if ( alpha(i) .ge. 0.2 .and. alpha(i) .le. 5. ) then + znotm = znotm*alpha(i) + endif + zoc(i) = -100.*znotm + zot(i) = -100* znott + else + call znot_wind10m(windmks,znott,znotm,icoef_sf) + zoc(i) = -100.*znotm + zot(i) = -100* znott + endif + endif +!------------------------------------------------------------------------ +! where necessary modify zo values over ocean. +!------------------------------------------------------------------------ +! + mzoc(i) = zoc(i) !FOR SAVE MOMENTUM Zo + tzot(i) = zot(i) !output wang + enddo + +!------------------------------------------------------------------------ +! define constants: +! a and c = constants used in evaluating universal function for +! stable case +! ca = karmen constant +! cm01 = constant part of vertical integral of universal +! function; stable case ( 0.5 < zeta < or = 10.0) +! cm02 = constant part of vertical integral of universal +! function; stable case ( zeta > 10.0) +!------------------------------------------------------------------------ + + en = 2. + c = .76 + a = 5. + ca = .4 + cmo1 = .5*a - 1.648 + cmo2 = 17.193 + .5*a - 10.*c + boycon = .61 + rovcp=rgas/cp + + do i = its,ite + theta(i) = tkmax(i)/((pkmax(i)/pspc(i))**rovcp) + vrtkx(i) = 1.0 + boycon*rkmax(i) + !zkmax(i) = -rgas*tkmax(i)*alog(pkmax(i)/pspc(i))*og + zkmax(i) = z1(i) !use precalculated height of first model layer center + enddo + +!------------------------------------------------------------------------ +! get saturation mixing ratios at surface +!------------------------------------------------------------------------ + + do i = its,ite + tsg (i) = tstar(i) + tab1 (i) = tstar(i) - 153.16 + it (i) = IFIX(tab1(i)) + tab2 (i) = tab1(i) - FLOAT(it(i)) + t1 (i) = tab(min(223,max(1,it(i) + 1))) + t2 (i) = table(min(223,max(1,it(i) + 1))) + estso(i) = t1(i) + tab2(i)*t2(i) + psps1 = (pss(i) - estso(i)) + if(psps1 .EQ. 0.0)then + psps1 = .1 + endif + rstso(i) = 0.622*estso(i)/psps1 + vrts (i) = 1. + boycon*ecof(i)*rstso(i) + enddo + +!------------------------------------------------------------------------ +! check if consideration of virtual temperature changes stability. +! if so, set "dthetav" to near neutral value (1.0e-4). also check +! for very small lapse rates; if ABS(tempa1) <1.0e-4 then +! tempa1=1.0e-4 +!------------------------------------------------------------------------ + + do i = its,ite + tempa1(i) = theta(i)*vrtkx(i) - tstar(i)*vrts(i) + tempa2(i) = tempa1(i)*(theta(i) - tstar(i)) + if (tempa2(i) .LT. 0.) tempa1(i) = 1.0e-4 + tab1(i) = ABS(tempa1(i)) + if (tab1(i) .LT. 1.0e-4) tempa1(i) = 1.0e-4 +!------------------------------------------------------------------------ +! compute bulk richardson number "rib" at each point. if "rib" +! exceeds 95% of critical richardson number "tab1" then "rib = tab1" +!------------------------------------------------------------------------ + + rib (i) = g*zkmax(i)*tempa1(i)/ & + (tkmax(i)*vrtkx(i)*wind(i)*wind(i)) + tab2(i) = ABS(zoc(i)) + tab1(i) = 0.95/(c*(1. - tab2(i)/zkmax(i))) + if (rib(i) .GT. tab1(i)) rib(i) = tab1(i) + enddo + + do i = its,ite + zeta(i) = ca*rib(i)/0.03 + enddo + +!------------------------------------------------------------------------ +! begin looping through points on line, solving wegsteins iteration +! for zeta at each point, and using hicks functions +!------------------------------------------------------------------------ + +!------------------------------------------------------------------------ +! set initial guess of zeta=non - dimensional height "szeta" for +! stable points +!------------------------------------------------------------------------ + + rca = 1./ca + enrca = en*rca +! turn off interfacial layer by zeroing out enrca + enrca = 0.0 + zog = .0185*og + +!------------------------------------------------------------------------ +! stable points +!------------------------------------------------------------------------ + + ip = 0 + do i = its,ite + if (zeta(i) .GE. 0.0) then + ip = ip + 1 + istb(ip) = i + endif + enddo + + if (ip .EQ. 0) go to 170 + do i = 1,ip + szetam(i) = 1.0e+30 + sgzm(i) = 0.0e+00 + szeta(i) = zeta(istb(i)) + ifz(i) = 1 + enddo + +!------------------------------------------------------------------------ +! begin wegstein iteration for "zeta" at stable points using +! hicks(1976) +!------------------------------------------------------------------------ + + do icnt = 1,icntx + do i = 1,ip + if (ifz(i) .EQ. 0) go to 80 + zal1g = ALOG(szeta(i)) + if (szeta(i) .LE. 0.5) then + fmz1(i) = (zal1g + a*szeta(i))*rca + else if (szeta(i) .GT. 0.5 .AND. szeta(i) .LE. 10.) then + rzeta1 = 1./szeta(i) + fmz1(i) = (8.*zal1g + 4.25*rzeta1 - & + 0.5*rzeta1*rzeta1 + cmo1)*rca + else if (szeta(i) .GT. 10.) then + fmz1(i) = (c*szeta(i) + cmo2)*rca + endif + szetao = ABS(zoc(istb(i)))/zkmax(istb(i))*szeta(i) + zal2g = ALOG(szetao) + if (szetao .LE. 0.5) then + fmzo1(i) = (zal2g + a*szetao)*rca + sfzo (i) = 1. + a*szetao + else if (szetao .GT. 0.5 .AND. szetao .LE. 10.) then + rzeta2 = 1./szetao + fmzo1(i) = (8.*zal2g + 4.25*rzeta2 - & + 0.5*rzeta2*rzeta2 + cmo1)*rca + sfzo (i) = 8.0 - 4.25*rzeta2 + rzeta2*rzeta2 + else if (szetao .GT. 10.) then + fmzo1(i) = (c*szetao + cmo2)*rca + sfzo (i) = c*szetao + endif + + +! compute heat & moisture parts of zot.. for calculation of sfh + + szetho = ABS(zot(istb(i)))/zkmax(istb(i))*szeta(i) + zal2gh = ALOG(szetho) + if (szetho .LE. 0.5) then + fhzo1(i) = (zal2gh + a*szetho)*rca + sfzo (i) = 1. + a*szetho + else if (szetho .GT. 0.5 .AND. szetho .LE. 10.) then + rzeta2 = 1./szetho + fhzo1(i) = (8.*zal2gh + 4.25*rzeta2 - & + 0.5*rzeta2*rzeta2 + cmo1)*rca + sfzo (i) = 8.0 - 4.25*rzeta2 + rzeta2*rzeta2 + else if (szetho .GT. 10.) then + fhzo1(i) = (c*szetho + cmo2)*rca + sfzo (i) = c*szetho + endif + +!------------------------------------------------------------------------ +! compute universal function at 10 meters for diagnostic purposes +!------------------------------------------------------------------------ + + szet10 = ABS(z10(istb(i)))/zkmax(istb(i))*szeta(i) + zal10 = ALOG(szet10) + if (szet10 .LE. 0.5) then + fmz10(i) = (zal10 + a*szet10)*rca + else if (szet10 .GT. 0.5 .AND. szet10 .LE. 10.) then + rzeta2 = 1./szet10 + fmz10(i) = (8.*zal10 + 4.25*rzeta2 - & + 0.5*rzeta2*rzeta2 + cmo1)*rca + else if (szet10 .GT. 10.) then + fmz10(i) = (c*szet10 + cmo2)*rca + endif + sf10(i) = fmz10(i) - fmzo1(i) +! compute 2m values for diagnostics in HWRF + szet2 = ABS(z2 (istb(i)))/zkmax(istb(i))*szeta(i) + zal2 = ALOG(szet2 ) + if (szet2 .LE. 0.5) then + fmz2 (i) = (zal2 + a*szet2 )*rca + else if (szet2 .GT. 0.5 .AND. szet2 .LE. 2.) then + rzeta2 = 1./szet2 + fmz2 (i) = (8.*zal2 + 4.25*rzeta2 - & + 0.5*rzeta2*rzeta2 + cmo1)*rca + else if (szet2 .GT. 2.) then + fmz2 (i) = (c*szet2 + cmo2)*rca + endif + sf2 (i) = fmz2 (i) - fmzo1(i) + + sfm(i) = fmz1(i) - fmzo1(i) + sfh(i) = fmz1(i) - fhzo1(i) + sgz = ca*rib(istb(i))*sfm(i)*sfm(i)/ & + (sfh(i) + enrca*sfzo(i)) + fmz = (sgz - szeta(i))/szeta(i) + fmzo = ABS(fmz) + if (fmzo .GE. 5.0e-5) then + sq = (sgz - sgzm(i))/(szeta(i) - szetam(i)) + if(sq .EQ. 1) then + write(errmsg,'(*(a))') 'NCO ERROR DIVIDE BY ZERO IN gfdl_sfc_layer.F90/MFLUX2 (STABLE CASE)'// & + 'sq is 1 ',fmzo,sgz,sgzm(i),szeta(i),szetam(i) + errflg = 1 + return + endif + szetam(i) = szeta(i) + szeta (i) = (sgz - szeta(i)*sq)/(1.0 - sq) + sgzm (i) = sgz + else + ifz(i) = 0 + endif +80 continue + enddo + enddo + + do i = 1,ip + if (ifz(i) .GE. 1) go to 110 + enddo + + go to 130 + +110 continue + + write(errmsg,'(*(a))') 'NON-CONVERGENCE FOR STABLE ZETA IN gfdl_sfc_layer.F90/MFLUX2' + errflg = 1 + return +! call MPI_CLOSE(1,routine) + +!------------------------------------------------------------------------ +! update "zo" for ocean points. "zo"cannot be updated within the +! wegsteins iteration as the scheme (for the near neutral case) +! can become unstable +!------------------------------------------------------------------------ + +130 continue + do i = 1,ip + szo = zoc(istb(i)) + if (szo .LT. 0.0) then + wndm=wind(istb(i))*0.01 + if(wndm.lt.15.0) then + ckg=0.0185*og + else + ckg=(sfenth*(4*0.000308*wndm) + (1.-sfenth)*0.0185 )*og + endif + + szo = - ckg*wind(istb(i))*wind(istb(i))/ & + (sfm(i)*sfm(i)) + cons_p000001 = .000001 + cons_7 = 7. + vis = 1.4E-1 + + ustar = sqrt( -szo / zog) + restar = -ustar * szo / vis + restar = max(restar,cons_p000001) +! Rat taken from Zeng, Zhao and Dickinson 1997 + rat = 2.67 * restar ** .25 - 2.57 + rat = min(rat ,cons_7) !constant + rat=0. + zot(istb(i)) = szo * exp(-rat) + else + zot(istb(i)) = zoc(istb(i)) + endif + +! in hwrf thermal znot is loaded back into the zoc array for next step + zoc(istb(i)) = szo + enddo + + do i = 1,ip + xxfm(istb(i)) = sfm(i) + xxfh(istb(i)) = sfh(i) + xxfh2(istb(i)) = sf2 (i) + xxsh(istb(i)) = sfzo(i) + enddo + +!------------------------------------------------------------------------ +! obtain wind at 10 meters for diagnostic purposes +!------------------------------------------------------------------------ + + do i = 1,ip + wind10(istb(i)) = sf10(i)*uvs1(istb(i))/sfm(i) + wind10(istb(i)) = wind10(istb(i)) * 1.944 + if(wind10(istb(i)) .GT. 6000.0) then + wind10(istb(i))=wind10(istb(i))+wind10(istb(i))*cor1 & + - cor2 + endif +! the above correction done by GFDL in centi-kts!!!-change back + wind10(istb(i)) = wind10(istb(i)) / 1.944 + enddo + +!------------------------------------------------------------------------ +! unstable points +!------------------------------------------------------------------------ + +170 continue + + iq = 0 + do i = its,ite + if (zeta(i) .LT. 0.0) then + iq = iq + 1 + iutb(iq) = i + endif + enddo + + if (iq .EQ. 0) go to 290 + do i = 1,iq + uzeta (i) = zeta(iutb(i)) + ifz (i) = 1 + uzetam(i) = 1.0e+30 + ugzm (i) = 0.0e+00 + enddo + +!------------------------------------------------------------------------ +! begin wegstein iteration for "zeta" at unstable points using +! hicks functions +!------------------------------------------------------------------------ + + do icnt = 1,icntx + do i = 1,iq + if (ifz(i) .EQ. 0) go to 200 + ugzzo = ALOG(zkmax(iutb(i))/ABS(zot(iutb(i)))) + uzetao = ABS(zot(iutb(i)))/zkmax(iutb(i))*uzeta(i) + ux11 = 1. - 16.*uzeta(i) + ux12 = 1. - 16.*uzetao + y = SQRT(ux11) + yo = SQRT(ux12) + ufzo(i) = 1./yo + ux13 = (1. + y)/(1. + yo) + ux21 = ALOG(ux13) + ufh(i) = (ugzzo - 2.*ux21)*rca +! recompute scalers for ufm in terms of mom znot... zoc + ugzzo = ALOG(zkmax(iutb(i))/ABS(zoc(iutb(i)))) + uzetao = ABS(zoc(iutb(i)))/zkmax(iutb(i))*uzeta(i) + ux11 = 1. - 16.*uzeta(i) + ux12 = 1. - 16.*uzetao + y = SQRT(ux11) + yo = SQRT(ux12) + ux13 = (1. + y)/(1. + yo) + ux21 = ALOG(ux13) +! ufzo(i) = 1./yo + x = SQRT(y) + xo = SQRT(yo) + xnum = (x**2 + 1.)*((x + 1.)**2) + xden = (xo**2 + 1.)*((xo + 1.)**2) + xtan = ATAN(x) - ATAN(xo) + ux3 = ALOG(xnum/xden) + ufm(i) = (ugzzo - ux3 + 2.*xtan)*rca + +!------------------------------------------------------------------------ +! obtain ten meter winds for diagnostic purposes +!------------------------------------------------------------------------ + + ugz10 = ALOG(z10(iutb(i))/ABS(zoc(iutb(i)))) + uzet1o = ABS(z10(iutb(i)))/zkmax(iutb(i))*uzeta(i) + uzetao = ABS(zoc(iutb(i)))/zkmax(iutb(i))*uzeta(i) + ux11 = 1. - 16.*uzet1o + ux12 = 1. - 16.*uzetao + y = SQRT(ux11) + y10 = SQRT(ux12) + ux13 = (1. + y)/(1. + y10) + ux21 = ALOG(ux13) + x = SQRT(y) + x10 = SQRT(y10) + xnum = (x**2 + 1.)*((x + 1.)**2) + xden = (x10**2 + 1.)*((x10 + 1.)**2) + xtan = ATAN(x) - ATAN(x10) + ux3 = ALOG(xnum/xden) + uf10(i) = (ugz10 - ux3 + 2.*xtan)*rca + +! obtain 2m values for diagnostics... + + + ugz2 = ALOG(z2 (iutb(i))/ABS(zoc(iutb(i)))) + uzet1o = ABS(z2 (iutb(i)))/zkmax(iutb(i))*uzeta(i) + uzetao = ABS(zoc(iutb(i)))/zkmax(iutb(i))*uzeta(i) + ux11 = 1. - 16.*uzet1o + ux12 = 1. - 16.*uzetao + y = SQRT(ux11) + yo = SQRT(ux12) + ux13 = (1. + y)/(1. + yo) + ux21 = ALOG(ux13) + uf2 (i) = (ugzzo - 2.*ux21)*rca + + + ugz = ca*rib(iutb(i))*ufm(i)*ufm(i)/(ufh(i) + enrca*ufzo(i)) + ux1 = (ugz - uzeta(i))/uzeta(i) + ux2 = ABS(ux1) + if (ux2 .GE. 5.0e-5) then + uq = (ugz - ugzm(i))/(uzeta(i) - uzetam(i)) + uzetam(i) = uzeta(i) + if(uq .EQ. 1) then + write(errmsg,'(*(a))') 'NCO ERROR DIVIDE BY ZERO IN gfdl_sfc_layer.F90/MFLUX2 (UNSTABLE CASE)'// & + 'uq is 1 ',ux2,ugz,ugzm(i),uzeta(i),uzetam(i) + errflg = 1 + return + endif + uzeta (i) = (ugz - uzeta(i)*uq)/(1.0 - uq) + ugzm (i) = ugz + else + ifz(i) = 0 + endif +200 continue + enddo + enddo + + + do i = 1,iq + if (ifz(i) .GE. 1) go to 230 + enddo + + go to 250 + +230 continue + write(errmsg,'(*(a))') 'NON-CONVERGENCE FOR UNSTABLE ZETA IN ROW'// & + 'uq is 1 ',ux2,ugz,ugzm(i),uzeta(i),uzetam(i) + errflg = 1 + return + +! call MPI_CLOSE(1,routine) + +!------------------------------------------------------------------------ +! gather unstable values +!------------------------------------------------------------------------ + +250 continue + +!------------------------------------------------------------------------ +! update "zo" for ocean points. zo cannot be updated within the +! wegsteins iteration as the scheme (for the near neutral case) +! can become unstable. +!------------------------------------------------------------------------ + + do i = 1,iq + uzo = zoc(iutb(i)) + if (zoc(iutb(i)) .LT. 0.0) then + wndm=wind(iutb(i))*0.01 + if(wndm.lt.15.0) then + ckg=0.0185*og + else + ckg=(4*0.000308*wndm)*og + ckg=(sfenth*(4*0.000308*wndm) + (1.-sfenth)*0.0185 )*og + endif + uzo =-ckg*wind(iutb(i))*wind(iutb(i))/(ufm(i)*ufm(i)) + cons_p000001 = .000001 + cons_7 = 7. + vis = 1.4E-1 + + ustar = sqrt( -uzo / zog) + restar = -ustar * uzo / vis + restar = max(restar,cons_p000001) +! Rat taken from Zeng, Zhao and Dickinson 1997 + rat = 2.67 * restar ** .25 - 2.57 + rat = min(rat ,cons_7) !constant + rat=0.0 + zot(iutb(i)) = uzo * exp(-rat) + else + zot(iutb(i)) = zoc(iutb(i)) + endif +! in hwrf thermal znot is loaded back into the zoc array for next step + zoc(iutb(i)) = uzo + enddo + +!------------------------------------------------------------------------ +! obtain wind at ten meters for diagnostic purposes +!------------------------------------------------------------------------ + do i = 1,iq + wind10(iutb(i)) = uf10(i)*uvs1(iutb(i))/ufm(i) + wind10(iutb(i)) = wind10(iutb(i)) * 1.944 + if(wind10(iutb(i)) .GT. 6000.0) then + wind10(iutb(i))=wind10(iutb(i))+wind10(iutb(i))*cor1 & + - cor2 + endif +! the above correction done by GFDL in centi-kts!!!-change back + wind10(iutb(i)) = wind10(iutb(i)) / 1.944 + enddo + + do i = 1,iq + xxfm(iutb(i)) = ufm(i) + xxfh(iutb(i)) = ufh(i) + xxfh2(iutb(i)) = uf2 (i) + xxsh(iutb(i)) = ufzo(i) + enddo + +290 continue + + do i = its,ite + ucom(i) = ukmax(i) + vcom(i) = vkmax(i) + if (windp(i) .EQ. 0.0) then + windp(i) = 100.0 + ucom (i) = 100.0/SQRT(2.0) + vcom (i) = 100.0/SQRT(2.0) + endif + rho(i) = pss(i)/(rgas*(tsg(i) + enrca*(theta(i) - & + tsg(i))*xxsh(i)/(xxfh(i) + enrca*xxsh(i)))) + bq1(i) = wind(i)*rho(i)/(xxfm(i)*(xxfh(i) + enrca*xxsh(i))) + enddo + +! do land sfc temperature prediction if ntsflg=1 +! ntsflg = 1 ! gopal's doing + + if (ntsflg .EQ. 0) go to 370 + alll = 600. + xks = 0.01 + hcap = .5/2.39e-8 + pith = SQRT(4.*ATAN(1.0)) + alfus = alll/2.39e-8 + teps = 0.1 +! slwdc... in units of cal/min ???? +! slwa... in units of ergs/sec/cm*2 +! 1 erg=2.39e-8 cal +!------------------------------------------------------------------------ +! pack land and sea ice points +!------------------------------------------------------------------------ + + ip = 0 + do i = its,ite + if (land(i) .EQ. 1) then + ip = ip + 1 + indx (ip) = i +! slwa is defined as positive down.... + slwa (ip) = slwdc(i)/(2.39e-8*60.) + tss (ip) = tstar(i) + thetap (ip) = theta(i) + rkmaxp (ip) = rkmax(i) + aap (ip) = 5.673e-5 + pssp (ip) = pss(i) + ecofp (ip) = ecof(i) + estsop (ip) = estso(i) + rstsop (ip) = rstso(i) + bq1p (ip) = bq1(i) + bq1p (ip) = amax1(bq1p(ip),0.1e-3) + delsrad(ip) = dt *pith/(hcap*SQRT(3600.*24.*xks)) + endif + enddo + +!------------------------------------------------------------------------ +! initialize variables for first pass of iteration +!------------------------------------------------------------------------ + + do i = 1,ip + ifz (i) = 1 + tsm (i) = tss(i) + rdiff(i) = amin1(0.0,(rkmaxp(i) - rstsop(i))) + +300 format(2X, ' SURFACE EQUILIBRIUM CALCULATION ') + + foftm(i) = tss(i) + delsrad(i)*(slwa(i) - aap(i)*tsm(i)**4 - & + cp*bq1p(i)*(tsm(i) - thetap(i)) + ecofp(i)*alfus*bq1p(i)* & + rdiff(i)) + tsp(i) = foftm(i) + enddo + +!------------------------------------------------------------------------ +! do iteration to determine "tstar" at new time level +!------------------------------------------------------------------------ + + do icnt = 1,icntx + do i = 1,ip + if (ifz(i) .EQ. 0) go to 330 + tab1 (i) = tsp(i) - 153.16 + it (i) = IFIX(tab1(i)) + tab2 (i) = tab1(i) - FLOAT(it(i)) + t1 (i) = tab(min(223,max(1,it(i) + 1))) + t2 (i) = table(min(223,max(1,it(i) + 1))) + estsop(i) = t1(i) + tab2(i)*t2(i) + psps2 = (pssp(i) - estsop(i)) + if(psps2 .EQ. 0.0)then + psps2 = .1 + endif + rstsop(i) = 0.622*estsop(i)/psps2 + rdiff (i) = amin1(0.0,(rkmaxp(i) - rstsop(i))) + + foft(i) = tss(i) + delsrad(i)*(slwa(i) - aap(i)*tsp(i)**4 - & + cp*bq1p(i)*(tsp(i) - thetap(i)) + ecofp(i)*alfus*bq1p(i)* & + rdiff(i)) + + frac(i) = ABS((foft(i) - tsp(i))/tsp(i)) + +!------------------------------------------------------------------------ +! check for convergence of all points use wegstein iteration +!------------------------------------------------------------------------ + + if (frac(i) .GE. teps) then + qf (i) = (foft(i) - foftm(i))/(tsp(i) - tsm(i)) + tsm (i) = tsp(i) + tsp (i) = (foft(i) - tsp(i)*qf(i))/(1. - qf(i)) + foftm(i) = foft(i) + else + ifz(i) = 0 + endif +330 continue + enddo + enddo + +!------------------------------------------------------------------------ +! check for convergence of "t star" prediction +!------------------------------------------------------------------------ + + do i = 1,ip + if (ifz(i) .EQ. 1) then + write(errmsg,'(*(a))') 'NON-CONVERGENCE OF T* PREDICTED (T*,I) = ', & + tsp(i), i + errflg = 1 + return +! call MPI_CLOSE(1,routine) + endif + enddo + + do i = 1,ip + ii = indx(i) + tstrc(ii) = tsp (i) + enddo + +!------------------------------------------------------------------------ +! compute fluxes and momentum drag coef +!------------------------------------------------------------------------ + +370 continue + do i = its,ite +!!! + if ( iwavecpl .eq. 1 .and. zoc(i) .le. 0.0 ) then + windmks = wind10(i) * 0.01 + call znot_wind10m(windmks,znott,znotm,icoef_sf) + !Check if Charnock parameter ratio is received in a proper range. + if ( alpha(i) .ge. 0.2 .and. alpha(i) .le. 5. ) then + znotm = znotm*alpha(i) + endif + zoc(i) = -100.*znotm + zot(i) = -100* znott + endif +!!!! + fxh(i) = bq1(i)*(theta(i) - tsg(i)) + fxe(i) = ecof(i)*bq1(i)*(rkmax(i) - rstso(i)) + if (fxe(i) .GT. 0.0) fxe(i) = 0.0 + fxmx(i) = rho(i)/(xxfm(i)*xxfm(i))*wind(i)*wind(i)*ucom(i)/ & + windp(i) + fxmy(i) = rho(i)/(xxfm(i)*xxfm(i))*wind(i)*wind(i)*vcom(i)/ & + windp(i) + cdm(i) = 1./(xxfm(i)*xxfm(i)) +#if HWRF==1 +! randomly perturb the Cd +!zzz if( pert_Cd_local .and. ens_random_seed_local .gt. 0 ) then + if( pert_Cd_local ) then + ens_random_seed_local=ran1(-ens_random_seed_local)*1000 + rr=2.0*ens_Cdamp_local*ran1(-ens_random_seed_local)-ens_Cdamp_local + cdm(i) = cdm(i) *(1.0+rr) + endif +#endif + + enddo + ntstep = ntstep + 1 + return + end subroutine MFLUX2 + + end module gfdl_sfc_layer diff --git a/physics/gfdl_sfc_layer.meta b/physics/gfdl_sfc_layer.meta new file mode 100644 index 000000000..738216d1a --- /dev/null +++ b/physics/gfdl_sfc_layer.meta @@ -0,0 +1,801 @@ +[ccpp-arg-table] + name = gfdl_sfc_layer_init + type = scheme +[icoef_sf] + standard_name = flag_for_surface_roughness_option_over_ocean + long_name = surface roughness options over ocean + units = flag + dimensions = () + type = integer + intent = in + optional = F +[cplwav] + standard_name = flag_for_wave_coupling + long_name = flag controlling cplwav collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lcurr_sf] + standard_name = flag_for_ocean_currents_in_surface_layer_scheme + long_name = flag for taking ocean currents into account in surface layer scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[pert_cd] + standard_name = flag_for_perturbation_of_surface_drag_coefficient_for_momentum_in_air + long_name = flag for perturbing the surface drag coefficient for momentum in surface layer scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntsflg] + standard_name = flag_for_updating_skin_temperatuer_in_surface_layer_scheme + long_name = flag for updating skin temperature in the surface layer scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = gfdl_sfc_layer_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noah] + standard_name = flag_for_noah_land_surface_scheme + long_name = flag for NOAH land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noah_wrfv4] + standard_name = flag_for_noah_wrfv4_land_surface_scheme + long_name = flag for NOAH WRFv4 land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icoef_sf] + standard_name = flag_for_surface_roughness_option_over_ocean + long_name = surface roughness options over ocean + units = flag + dimensions = () + type = integer + intent = in + optional = F +[cplwav] + standard_name = flag_for_wave_coupling + long_name = flag controlling cplwav collection (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lcurr_sf] + standard_name = flag_for_ocean_currents_in_surface_layer_scheme + long_name = flag for taking ocean currents into account in surface layer scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[pert_Cd] + standard_name = flag_for_perturbation_of_surface_drag_coefficient_for_momentum_in_air + long_name = flag for perturbing the surface drag coefficient for momentum in surface layer scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntsflg] + standard_name = flag_for_updating_skin_temperatuer_in_surface_layer_scheme + long_name = flag for updating skin temperature in the surface layer scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[sfenth] + standard_name = enthalpy_flux_factor + long_name = enthalpy flux factor used in surface layer scheme + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[z1] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractnl cover of green veg + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[vegtype] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[sigmaf] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[dry] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[isltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ep1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ep2] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[smois] + standard_name = volume_fraction_of_soil_moisture + long_name = total soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psfc] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[u1] + standard_name = x_wind_at_lowest_model_layer + long_name = zonal wind at lowest model layer + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind_at_lowest_model_layer + long_name = meridional wind at lowest model layer + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[u10] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[v10] + standard_name = y_wind_at_10m + long_name = 10 meter v wind speed + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[gsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[glw] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_ocn] + standard_name = surface_skin_temperature_after_iteration_over_ocean + long_name = surface skin temperature after iteration over ocean + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_lnd] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tskin_ocn] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin_lnd] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tskin_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_ocn] + standard_name = surface_friction_velocity_over_ocean + long_name = surface friction velocity over ocean + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_lnd] + standard_name = surface_friction_velocity_over_land + long_name = surface friction velocity over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[znt_ocn] + standard_name = surface_roughness_length_over_ocean_interstitial + long_name = surface roughness length over ocean (temporary use as interstitial) + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[znt_lnd] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[znt_ice] + standard_name = surface_roughness_length_over_ice_interstitial + long_name = surface roughness length over ice (temporary use as interstitial) + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cdm_ocn] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean + long_name = surface exchange coeff for momentum over ocean + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cdm_lnd] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cdm_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ocn] + standard_name = surface_wind_stress_over_ocean + long_name = surface wind stress over ocean + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_lnd] + standard_name = surface_wind_stress_over_land + long_name = surface wind stress over land + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stress_ice] + standard_name = surface_wind_stress_over_ice + long_name = surface wind stress over ice + units = m2 s-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[rib_ocn] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean + long_name = bulk Richardson number at the surface over ocean + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[rib_lnd] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[rib_ice] + standard_name = bulk_richardson_number_at_lowest_model_level_over_ice + long_name = bulk Richardson number at the surface over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean + long_name = Monin-Obukhov similarity function for momentum over ocean + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land + long_name = Monin-Obukhov similarity function for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fm_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice + long_name = Monin-Obukhov similarity function for momentum over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean + long_name = Monin-Obukhov similarity function for heat over ocean + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_land + long_name = Monin-Obukhov similarity function for heat over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fh_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice + long_name = Monin-Obukhov similarity function for heat over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ocn] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean + long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_lnd] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land + long_name = Monin-Obukhov similarity parameter for heat at 2m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fh2_ice] + standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice + long_name = Monin-Obukhov similarity parameter for heat at 2m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_ocn] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_lnd] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ch_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ocn] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_lnd] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land + long_name = Monin-Obukhov similarity parameter for momentum at 10m over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fm10_ice] + standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice + long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[qss_ocn] + standard_name = surface_specific_humidity_over_ocean + long_name = surface air saturation specific humidity over ocean + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss_lnd] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[qss_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/module_sf_exchcoef.f90 b/physics/module_sf_exchcoef.f90 new file mode 100755 index 000000000..0e3dae80c --- /dev/null +++ b/physics/module_sf_exchcoef.f90 @@ -0,0 +1,733 @@ +! This MODULE holds the routines that calculate air-sea exchange coefficients + +MODULE module_sf_exchcoef +CONTAINS + + SUBROUTINE znot_m_v1(uref,znotm) + IMPLICIT NONE + +! uref(m/s) : Reference level wind +! znotm(meter): Roughness scale for momentum +! Author : Biju Thomas on 02/07/2014 +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znotm + REAL :: bs0, bs1, bs2, bs3, bs4, bs5, bs6 + REAL :: cf0, cf1, cf2, cf3, cf4, cf5, cf6 + + + bs0 = -8.367276172397277e-12 + bs1 = 1.7398510865876079e-09 + bs2 = -1.331896578363359e-07 + bs3 = 4.507055294438727e-06 + bs4 = -6.508676881906914e-05 + bs5 = 0.00044745137674732834 + bs6 = -0.0010745704660847233 + + cf0 = 2.1151080765239772e-13 + cf1 = -3.2260663894433345e-11 + cf2 = -3.329705958751961e-10 + cf3 = 1.7648562021709124e-07 + cf4 = 7.107636825694182e-06 + cf5 = -0.0013914681964973246 + cf6 = 0.0406766967657759 + + + IF ( uref .LE. 5.0 ) THEN + znotm = (0.0185 / 9.8*(7.59e-4*uref**2+2.46e-2*uref)**2) + ELSEIF (uref .GT. 5.0 .AND. uref .LT. 10.0) THEN + znotm =.00000235*(uref**2 - 25 ) + 3.805129199617346e-05 + ELSEIF ( uref .GE. 10.0 .AND. uref .LT. 60.0) THEN + znotm = bs6 + bs5*uref + bs4*uref**2 + bs3*uref**3 + bs2*uref**4 + & + bs1*uref**5 + bs0*uref**6 + ELSE + znotm = cf6 + cf5*uref + cf4*uref**2 + cf3*uref**3 + cf2*uref**4 + & + cf1*uref**5 + cf0*uref**6 + + END IF + + END SUBROUTINE znot_m_v1 + + SUBROUTINE znot_m_v0(uref,znotm) + IMPLICIT NONE + +! uref(m/s) : Reference level wind +! znotm(meter): Roughness scale for momentum +! Author : Biju Thomas on 02/07/2014 + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znotm + REAL :: yz, y1, y2, y3, y4 + + yz = 0.0001344 + y1 = 3.015e-05 + y2 = 1.517e-06 + y3 = -3.567e-08 + y4 = 2.046e-10 + + IF ( uref .LT. 12.5 ) THEN + znotm = (0.0185 / 9.8*(7.59e-4*uref**2+2.46e-2*uref)**2) + ELSE IF ( uref .GE. 12.5 .AND. uref .LT. 30.0 ) THEN + znotm = (0.0739793 * uref -0.58)/1000.0 + ELSE + znotm = yz + uref*y1 + uref**2*y2 + uref**3*y3 + uref**4*y4 + END IF + + END SUBROUTINE znot_m_v0 + + + SUBROUTINE znot_t_v1(uref,znott) + IMPLICIT NONE + +! uref(m/s) : Reference level wind +! znott(meter): Roughness scale for temperature/moisture +! Author : Biju Thomas on 02/07/2014 + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + REAL :: to0, to1, to2, to3 + REAL :: tr0, tr1, tr2, tr3 + REAL :: tn0, tn1, tn2, tn3, tn4, tn5 + REAL :: ta0, ta1, ta2, ta3, ta4, ta5, ta6 + REAL :: tt0, tt1, tt2, tt3, tt4, tt5, tt6, tt7 + + + tr0 = 6.451939325286488e-08 + tr1 = -7.306388137342143e-07 + tr2 = -1.3709065148333262e-05 + tr3 = 0.00019109962089098182 + + to0 = 1.4379320027061375e-08 + to1 = -2.0674525898850674e-07 + to2 = -6.8950970846611e-06 + to3 = 0.00012199648268521026 + + tn0 = 1.4023940955902878e-10 + tn1 = -1.4752557214976321e-08 + tn2 = 5.90998487691812e-07 + tn3 = -1.0920804077770066e-05 + tn4 = 8.898205876940546e-05 + tn5 = -0.00021123340439418298 + + tt0 = 1.92409564131838e-12 + tt1 = -5.765467086754962e-10 + tt2 = 7.276979099726975e-08 + tt3 = -5.002261599293387e-06 + tt4 = 0.00020220445539973736 + tt5 = -0.0048088230565883 + tt6 = 0.0623468551971189 + tt7 = -0.34019193746967424 + + ta0 = -1.7787470700719361e-10 + ta1 = 4.4691736529848764e-08 + ta2 = -3.0261975348463414e-06 + ta3 = -0.00011680322286017206 + ta4 = 0.024449377821884846 + ta5 = -1.1228628619105638 + ta6 = 17.358026773905973 + + IF ( uref .LE. 7.0 ) THEN + znott = (0.0185 / 9.8*(7.59e-4*uref**2+2.46e-2*uref)**2) + ELSEIF ( uref .GE. 7.0 .AND. uref .LT. 12.5 ) THEN + znott = tr3 + tr2*uref + tr1*uref**2 + tr0*uref**3 + ELSEIF ( uref .GE. 12.5 .AND. uref .LT. 15.0 ) THEN + znott = to3 + to2*uref + to1*uref**2 + to0*uref**3 + ELSEIF ( uref .GE. 15.0 .AND. uref .LT. 30.0) THEN + znott = tn5 + tn4*uref + tn3*uref**2 + tn2*uref**3 + tn1*uref**4 + & + tn0*uref**5 + ELSEIF ( uref .GE. 30.0 .AND. uref .LT. 60.0) THEN + znott = tt7 + tt6*uref + tt5*uref**2 + tt4*uref**3 + tt3*uref**4 + & + tt2*uref**5 + tt1*uref**6 + tt0*uref**7 + ELSE + znott = ta6 + ta5*uref + ta4*uref**2 + ta3*uref**3 + ta2*uref**4 + & + ta1*uref**5 + ta0*uref**6 + END IF + + END SUBROUTINE znot_t_v1 + + SUBROUTINE znot_t_v0(uref,znott) + IMPLICIT NONE + +! uref(m/s) : Reference level wind +! znott(meter): Roughness scale for temperature/moisture +! Author : Biju Thomas on 02/07/2014 + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + + IF ( uref .LT. 7.0 ) THEN + znott = (0.0185 / 9.8*(7.59e-4*uref**2+2.46e-2*uref)**2) + ELSE + znott = (0.2375*exp(-0.5250*uref) + 0.0025*exp(-0.0211*uref))*0.01 + END IF + + END SUBROUTINE znot_t_v0 + + + SUBROUTINE znot_t_v2(uu,znott) + IMPLICIT NONE + +! uu in MKS +! znott in m +! Biju Thomas on 02/12/2015 +! + + REAL, INTENT(IN) :: uu + REAL, INTENT(OUT):: znott + REAL :: ta0, ta1, ta2, ta3, ta4, ta5, ta6 + REAL :: tb0, tb1, tb2, tb3, tb4, tb5, tb6 + REAL :: tt0, tt1, tt2, tt3, tt4, tt5, tt6 + + ta0 = 2.51715926619e-09 + ta1 = -1.66917514012e-07 + ta2 = 4.57345863551e-06 + ta3 = -6.64883696932e-05 + ta4 = 0.00054390175125 + ta5 = -0.00239645231325 + ta6 = 0.00453024927761 + + + tb0 = -1.72935914649e-14 + tb1 = 2.50587455802e-12 + tb2 = -7.90109676541e-11 + tb3 = -4.40976353607e-09 + tb4 = 3.68968179733e-07 + tb5 = -9.43728336756e-06 + tb6 = 8.90731312383e-05 + + tt0 = 4.68042680888e-14 + tt1 = -1.98125754931e-11 + tt2 = 3.41357133496e-09 + tt3 = -3.05130605309e-07 + tt4 = 1.48243563819e-05 + tt5 = -0.000367207751936 + tt6 = 0.00357204479347 + + IF ( uu .LE. 7.0 ) THEN + znott = (0.0185 / 9.8*(7.59e-4*uu**2+2.46e-2*uu)**2) + ELSEIF ( uu .GE. 7.0 .AND. uu .LT. 15. ) THEN + znott = ta6 + ta5*uu + ta4*uu**2 + ta3*uu**3 + ta2*uu**4 + & + ta1*uu**5 + ta0*uu**6 + ELSEIF ( uu .GE. 15.0 .AND. uu .LT. 60.0) THEN + znott = tb6 + tb5*uu + tb4*uu**2 + tb3*uu**3 + tb2*uu**4 + & + tb1*uu**5 + tb0*uu**6 + ELSE + znott = tt6 + tt5*uu + tt4*uu**2 + tt3*uu**3 + tt2*uu**4 + & + tt1*uu**5 + tt0*uu**6 + END IF + + END SUBROUTINE znot_t_v2 + + SUBROUTINE znot_m_v6(uref,znotm) + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znotm + REAL :: p13, p12, p11, p10 + REAL :: p25, p24, p23, p22, p21, p20 + REAL :: p35, p34, p33, p32, p31, p30 + REAL :: p40 + + p13 = -1.296521881682694e-02 + p12 = 2.855780863283819e-01 + p11 = -1.597898515251717e+00 + p10 = -8.396975715683501e+00 + + p25 = 3.790846746036765e-10 + p24 = 3.281964357650687e-09 + p23 = 1.962282433562894e-07 + p22 = -1.240239171056262e-06 + p21 = 1.739759082358234e-07 + p20 = 2.147264020369413e-05 + + p35 = 1.840430200185075e-07 + p34 = -2.793849676757154e-05 + p33 = 1.735308193700643e-03 + p32 = -6.139315534216305e-02 + p31 = 1.255457892775006e+00 + p30 = -1.663993561652530e+01 + + p40 = 4.579369142033410e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + p11*uref + p12*uref**2 + p13*uref**3) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p25*uref**5 + p24*uref**4 + p23*uref**3 + p22*uref**2 + p21*uref + p20 + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p35*uref**5 + p34*uref**4 + p33*uref**3 + p32*uref**2 + p31*uref + p30 ) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v6 + + SUBROUTINE znot_t_v6(uref,znott) + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! +! Bin Liu, NOAA/NCEP/EMC 2017 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + + REAL :: p00 + REAL :: p15, p14, p13, p12, p11, p10 + REAL :: p25, p24, p23, p22, p21, p20 + REAL :: p35, p34, p33, p32, p31, p30 + REAL :: p45, p44, p43, p42, p41, p40 + REAL :: p56, p55, p54, p53, p52, p51, p50 + REAL :: p60 + + p00 = 1.100000000000000e-04 + + p15 = -9.144581627678278e-10 + p14 = 7.020346616456421e-08 + p13 = -2.155602086883837e-06 + p12 = 3.333848806567684e-05 + p11 = -2.628501274963990e-04 + p10 = 8.634221567969181e-04 + + p25 = -8.654513012535990e-12 + p24 = 1.232380050058077e-09 + p23 = -6.837922749505057e-08 + p22 = 1.871407733439947e-06 + p21 = -2.552246987137160e-05 + p20 = 1.428968311457630e-04 + + p35 = 3.207515102100162e-12 + p34 = -2.945761895342535e-10 + p33 = 8.788972147364181e-09 + p32 = -3.814457439412957e-08 + p31 = -2.448983648874671e-06 + p30 = 3.436721779020359e-05 + + p45 = -3.530687797132211e-11 + p44 = 3.939867958963747e-09 + p43 = -1.227668406985956e-08 + p42 = -1.367469811838390e-05 + p41 = 5.988240863928883e-04 + p40 = -7.746288511324971e-03 + + p56 = -1.187982453329086e-13 + p55 = 4.801984186231693e-11 + p54 = -8.049200462388188e-09 + p53 = 7.169872601310186e-07 + p52 = -3.581694433758150e-05 + p51 = 9.503919224192534e-04 + p50 = -1.036679430885215e-02 + + p60 = 4.751256171799112e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p15*uref**5 + p14*uref**4 + p13*uref**3 + p12*uref**2 + p11*uref + p10 + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p25*uref**5 + p24*uref**4 + p23*uref**3 + p22*uref**2 + p21*uref + p20 + elseif (uref > 21.6 .and. uref <= 42.2) then + znott = p35*uref**5 + p34*uref**4 + p33*uref**3 + p32*uref**2 + p31*uref + p30 + elseif ( uref > 42.2 .and. uref <= 53.3) then + znott = p45*uref**5 + p44*uref**4 + p43*uref**3 + p42*uref**2 + p41*uref + p40 + elseif ( uref > 53.3 .and. uref <= 80.0) then + znott = p56*uref**6 + p55*uref**5 + p54*uref**4 + p53*uref**3 + p52*uref**2 + p51*uref + p50 + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v6 + + SUBROUTINE znot_m_v7(uref,znotm) + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znotm + REAL :: p13, p12, p11, p10 + REAL :: p25, p24, p23, p22, p21, p20 + REAL :: p35, p34, p33, p32, p31, p30 + REAL :: p40 + + p13 = -1.296521881682694e-02 + p12 = 2.855780863283819e-01 + p11 = -1.597898515251717e+00 + p10 = -8.396975715683501e+00 + + p25 = 3.790846746036765e-10 + p24 = 3.281964357650687e-09 + p23 = 1.962282433562894e-07 + p22 = -1.240239171056262e-06 + p21 = 1.739759082358234e-07 + p20 = 2.147264020369413e-05 + + p35 = 1.897534489606422e-07 + p34 = -3.019495980684978e-05 + p33 = 1.931392924987349e-03 + p32 = -6.797293095862357e-02 + p31 = 1.346757797103756e+00 + p30 = -1.707846930193362e+01 + + p40 = 3.371427455376717e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + p11*uref + p12*uref**2 + p13*uref**3) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p25*uref**5 + p24*uref**4 + p23*uref**3 + p22*uref**2 + p21*uref + p20 + elseif (uref > 15.7 .and. uref <= 53.0) then + znotm = exp( p35*uref**5 + p34*uref**4 + p33*uref**3 + p32*uref**2 + p31*uref + p30 ) + elseif ( uref > 53.0) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v7 + + SUBROUTINE znot_t_v7(uref,znott) + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! To be compatible with the slightly decreased Cd for higher wind speed +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + + REAL :: p00 + REAL :: p15, p14, p13, p12, p11, p10 + REAL :: p25, p24, p23, p22, p21, p20 + REAL :: p35, p34, p33, p32, p31, p30 + REAL :: p45, p44, p43, p42, p41, p40 + REAL :: p56, p55, p54, p53, p52, p51, p50 + REAL :: p60 + + p00 = 1.100000000000000e-04 + + p15 = -9.193764479895316e-10 + p14 = 7.052217518653943e-08 + p13 = -2.163419217747114e-06 + p12 = 3.342963077911962e-05 + p11 = -2.633566691328004e-04 + p10 = 8.644979973037803e-04 + + p25 = -9.402722450219142e-12 + p24 = 1.325396583616614e-09 + p23 = -7.299148051141852e-08 + p22 = 1.982901461144764e-06 + p21 = -2.680293455916390e-05 + p20 = 1.484341646128200e-04 + + p35 = 7.921446674311864e-12 + p34 = -1.019028029546602e-09 + p33 = 5.251986927351103e-08 + p32 = -1.337841892062716e-06 + p31 = 1.659454106237737e-05 + p30 = -7.558911792344770e-05 + + p45 = -2.694370426850801e-10 + p44 = 5.817362913967911e-08 + p43 = -5.000813324746342e-06 + p42 = 2.143803523428029e-04 + p41 = -4.588070983722060e-03 + p40 = 3.924356617245624e-02 + + p56 = -1.663918773476178e-13 + p55 = 6.724854483077447e-11 + p54 = -1.127030176632823e-08 + p53 = 1.003683177025925e-06 + p52 = -5.012618091180904e-05 + p51 = 1.329762020689302e-03 + p50 = -1.450062148367566e-02 + + p60 = 6.840803042788488e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p15*uref**5 + p14*uref**4 + p13*uref**3 + p12*uref**2 + p11*uref + p10 + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p25*uref**5 + p24*uref**4 + p23*uref**3 + p22*uref**2 + p21*uref + p20 + elseif (uref > 21.6 .and. uref <= 42.6) then + znott = p35*uref**5 + p34*uref**4 + p33*uref**3 + p32*uref**2 + p31*uref + p30 + elseif ( uref > 42.6 .and. uref <= 53.0) then + znott = p45*uref**5 + p44*uref**4 + p43*uref**3 + p42*uref**2 + p41*uref + p40 + elseif ( uref > 53.0 .and. uref <= 80.0) then + znott = p56*uref**6 + p55*uref**5 + p54*uref**4 + p53*uref**3 + p52*uref**2 + p51*uref + p50 + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v7 + + SUBROUTINE znot_m_v8(uref,znotm) + IMPLICIT NONE +! Calculate areodynamical roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Cd-U10 relationship from COARE V3.5 (Edson et al. 2013) +! For high winds, try to fit available observational data +! Comparing to znot_t_v6, slightly decrease Cd for higher wind speed +! And this is another variation similar to v7 +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znotm(meter): areodynamical roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znotm + REAL :: p13, p12, p11, p10 + REAL :: p25, p24, p23, p22, p21, p20 + REAL :: p35, p34, p33, p32, p31, p30 + REAL :: p40 + + p13 = -1.296521881682694e-02 + p12 = 2.855780863283819e-01 + p11 = -1.597898515251717e+00 + p10 = -8.396975715683501e+00 + + p25 = 3.790846746036765e-10 + p24 = 3.281964357650687e-09 + p23 = 1.962282433562894e-07 + p22 = -1.240239171056262e-06 + p21 = 1.739759082358234e-07 + p20 = 2.147264020369413e-05 + + p35 = 1.897534489606422e-07 + p34 = -3.019495980684978e-05 + p33 = 1.931392924987349e-03 + p32 = -6.797293095862357e-02 + p31 = 1.346757797103756e+00 + p30 = -1.707846930193362e+01 + + p40 = 3.886804744928044e-04 + + if (uref >= 0.0 .and. uref <= 6.5 ) then + znotm = exp( p10 + p11*uref + p12*uref**2 + p13*uref**3) + elseif (uref > 6.5 .and. uref <= 15.7) then + znotm = p25*uref**5 + p24*uref**4 + p23*uref**3 + p22*uref**2 + p21*uref + p20 + elseif (uref > 15.7 .and. uref <= 51.5) then + znotm = exp( p35*uref**5 + p34*uref**4 + p33*uref**3 + p32*uref**2 + p31*uref + p30 ) + elseif ( uref > 51.5) then + znotm = p40 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_m_v8 + + SUBROUTINE znot_t_v8(uref,znott) + IMPLICIT NONE +! Calculate scalar roughness over water with input 10-m wind +! For low-to-moderate winds, try to match the Ck-U10 relationship from COARE algorithm +! For high winds, try to retain the Ck-U10 relationship of FY2015 HWRF +! To be compatible with the slightly decreased Cd for higher wind speed +! And this is another variation similar to v7 +! +! Bin Liu, NOAA/NCEP/EMC 2018 +! +! uref(m/s) : wind speed at 10-m height +! znott(meter): scalar roughness scale over water +! + + REAL, INTENT(IN) :: uref + REAL, INTENT(OUT):: znott + + REAL :: p00 + REAL :: p15, p14, p13, p12, p11, p10 + REAL :: p25, p24, p23, p22, p21, p20 + REAL :: p35, p34, p33, p32, p31, p30 + REAL :: p45, p44, p43, p42, p41, p40 + REAL :: p56, p55, p54, p53, p52, p51, p50 + REAL :: p60 + + p00 = 1.100000000000000e-04 + + p15 = -9.193764479895316e-10 + p14 = 7.052217518653943e-08 + p13 = -2.163419217747114e-06 + p12 = 3.342963077911962e-05 + p11 = -2.633566691328004e-04 + p10 = 8.644979973037803e-04 + + p25 = -9.402722450219142e-12 + p24 = 1.325396583616614e-09 + p23 = -7.299148051141852e-08 + p22 = 1.982901461144764e-06 + p21 = -2.680293455916390e-05 + p20 = 1.484341646128200e-04 + + p35 = 7.921446674311864e-12 + p34 = -1.019028029546602e-09 + p33 = 5.251986927351103e-08 + p32 = -1.337841892062716e-06 + p31 = 1.659454106237737e-05 + p30 = -7.558911792344770e-05 + + p45 = -2.706461188613193e-10 + p44 = 5.845859022891930e-08 + p43 = -5.027577045502003e-06 + p42 = 2.156326523752734e-04 + p41 = -4.617267288861201e-03 + p40 = 3.951492707214883e-02 + + p56 = -1.112896580069263e-13 + p55 = 4.450334755105140e-11 + p54 = -7.375373918500171e-09 + p53 = 6.493685149526543e-07 + p52 = -3.206421106713471e-05 + p51 = 8.407596231678149e-04 + p50 = -9.027924333673693e-03 + + p60 = 5.791179079892191e-05 + + if (uref >= 0.0 .and. uref < 5.9 ) then + znott = p00 + elseif (uref >= 5.9 .and. uref <= 15.4) then + znott = p15*uref**5 + p14*uref**4 + p13*uref**3 + p12*uref**2 + p11*uref + p10 + elseif (uref > 15.4 .and. uref <= 21.6) then + znott = p25*uref**5 + p24*uref**4 + p23*uref**3 + p22*uref**2 + p21*uref + p20 + elseif (uref > 21.6 .and. uref <= 42.6) then + znott = p35*uref**5 + p34*uref**4 + p33*uref**3 + p32*uref**2 + p31*uref + p30 + elseif ( uref > 42.6 .and. uref <= 51.5) then + znott = p45*uref**5 + p44*uref**4 + p43*uref**3 + p42*uref**2 + p41*uref + p40 + elseif ( uref > 51.5 .and. uref <= 80.0) then + znott = p56*uref**6 + p55*uref**5 + p54*uref**4 + p53*uref**3 + p52*uref**2 + p51*uref + p50 + elseif ( uref > 80.0) then + znott = p60 + else + print*, 'Wrong input uref value:',uref + endif + + END SUBROUTINE znot_t_v8 + + SUBROUTINE znot_wind10m(w10m,znott,znotm,icoef_sf) + IMPLICIT NONE + +! w10m(m/s) : 10-m wind speed +! znott(meter): Roughness scale for temperature/moisture, zt +! znotm(meter): Roughness scale for momentum, z0 +! Author : Weiguo Wang on 02/24/2016 +! convert from icoef=0,1,2 to have 10m level cd, ch match obs + REAL, INTENT(IN) :: w10m + INTEGER, INTENT(IN) :: icoef_sf + REAL, INTENT(OUT):: znott, znotm + + real :: zm,zt,windmks, zlev,z10, tmp, zlevt, aaa, zm1,zt1 + zlev=20.0 + zlevt=10.0 + z10=10.0 + windmks=w10m + if (windmks > 85.0) windmks=85.0 + if (windmks < 1.0) windmks=1.0 + if ( icoef_sf .EQ. 1) then + call znot_m_v1(windmks,zm1) + call znot_t_v1(windmks,zt1) + + else if ( icoef_sf .EQ. 0 ) then + call znot_m_v0(windmks,zm1) + call znot_t_v0(windmks,zt1) + + else if( icoef_sf .EQ. 2 ) then + call znot_m_v1(windmks,zm1) + call znot_t_v2(windmks,zt1) + + else if( icoef_sf .EQ. 3 ) then + call znot_m_v1(windmks,zm) + call znot_t_v2(windmks,zt) +!! adjust a little to match obs at 10m, cd is reduced + tmp=0.4*0.4/(alog(zlev/zm))**2 ! cd at zlev + zm1=z10/exp( sqrt(0.4*0.4/(tmp*0.95-0.0002)) ) +!ch + tmp=0.4*0.4/(alog(zlevt/zm)*alog(zlevt/zt)) ! ch at zlev using old formula + zt1=z10/exp( 0.4*0.4/( 0.95*tmp*alog(z10/zm1) ) ) + + else if( icoef_sf .EQ. 4 ) then + + call znot_m_v1(windmks,zm) + call znot_t_v2(windmks,zt) +!! for wind<20, cd similar to icoef=2 at 10m, then reduced + tmp=0.4*0.4/(alog(10.0/zm))**2 ! cd at zlev + aaa=0.75 + if (windmks < 20) then + aaa=0.99 + elseif(windmks < 45.0) then + aaa=0.99+(windmks-20)*(0.75-0.99)/(45.0-20.0) + endif + zm1=z10/exp( sqrt(0.4*0.4/(tmp*aaa)) ) +!ch + tmp=0.4*0.4/(alog(zlevt/zm)*alog(zlevt/zt)) ! ch at zlev using old formula + zt1=z10/exp( 0.4*0.4/( 0.95*tmp*alog(z10/zm1) ) ) + + else if( icoef_sf .EQ. 5 ) then + + call znot_m_v1(windmks,zm) + call znot_t_v2(windmks,zt) +!! for wind<20, cd similar to icoef=2 at 10m, then reduced + tmp=0.4*0.4/(alog(10.0/zm))**2 ! cd at zlev + aaa=0.80 + if (windmks < 20) then + aaa=1.0 + elseif(windmks < 45.0) then + aaa=1.0+(windmks-20)*(0.80-1.0)/(45.0-20.0) + endif + zm1=z10/exp( sqrt(0.4*0.4/(tmp*aaa)) ) +!ch + tmp=0.4*0.4/(alog(zlevt/zm)*alog(zlevt/zt)) ! ch at zlev using old formula + zt1=z10/exp( 0.4*0.4/( 1.0*tmp*alog(z10/zm1) ) ) + + else if( icoef_sf .EQ. 6 ) then + call znot_m_v6(windmks,zm1) + call znot_t_v6(windmks,zt1) + else if( icoef_sf .EQ. 7 ) then + call znot_m_v7(windmks,zm1) + call znot_t_v7(windmks,zt1) + else if( icoef_sf .EQ. 8 ) then + call znot_m_v8(windmks,zm1) + call znot_t_v8(windmks,zt1) + else + write(0,*)'stop, icoef_sf must be one of 0,1,2,3,4,5,6,7,8' + stop + endif + znott=zt1 + znotm=zm1 + + end subroutine znot_wind10m + +END MODULE module_sf_exchcoef + diff --git a/physics/module_sf_noahlsm.F90 b/physics/module_sf_noahlsm.F90 new file mode 100644 index 000000000..9336abf65 --- /dev/null +++ b/physics/module_sf_noahlsm.F90 @@ -0,0 +1,4773 @@ + MODULE module_sf_noahlsm + +!ckay=KIRAN ALAPATY @ US EPA -- November 01, 2015 +! +! Tim Glotfelty@CNSU; AJ Deng@PSU +!modified for use with FASDAS +!Flux Adjusting Surface Data Assimilation System to assimilate +!surface layer and soil layers temperature and moisture using +! surfance reanalsys +!Reference: Alapaty et al., 2008: Development of the flux-adjusting surface +! data assimilation system for mesoscale models. JAMC, 47, 2331-2350 +! + + REAL, PARAMETER :: EMISSI_S = 0.95 + +! VEGETATION PARAMETERS + INTEGER :: LUCATS , BARE + INTEGER :: NATURAL + INTEGER :: LOW_DENSITY_RESIDENTIAL, HIGH_DENSITY_RESIDENTIAL, HIGH_INTENSITY_INDUSTRIAL + integer, PARAMETER :: NLUS=50 + CHARACTER(LEN=256) LUTYPE + INTEGER, DIMENSION(1:NLUS) :: NROTBL + real, dimension(1:NLUS) :: SNUPTBL, RSTBL, RGLTBL, HSTBL, & + SHDTBL, MAXALB, & + EMISSMINTBL, EMISSMAXTBL, & + LAIMINTBL, LAIMAXTBL, & + Z0MINTBL, Z0MAXTBL, & + ALBEDOMINTBL, ALBEDOMAXTBL, & + ZTOPVTBL,ZBOTVTBL + REAL :: TOPT_DATA,CMCMAX_DATA,CFACTR_DATA,RSMAX_DATA + +! SOIL PARAMETERS + INTEGER :: SLCATS + INTEGER, PARAMETER :: NSLTYPE=30 + CHARACTER(LEN=256) SLTYPE + REAL, DIMENSION (1:NSLTYPE) :: BB,DRYSMC,F11, & + MAXSMC, REFSMC,SATPSI,SATDK,SATDW, WLTSMC,QTZ + +! LSM GENERAL PARAMETERS + INTEGER :: SLPCATS + INTEGER, PARAMETER :: NSLOPE=30 + REAL, DIMENSION (1:NSLOPE) :: SLOPE_DATA + REAL :: SBETA_DATA,FXEXP_DATA,CSOIL_DATA,SALP_DATA,REFDK_DATA, & + REFKDT_DATA,FRZK_DATA,ZBOT_DATA, SMLOW_DATA,SMHIGH_DATA, & + CZIL_DATA + REAL :: LVCOEF_DATA + + integer, private :: iloc, jloc +!$omp threadprivate(iloc, jloc) +! + CONTAINS +! + + SUBROUTINE SFLX (IILOC,JJLOC,FFROZP,ISURBAN,DT,ZLVL,NSOIL,SLDPTH, & !C + LOCAL, & !L + LLANDUSE, LSOIL, & !CL + LWDN,SOLDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2,SFCSPD, & !F + COSZ,PRCPRAIN, SOLARDIRECT, & !F + TH2,Q2SAT,DQSDT2, & !I + VEGTYP,SOILTYP,SLOPETYP,SHDFAC,SHDMIN,SHDMAX, & !I + ALB, SNOALB,TBOT, Z0BRD, Z0, EMISSI, EMBRD, & !S + CMC,T1,STC,SMC,SH2O,SNOWH,SNEQV,ALBEDO,CH,CM, & !H + CP, RD, SIGMA, CPH2O, CPICE, LSUBF, & !physical constants +! ---------------------------------------------------------------------- +! OUTPUTS, DIAGNOSTICS, PARAMETERS BELOW GENERALLY NOT NECESSARY WHEN +! COUPLED WITH E.G. A NWP MODEL (SUCH AS THE NOAA/NWS/NCEP MESOSCALE ETA +! MODEL). OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES. +! ---------------------------------------------------------------------- + ETA,SHEAT, ETA_KINEMATIC,FDOWN, & !O + EC,EDIR,ET,ETT,ESNOW,DRIP,DEW, & !O + BETA,ETP,SSOIL, & !O + FLX1,FLX2,FLX3, & !O + FLX4,FVB,FBUR,FGSN,UA_PHYS, & !UA + SNOMLT,SNCOVR, & !O + RUNOFF1,RUNOFF2,RUNOFF3, & !O + RC,PC,RSMIN,XLAI,RCS,RCT,RCQ,RCSOIL, & !O + SOILW,SOILM,Q1,SMAV, & !D + RDLAI2D,USEMONALB, & + SNOTIME1, & + RIBB, & + SMCWLT,SMCDRY,SMCREF,SMCMAX,NROOT, & + SFHEAD1RT, & !I + INFXS1RT,ETPND1,OPT_THCND,AOASIS, & !P + XSDA_QFX,HFX_PHY,QFX_PHY,XQNORM, & !fasdas + fasdas,HCPCT_FASDAS, & !fasdas + errflg, errmsg) + +! ---------------------------------------------------------------------- +! SUBROUTINE SFLX - UNIFIED NOAHLSM VERSION 1.0 JULY 2007 +! ---------------------------------------------------------------------- +! SUB-DRIVER FOR "Noah LSM" FAMILY OF PHYSICS SUBROUTINES FOR A +! SOIL/VEG/SNOWPACK LAND-SURFACE MODEL TO UPDATE SOIL MOISTURE, SOIL +! ICE, SOIL TEMPERATURE, SKIN TEMPERATURE, SNOWPACK WATER CONTENT, +! SNOWDEPTH, AND ALL TERMS OF THE SURFACE ENERGY BALANCE AND SURFACE +! WATER BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF DOWNWARD +! RADIATION AND PRECIP) +! ---------------------------------------------------------------------- +! SFLX ARGUMENT LIST KEY: +! ---------------------------------------------------------------------- +! C CONFIGURATION INFORMATION +! L LOGICAL +! CL 4-string character bearing logical meaning +! F FORCING DATA +! I OTHER (INPUT) FORCING DATA +! S SURFACE CHARACTERISTICS +! H HISTORY (STATE) VARIABLES +! O OUTPUT VARIABLES +! D DIAGNOSTIC OUTPUT +! P Parameters +! Msic Miscellaneous terms passed from gridded driver +! ---------------------------------------------------------------------- +! 1. CONFIGURATION INFORMATION (C): +! ---------------------------------------------------------------------- +! DT TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND +! 1800 SECS OR LESS) +! ZLVL HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES +! NSOIL NUMBER OF SOIL LAYERS (AT LEAST 2, AND NOT GREATER THAN +! PARAMETER NSOLD SET BELOW) +! SLDPTH THE THICKNESS OF EACH SOIL LAYER (M) +! ---------------------------------------------------------------------- +! 2. LOGICAL: +! ---------------------------------------------------------------------- +! LCH Exchange coefficient (Ch) calculation flag (false: using +! ch-routine SFCDIF; true: Ch is brought in) +! LOCAL Flag for local-site simulation (where there is no +! maps for albedo, veg fraction, and roughness +! true: all LSM parameters (inluding albedo, veg fraction and +! roughness length) will be defined by three tables +! LLANDUSE (=USGS, using USGS landuse classification) +! LSOIL (=STAS, using FAO/STATSGO soil texture classification) +! OPT_THCND option for how to treat thermal conductivity +! ---------------------------------------------------------------------- +! 3. FORCING DATA (F): +! ---------------------------------------------------------------------- +! LWDN LW DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET LONGWAVE) +! SOLDN SOLAR DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET SOLAR) +! SOLNET NET DOWNWARD SOLAR RADIATION ((W M-2; POSITIVE) +! SFCPRS PRESSURE AT HEIGHT ZLVL ABOVE GROUND (PASCALS) +! PRCP PRECIP RATE (KG M-2 S-1) (NOTE, THIS IS A RATE) +! SFCTMP AIR TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND +! TH2 AIR POTENTIAL TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND +! Q2 MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1) +! COSZ Solar zenith angle (not used for now) +! PRCPRAIN Liquid-precipitation rate (KG M-2 S-1) (not used) +! SOLARDIRECT Direct component of downward solar radiation (W M-2) (not used) +! FFROZP FRACTION OF FROZEN PRECIPITATION +! ---------------------------------------------------------------------- +! 4. OTHER FORCING (INPUT) DATA (I): +! ---------------------------------------------------------------------- +! SFCSPD WIND SPEED (M S-1) AT HEIGHT ZLVL ABOVE GROUND +! Q2SAT SAT SPECIFIC HUMIDITY AT HEIGHT ZLVL ABOVE GROUND (KG KG-1) +! DQSDT2 SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP +! (KG KG-1 K-1) +! ---------------------------------------------------------------------- +! 5. CANOPY/SOIL CHARACTERISTICS (S): +! ---------------------------------------------------------------------- +! VEGTYP VEGETATION TYPE (INTEGER INDEX) +! SOILTYP SOIL TYPE (INTEGER INDEX) +! SLOPETYP CLASS OF SFC SLOPE (INTEGER INDEX) +! SHDFAC AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! (FRACTION= 0.0-1.0) +! SHDMIN MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! (FRACTION= 0.0-1.0) <= SHDFAC +! PTU PHOTO THERMAL UNIT (PLANT PHENOLOGY FOR ANNUALS/CROPS) +! (NOT YET USED, BUT PASSED TO REDPRM FOR FUTURE USE IN +! VEG PARMS) +! ALB BACKROUND SNOW-FREE SURFACE ALBEDO (FRACTION), FOR JULIAN +! DAY OF YEAR (USUALLY FROM TEMPORAL INTERPOLATION OF +! MONTHLY MEAN VALUES' CALLING PROG MAY OR MAY NOT +! INCLUDE DIURNAL SUN ANGLE EFFECT) +! SNOALB UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW (E.G. FROM +! ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.) +! TBOT BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR +! TEMPERATURE) +! Z0BRD Background fixed roughness length (M) +! Z0 Time varying roughness length (M) as function of snow depth +! +! EMBRD Background surface emissivity (between 0 and 1) +! EMISSI Surface emissivity (between 0 and 1) +! ---------------------------------------------------------------------- +! 6. HISTORY (STATE) VARIABLES (H): +! ---------------------------------------------------------------------- +! CMC CANOPY MOISTURE CONTENT (M) +! T1 GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K) +! STC(NSOIL) SOIL TEMP (K) +! SMC(NSOIL) TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION) +! SH2O(NSOIL) UNFROZEN SOIL MOISTURE CONTENT (VOLUMETRIC FRACTION) +! NOTE: FROZEN SOIL MOISTURE = SMC - SH2O +! SNOWH ACTUAL SNOW DEPTH (M) +! SNEQV LIQUID WATER-EQUIVALENT SNOW DEPTH (M) +! NOTE: SNOW DENSITY = SNEQV/SNOWH +! ALBEDO SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION) +! =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR +! =FCT(MSNOALB,ALB,VEGTYP,SHDFAC,SHDMIN) WHEN SNEQV>0 +! CH SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE +! (M S-1); NOTE: CH IS TECHNICALLY A CONDUCTANCE SINCE +! IT HAS BEEN MULTIPLIED BY WIND SPEED. +! CM SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM (M S-1); NOTE: +! CM IS TECHNICALLY A CONDUCTANCE SINCE IT HAS BEEN +! MULTIPLIED BY WIND SPEED. +! 6a: Physical constants +! CP specific heat of dry air at constant pressure +! RD gas constant for dry air +! SIGMA Steffan-Boltzmann constant +! CPH2O specific heat of liquid water +! CPICE specific heat of ice +! LSUBF latent heat of fusion for water +! ---------------------------------------------------------------------- +! 7. OUTPUT (O): +! ---------------------------------------------------------------------- +! OUTPUT VARIABLES NECESSARY FOR A COUPLED NUMERICAL WEATHER PREDICTION +! MODEL, E.G. NOAA/NWS/NCEP MESOSCALE ETA MODEL. FOR THIS APPLICATION, +! THE REMAINING OUTPUT/DIAGNOSTIC/PARAMETER BLOCKS BELOW ARE NOT +! NECESSARY. OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES. +! ETA ACTUAL LATENT HEAT FLUX (W m-2: NEGATIVE, IF UP FROM +! SURFACE) +! ETA_KINEMATIC atctual latent heat flux in Kg m-2 s-1 +! SHEAT SENSIBLE HEAT FLUX (W M-2: POSITIVE, IF UPWARD FROM +! SURFACE) +! FDOWN Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN +! ---------------------------------------------------------------------- +! EC CANOPY WATER EVAPORATION (W m-2) +! EDIR DIRECT SOIL EVAPORATION (W m-2) +! ET(NSOIL) PLANT TRANSPIRATION FROM A PARTICULAR ROOT (SOIL) LAYER +! (W m-2) +! ETT TOTAL PLANT TRANSPIRATION (W m-2) +! ESNOW SUBLIMATION FROM (OR DEPOSITION TO IF <0) SNOWPACK +! (W m-2) +! DRIP THROUGH-FALL OF PRECIP AND/OR DEW IN EXCESS OF CANOPY +! WATER-HOLDING CAPACITY (M) +! DEW DEWFALL (OR FROSTFALL FOR T<273.15) (M) +! ---------------------------------------------------------------------- +! BETA RATIO OF ACTUAL/POTENTIAL EVAP (DIMENSIONLESS) +! ETP POTENTIAL EVAPORATION (W m-2) +! SSOIL SOIL HEAT FLUX (W M-2: NEGATIVE IF DOWNWARD FROM SURFACE) +! ---------------------------------------------------------------------- +! FLX1 PRECIP-SNOW SFC (W M-2) +! FLX2 FREEZING RAIN LATENT HEAT FLUX (W M-2) +! FLX3 PHASE-CHANGE HEAT FLUX FROM SNOWMELT (W M-2) +! ---------------------------------------------------------------------- +! SNOMLT SNOW MELT (M) (WATER EQUIVALENT) +! SNCOVR FRACTIONAL SNOW COVER (UNITLESS FRACTION, 0-1) +! ---------------------------------------------------------------------- +! RUNOFF1 SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE +! RUNOFF2 SUBSURFACE RUNOFF (M S-1), DRAINAGE OUT BOTTOM OF LAST +! SOIL LAYER (BASEFLOW) +! RUNOFF3 NUMERICAL TRUNCTATION IN EXCESS OF POROSITY (SMCMAX) +! FOR A GIVEN SOIL LAYER AT THE END OF A TIME STEP (M S-1). +! Note: the above RUNOFF2 is actually the sum of RUNOFF2 and RUNOFF3 +! ---------------------------------------------------------------------- +! RC CANOPY RESISTANCE (S M-1) +! PC PLANT COEFFICIENT (UNITLESS FRACTION, 0-1) WHERE PC*ETP +! = ACTUAL TRANSP +! XLAI LEAF AREA INDEX (DIMENSIONLESS) +! RSMIN MINIMUM CANOPY RESISTANCE (S M-1) +! RCS INCOMING SOLAR RC FACTOR (DIMENSIONLESS) +! RCT AIR TEMPERATURE RC FACTOR (DIMENSIONLESS) +! RCQ ATMOS VAPOR PRESSURE DEFICIT RC FACTOR (DIMENSIONLESS) +! RCSOIL SOIL MOISTURE RC FACTOR (DIMENSIONLESS) +! ---------------------------------------------------------------------- +! 8. DIAGNOSTIC OUTPUT (D): +! ---------------------------------------------------------------------- +! SOILW AVAILABLE SOIL MOISTURE IN ROOT ZONE (UNITLESS FRACTION +! BETWEEN SMCWLT AND SMCMAX) +! SOILM TOTAL SOIL COLUMN MOISTURE CONTENT (FROZEN+UNFROZEN) (M) +! Q1 Effective mixing ratio at surface (kg kg-1), used for +! diagnosing the mixing ratio at 2 meter for coupled model +! SMAV Soil Moisture Availability for each layer, as a fraction +! between SMCWLT and SMCMAX. +! Documentation for SNOTIME1 and SNOABL2 ????? +! What categories of arguments do these variables fall into ???? +! Documentation for RIBB ????? +! What category of argument does RIBB fall into ????? +! ---------------------------------------------------------------------- +! 9. PARAMETERS (P): +! ---------------------------------------------------------------------- +! SMCWLT WILTING POINT (VOLUMETRIC) +! SMCDRY DRY SOIL MOISTURE THRESHOLD WHERE DIRECT EVAP FRM TOP +! LAYER ENDS (VOLUMETRIC) +! SMCREF SOIL MOISTURE THRESHOLD WHERE TRANSPIRATION BEGINS TO +! STRESS (VOLUMETRIC) +! SMCMAX POROSITY, I.E. SATURATED VALUE OF SOIL MOISTURE +! (VOLUMETRIC) +! NROOT NUMBER OF ROOT LAYERS, A FUNCTION OF VEG TYPE, DETERMINED +! IN SUBROUTINE REDPRM. +! ---------------------------------------------------------------------- + + + IMPLICIT NONE +! ---------------------------------------------------------------------- + +! DECLARATIONS - LOGICAL AND CHARACTERS +! ---------------------------------------------------------------------- + + INTEGER, INTENT(IN) :: IILOC, JJLOC + LOGICAL, INTENT(IN):: LOCAL + LOGICAL :: FRZGRA, SNOWNG + CHARACTER (LEN=256), INTENT(IN):: LLANDUSE, LSOIL + +! ---------------------------------------------------------------------- +! 1. CONFIGURATION INFORMATION (C): +! ---------------------------------------------------------------------- + INTEGER,INTENT(IN) :: NSOIL,SLOPETYP,SOILTYP,VEGTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER,INTENT(OUT):: NROOT + INTEGER KZ, K, iout + +! ---------------------------------------------------------------------- +! 2. LOGICAL: +! ---------------------------------------------------------------------- + LOGICAL, INTENT(IN) :: RDLAI2D + LOGICAL, INTENT(IN) :: USEMONALB + INTEGER, INTENT(IN) :: OPT_THCND + + REAL, INTENT(INOUT):: SFHEAD1RT,INFXS1RT, ETPND1 + + REAL, INTENT(IN) :: SHDMIN,SHDMAX,DT,DQSDT2,LWDN,PRCP,PRCPRAIN, & + Q2,Q2SAT,SFCPRS,SFCSPD,SFCTMP, SNOALB, & + SOLDN,SOLNET,TBOT,TH2,ZLVL, & + FFROZP,AOASIS + REAL, INTENT(IN) :: CP, RD, SIGMA, CPH2O, CPICE, LSUBF + REAL, INTENT(OUT) :: EMBRD + REAL, INTENT(OUT) :: ALBEDO + REAL, INTENT(INOUT):: COSZ, SOLARDIRECT,CH,CM, & + CMC,SNEQV,SNCOVR,SNOWH,T1,XLAI,SHDFAC,Z0BRD, & + EMISSI, ALB + REAL, INTENT(INOUT):: SNOTIME1 + REAL, INTENT(INOUT):: RIBB + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SLDPTH + REAL, DIMENSION(1:NSOIL), INTENT(OUT):: ET + REAL, DIMENSION(1:NSOIL), INTENT(OUT):: SMAV + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O, SMC, STC + REAL,DIMENSION(1:NSOIL):: RTDIS, ZSOIL + + REAL,INTENT(OUT) :: ETA_KINEMATIC,BETA,DEW,DRIP,EC,EDIR,ESNOW,ETA, & + ETP,FLX1,FLX2,FLX3,SHEAT,PC,RUNOFF1,RUNOFF2, & + RUNOFF3,RC,RSMIN,RCQ,RCS,RCSOIL,RCT,SSOIL, & + SMCDRY,SMCMAX,SMCREF,SMCWLT,SNOMLT, SOILM, & + SOILW,FDOWN,Q1 + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL,INTENT(OUT) :: FLX4 ! UA: energy added to sensible heat + REAL,INTENT(OUT) :: FVB ! UA: frac. veg. w/snow beneath + REAL,INTENT(OUT) :: FBUR ! UA: fraction of canopy buried + REAL,INTENT(OUT) :: FGSN ! UA: ground snow cover fraction + REAL :: ZTOPV ! UA: height of canopy top + REAL :: ZBOTV ! UA: height of canopy bottom + REAL :: GAMA ! UA: = EXP(-1.* XLAI) + REAL :: FNET ! UA: + REAL :: ETPN ! UA: + REAL :: RU ! UA: + + REAL :: BEXP,CFACTR,CMCMAX,CSOIL,CZIL,DF1,DF1H,DF1A,DKSAT,DWSAT, & + DSOIL,DTOT,ETT,FRCSNO,FRCSOI,EPSCA,F1,FXEXP,FRZX,HS, & + KDT,LVH2O,PRCP1,PSISAT,QUARTZ,R,RCH,REFKDT,RR,RGL, & + RSMAX, & + RSNOW,SNDENS,SNCOND,SBETA,SN_NEW,SLOPE,SNUP,SALP,SOILWM, & + SOILWW,T1V,T24,T2V,TH2V,TOPT,TFREEZ,TSNOW,ZBOT,Z0,PRCPF, & + ETNS,PTU,LSUBS + REAL :: LVCOEF + REAL :: INTERP_FRACTION + REAL :: LAIMIN, LAIMAX + REAL :: ALBEDOMIN, ALBEDOMAX + REAL :: EMISSMIN, EMISSMAX + REAL :: Z0MIN, Z0MAX + +! ---------------------------------------------------------------------- +! DECLARATIONS - PARAMETERS +! ---------------------------------------------------------------------- + PARAMETER (TFREEZ = 273.15) + PARAMETER (LVH2O = 2.501E+6) + PARAMETER (LSUBS = 2.83E+6) + PARAMETER (R = 287.04) +! +! FASDAS +! + INTEGER, INTENT(IN ) :: fasdas + REAL, INTENT(INOUT) :: XSDA_QFX, XQNORM + REAL, INTENT(INOUT) :: HFX_PHY, QFX_PHY + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! ---------------------------------------------------------------------- +! INITIALIZATION +! ---------------------------------------------------------------------- + errmsg = '' + errflg = 0 + + ILOC = IILOC + JLOC = JJLOC + + RUNOFF1 = 0.0 + RUNOFF2 = 0.0 + RUNOFF3 = 0.0 + SNOMLT = 0.0 + + IF ( .NOT. UA_PHYS ) THEN + FLX4 = 0.0 + FVB = 0.0 + FBUR = 0.0 + FGSN = 0.0 + ENDIF + +! ---------------------------------------------------------------------- +! CALCULATE DEPTH (NEGATIVE) BELOW GROUND FROM TOP SKIN SFC TO BOTTOM OF +! EACH SOIL LAYER. NOTE: SIGN OF ZSOIL IS NEGATIVE (DENOTING BELOW +! GROUND) +! ---------------------------------------------------------------------- + ZSOIL (1) = - SLDPTH (1) + DO KZ = 2,NSOIL + ZSOIL (KZ) = - SLDPTH (KZ) + ZSOIL (KZ -1) + END DO +! ---------------------------------------------------------------------- +! NEXT IS CRUCIAL CALL TO SET THE LAND-SURFACE PARAMETERS, INCLUDING +! SOIL-TYPE AND VEG-TYPE DEPENDENT PARAMETERS. +! ---------------------------------------------------------------------- + CALL REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX,TOPT, & + REFKDT,KDT,SBETA, SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX, & + PSISAT,SLOPE,SNUP,SALP,BEXP,DKSAT,DWSAT, & + SMCMAX,SMCWLT,SMCREF,SMCDRY,F1,QUARTZ,FXEXP, & + RTDIS,SLDPTH,ZSOIL,NROOT,NSOIL,CZIL, & + LAIMIN, LAIMAX, EMISSMIN, EMISSMAX, ALBEDOMIN, & + ALBEDOMAX, Z0MIN, Z0MAX, CSOIL, PTU, LLANDUSE, & + LSOIL,LOCAL,LVCOEF,ZTOPV,ZBOTV,errmsg,errflg) + if(errflg > 0) return + +!urban + IF(VEGTYP==ISURBAN)THEN + SHDFAC=0.05 + RSMIN=400.0 + SMCMAX = 0.45 + SMCREF = 0.42 + SMCWLT = 0.40 + SMCDRY = 0.40 + ENDIF + + IF ( SHDFAC >= SHDMAX ) THEN + EMBRD = EMISSMAX + IF (.NOT. RDLAI2D) THEN + XLAI = LAIMAX + ENDIF + IF (.NOT. USEMONALB) THEN + ALB = ALBEDOMIN + ENDIF + Z0BRD = Z0MAX + ELSE IF ( SHDFAC <= SHDMIN ) THEN + EMBRD = EMISSMIN + IF(.NOT. RDLAI2D) THEN + XLAI = LAIMIN + ENDIF + IF(.NOT. USEMONALB) then + ALB = ALBEDOMAX + ENDIF + Z0BRD = Z0MIN + ELSE + + IF ( SHDMAX > SHDMIN ) THEN + + INTERP_FRACTION = ( SHDFAC - SHDMIN ) / ( SHDMAX - SHDMIN ) + ! Bound INTERP_FRACTION between 0 and 1 + INTERP_FRACTION = MIN ( INTERP_FRACTION, 1.0 ) + INTERP_FRACTION = MAX ( INTERP_FRACTION, 0.0 ) + ! Scale Emissivity and LAI between EMISSMIN and EMISSMAX by INTERP_FRACTION + EMBRD = ( ( 1.0 - INTERP_FRACTION ) * EMISSMIN ) + ( INTERP_FRACTION * EMISSMAX ) + IF (.NOT. RDLAI2D) THEN + XLAI = ( ( 1.0 - INTERP_FRACTION ) * LAIMIN ) + ( INTERP_FRACTION * LAIMAX ) + ENDIF + if (.not. USEMONALB) then + ALB = ( ( 1.0 - INTERP_FRACTION ) * ALBEDOMAX ) + ( INTERP_FRACTION * ALBEDOMIN ) + endif + Z0BRD = ( ( 1.0 - INTERP_FRACTION ) * Z0MIN ) + ( INTERP_FRACTION * Z0MAX ) + + ELSE + + EMBRD = 0.5 * EMISSMIN + 0.5 * EMISSMAX + IF (.NOT. RDLAI2D) THEN + XLAI = 0.5 * LAIMIN + 0.5 * LAIMAX + ENDIF + if (.not. USEMONALB) then + ALB = 0.5 * ALBEDOMIN + 0.5 * ALBEDOMAX + endif + Z0BRD = 0.5 * Z0MIN + 0.5 * Z0MAX + + ENDIF + + ENDIF +! ---------------------------------------------------------------------- +! INITIALIZE PRECIPITATION LOGICALS. +! ---------------------------------------------------------------------- + SNOWNG = .FALSE. + FRZGRA = .FALSE. + +! ---------------------------------------------------------------------- +! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND +! SNOW THERMAL CONDUCTIVITY "SNCOND" (NOTE THAT CSNOW IS A FUNCTION +! SUBROUTINE) +! ---------------------------------------------------------------------- + IF ( SNEQV <= 1.E-7 ) THEN ! safer IF kmh (2008/03/25) + SNEQV = 0.0 + SNDENS = 0.0 + SNOWH = 0.0 + SNCOND = 1.0 + ELSE + SNDENS = SNEQV / SNOWH + IF(SNDENS > 1.0) THEN + errmsg = 'Physical snow depth is less than snow water equiv.' + errflg = 1 + return + ENDIF + CALL CSNOW (SNCOND,SNDENS) + END IF +! ---------------------------------------------------------------------- +! DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS. +! IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING! +! IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND +! TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING. +! ---------------------------------------------------------------------- + IF (PRCP > 0.0) THEN +! snow defined when fraction of frozen precip (FFROZP) > 0.5, +! passed in from model microphysics. + IF (FFROZP .GT. 0.5) THEN + SNOWNG = .TRUE. + ELSE + IF (T1 <= TFREEZ) FRZGRA = .TRUE. + END IF + END IF +! ---------------------------------------------------------------------- +! IF EITHER PRCP FLAG IS SET, DETERMINE NEW SNOWFALL (CONVERTING PRCP +! RATE FROM KG M-2 S-1 TO A LIQUID EQUIV SNOW DEPTH IN METERS) AND ADD +! IT TO THE EXISTING SNOWPACK. +! NOTE THAT SINCE ALL PRECIP IS ADDED TO SNOWPACK, NO PRECIP INFILTRATES +! INTO THE SOIL SO THAT PRCP1 IS SET TO ZERO. +! ---------------------------------------------------------------------- + IF ( (SNOWNG) .OR. (FRZGRA) ) THEN + SN_NEW = PRCP * DT * 0.001 + SNEQV = SNEQV + SN_NEW + PRCPF = 0.0 + +! ---------------------------------------------------------------------- +! UPDATE SNOW DENSITY BASED ON NEW SNOWFALL, USING OLD AND NEW SNOW. +! UPDATE SNOW THERMAL CONDUCTIVITY +! ---------------------------------------------------------------------- + CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS) + CALL CSNOW (SNCOND,SNDENS) + +! ---------------------------------------------------------------------- +! PRECIP IS LIQUID (RAIN), HENCE SAVE IN THE PRECIP VARIABLE THAT +! LATER CAN WHOLELY OR PARTIALLY INFILTRATE THE SOIL (ALONG WITH +! ANY CANOPY "DRIP" ADDED TO THIS LATER) +! ---------------------------------------------------------------------- + ELSE + PRCPF = PRCP + ENDIF +! ---------------------------------------------------------------------- +! DETERMINE SNOWCOVER AND ALBEDO OVER LAND. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! IF SNOW DEPTH=0, SET SNOW FRACTION=0, ALBEDO=SNOW FREE ALBEDO. +! ---------------------------------------------------------------------- + IF (SNEQV == 0.0) THEN + SNCOVR = 0.0 + ALBEDO = ALB + EMISSI = EMBRD + IF(UA_PHYS) FGSN = 0.0 + IF(UA_PHYS) FVB = 0.0 + IF(UA_PHYS) FBUR = 0.0 + ELSE +! ---------------------------------------------------------------------- +! DETERMINE SNOW FRACTIONAL COVERAGE. +! DETERMINE SURFACE ALBEDO MODIFICATION DUE TO SNOWDEPTH STATE. +! ---------------------------------------------------------------------- + CALL SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR, & + XLAI,SHDFAC,FVB,GAMA,FBUR, & + FGSN,ZTOPV,ZBOTV,UA_PHYS) + + IF ( UA_PHYS ) then + IF(SFCTMP <= T1) THEN + RU = 0. + ELSE + RU = 100.*SHDFAC*FGSN*MIN((SFCTMP-T1)/5., 1.)*(1.-EXP(-XLAI)) + ENDIF + CH = CH/(1.+RU*CH) + ENDIF + + SNCOVR = MIN(SNCOVR,0.98) + + CALL ALCALC (ALB,SNOALB,EMBRD,SHDFAC,SHDMIN,SNCOVR,T1, & + ALBEDO,EMISSI,DT,SNOWNG,SNOTIME1,LVCOEF) + ENDIF +! ---------------------------------------------------------------------- +! NEXT CALCULATE THE SUBSURFACE HEAT FLUX, WHICH FIRST REQUIRES +! CALCULATION OF THE THERMAL DIFFUSIVITY. TREATMENT OF THE +! LATTER FOLLOWS THAT ON PAGES 148-149 FROM "HEAT TRANSFER IN +! COLD CLIMATES", BY V. J. LUNARDINI (PUBLISHED IN 1981 +! BY VAN NOSTRAND REINHOLD CO.) I.E. TREATMENT OF TWO CONTIGUOUS +! "PLANE PARALLEL" MEDIUMS (NAMELY HERE THE FIRST SOIL LAYER +! AND THE SNOWPACK LAYER, IF ANY). THIS DIFFUSIVITY TREATMENT +! BEHAVES WELL FOR BOTH ZERO AND NONZERO SNOWPACK, INCLUDING THE +! LIMIT OF VERY THIN SNOWPACK. THIS TREATMENT ALSO ELIMINATES +! THE NEED TO IMPOSE AN ARBITRARY UPPER BOUND ON SUBSURFACE +! HEAT FLUX WHEN THE SNOWPACK BECOMES EXTREMELY THIN. +! ---------------------------------------------------------------------- +! FIRST CALCULATE THERMAL DIFFUSIVITY OF TOP SOIL LAYER, USING +! BOTH THE FROZEN AND LIQUID SOIL MOISTURE, FOLLOWING THE +! SOIL THERMAL DIFFUSIVITY FUNCTION OF PETERS-LIDARD ET AL. +! (1998,JAS, VOL 55, 1209-1224), WHICH REQUIRES THE SPECIFYING +! THE QUARTZ CONTENT OF THE GIVEN SOIL CLASS (SEE ROUTINE REDPRM) +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! NEXT ADD SUBSURFACE HEAT FLUX REDUCTION EFFECT FROM THE +! OVERLYING GREEN CANOPY, ADAPTED FROM SECTION 2.1.2 OF +! PETERS-LIDARD ET AL. (1997, JGR, VOL 102(D4)) +! ---------------------------------------------------------------------- + CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1),BEXP, PSISAT, SOILTYP, OPT_THCND) + +!urban + IF ( VEGTYP == ISURBAN ) DF1=3.24 + + DF1 = DF1 * EXP (SBETA * SHDFAC) +! +! kmh 09/03/2006 +! kmh 03/25/2008 change SNCOVR threshold to 0.97 +! + IF ( SNCOVR .GT. 0.97 ) THEN + DF1 = SNCOND + ENDIF +! +! ---------------------------------------------------------------------- +! FINALLY "PLANE PARALLEL" SNOWPACK EFFECT FOLLOWING +! V.J. LINARDINI REFERENCE CITED ABOVE. NOTE THAT DTOT IS +! COMBINED DEPTH OF SNOWDEPTH AND THICKNESS OF FIRST SOIL LAYER +! ---------------------------------------------------------------------- + + DSOIL = - (0.5 * ZSOIL (1)) + IF (SNEQV == 0.) THEN + SSOIL = DF1 * (T1- STC (1) ) / DSOIL + ELSE + DTOT = SNOWH + DSOIL + FRCSNO = SNOWH / DTOT + +! 1. HARMONIC MEAN (SERIES FLOW) +! DF1 = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1) + FRCSOI = DSOIL / DTOT +! 2. ARITHMETIC MEAN (PARALLEL FLOW) +! DF1 = FRCSNO*SNCOND + FRCSOI*DF1 + DF1H = (SNCOND * DF1)/ (FRCSOI * SNCOND+ FRCSNO * DF1) + +! 3. GEOMETRIC MEAN (INTERMEDIATE BETWEEN HARMONIC AND ARITHMETIC MEAN) +! DF1 = (SNCOND**FRCSNO)*(DF1**FRCSOI) +! weigh DF by snow fraction +! DF1 = DF1H*SNCOVR + DF1A*(1.0-SNCOVR) +! DF1 = DF1H*SNCOVR + DF1*(1.0-SNCOVR) + DF1A = FRCSNO * SNCOND+ FRCSOI * DF1 + +! ---------------------------------------------------------------------- +! CALCULATE SUBSURFACE HEAT FLUX, SSOIL, FROM FINAL THERMAL DIFFUSIVITY +! OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP +! MID-LAYER SOIL TEMPERATURE +! ---------------------------------------------------------------------- + DF1 = DF1A * SNCOVR + DF1* (1.0- SNCOVR) + SSOIL = DF1 * (T1- STC (1) ) / DTOT + END IF +! ---------------------------------------------------------------------- +! DETERMINE SURFACE ROUGHNESS OVER SNOWPACK USING SNOW CONDITION FROM +! THE PREVIOUS TIMESTEP. +! ---------------------------------------------------------------------- + IF (SNCOVR > 0. ) THEN + CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH,FBUR,FGSN,SHDMAX,UA_PHYS) + ELSE + Z0=Z0BRD + IF(UA_PHYS) CALL SNOWZ0 (SNCOVR,Z0,Z0BRD,SNOWH,FBUR,FGSN, & + SHDMAX,UA_PHYS) + END IF +! ---------------------------------------------------------------------- +! NEXT CALL ROUTINE SFCDIF TO CALCULATE THE SFC EXCHANGE COEF (CH) FOR +! HEAT AND MOISTURE. + +! NOTE !!! +! DO NOT CALL SFCDIF UNTIL AFTER ABOVE CALL TO REDPRM, IN CASE +! ALTERNATIVE VALUES OF ROUGHNESS LENGTH (Z0) AND ZILINTINKEVICH COEF +! (CZIL) ARE SET THERE VIA NAMELIST I/O. + +! NOTE !!! +! ROUTINE SFCDIF RETURNS A CH THAT REPRESENTS THE WIND SPD TIMES THE +! "ORIGINAL" NONDIMENSIONAL "Ch" TYPICAL IN LITERATURE. HENCE THE CH +! RETURNED FROM SFCDIF HAS UNITS OF M/S. THE IMPORTANT COMPANION +! COEFFICIENT OF CH, CARRIED HERE AS "RCH", IS THE CH FROM SFCDIF TIMES +! AIR DENSITY AND PARAMETER "CP". "RCH" IS COMPUTED IN "CALL PENMAN". +! RCH RATHER THAN CH IS THE COEFF USUALLY INVOKED LATER IN EQNS. + +! NOTE !!! +! ---------------------------------------------------------------------- +! SFCDIF ALSO RETURNS THE SURFACE EXCHANGE COEFFICIENT FOR MOMENTUM, CM, +! ALSO KNOWN AS THE SURFACE DRAGE COEFFICIENT. Needed as a state variable +! for iterative/implicit solution of CH in SFCDIF +! ---------------------------------------------------------------------- +! IF(.NOT.LCH) THEN +! T1V = T1 * (1.0+ 0.61 * Q2) +! TH2V = TH2 * (1.0+ 0.61 * Q2) +! CALL SFCDIF_off (ZLVL,Z0,T1V,TH2V,SFCSPD,CZIL,CM,CH) +! ENDIF + +! ---------------------------------------------------------------------- +! CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP), AND +! OTHER PARTIAL PRODUCTS AND SUMS SAVE IN COMMON/RITE FOR LATER +! CALCULATIONS. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) NEEDED IN +! PENMAN EP SUBROUTINE THAT FOLLOWS +! ---------------------------------------------------------------------- +! FDOWN = SOLDN * (1.0- ALBEDO) + LWDN + FDOWN = SOLNET + LWDN +! ---------------------------------------------------------------------- +! CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY SUBROUTINES +! PENMAN. + T2V = SFCTMP * (1.0+ 0.61 * Q2 ) + + iout=0 + if(iout.eq.1) then + print*,'before penman' + print*,' SFCTMP',SFCTMP,'SFCPRS',SFCPRS,'CH',CH,'T2V',T2V, & + 'TH2',TH2,'PRCP',PRCP,'FDOWN',FDOWN,'T24',T24,'SSOIL',SSOIL, & + 'Q2',Q2,'Q2SAT',Q2SAT,'ETP',ETP,'RCH',RCH, & + 'EPSCA',EPSCA,'RR',RR ,'SNOWNG',SNOWNG,'FRZGRA',FRZGRA, & + 'DQSDT2',DQSDT2,'FLX2',FLX2,'SNOWH',SNOWH,'SNEQV',SNEQV, & + ' DSOIL',DSOIL,' FRCSNO',FRCSNO,' SNCOVR',SNCOVR,' DTOT',DTOT, & + ' ZSOIL (1)',ZSOIL(1),' DF1',DF1,'T1',T1,' STC1',STC(1), & + 'ALBEDO',ALBEDO,'SMC',SMC,'STC',STC,'SH2O',SH2O + endif + + CALL PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, & + Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA, & + DQSDT2,FLX2,EMISSI,SNEQV,T1,SNCOVR,AOASIS, & + ALBEDO,SOLDN,FVB,GAMA,STC(1),ETPN,FLX4,UA_PHYS, & + CP,RD,SIGMA,CPH2O,CPICE,LSUBF) +! +! ---------------------------------------------------------------------- +! CALL CANRES TO CALCULATE THE CANOPY RESISTANCE AND CONVERT IT INTO PC +! IF NONZERO GREENNESS FRACTION +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! FROZEN GROUND EXTENSION: TOTAL SOIL WATER "SMC" WAS REPLACED +! BY UNFROZEN SOIL WATER "SH2O" IN CALL TO CANRES BELOW +! ---------------------------------------------------------------------- + IF ( (SHDFAC > 0.) .AND. (XLAI > 0.) ) THEN + CALL CANRES (SOLDN,CH,SFCTMP,Q2,SFCPRS,SH2O,ZSOIL,NSOIL, & + SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2, & + TOPT,RSMAX,RGL,HS,XLAI, & + RCS,RCT,RCQ,RCSOIL,EMISSI,CP,RD,SIGMA) + ELSE + RC = 0.0 + END IF +! ---------------------------------------------------------------------- +! NOW DECIDE MAJOR PATHWAY BRANCH TO TAKE DEPENDING ON WHETHER SNOWPACK +! EXISTS OR NOT: +! ---------------------------------------------------------------------- + ESNOW = 0.0 + IF (SNEQV == 0.0) THEN + CALL NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT, & + SHDFAC, & + SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,EMISSI, & + SSOIL, & + STC,EPSCA,BEXP,PC,RCH,RR,CFACTR, & + SH2O,SLOPE,KDT,FRZX,PSISAT,ZSOIL, & + DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2, & + RUNOFF3,EDIR,EC,ET,ETT,NROOT,RTDIS, & + QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,XSDA_QFX,QFX_PHY,XQNORM,fasdas,HCPCT_FASDAS, & !fasdas + SIGMA,CPH2O) + ETA_KINEMATIC = ETA + ELSE + CALL SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT, & + SBETA,DF1, & + Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA, & + SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,SNEQV,SNDENS,& + SNOWH,SH2O,SLOPE,KDT,FRZX,PSISAT, & + ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1, & + RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT, & + RTDIS,QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI, & + RIBB,SOLDN, & + ISURBAN, & + VEGTYP, & + ETPN,FLX4,UA_PHYS, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,QFX_PHY,fasdas,HCPCT_FASDAS,SIGMA,CPH2O,CPICE, & !fasdas + LSUBF) + ETA_KINEMATIC = ESNOW + ETNS - 1000.0*DEW + END IF + +! Calculate effective mixing ratio at grnd level (skin) +! +! Q1=Q2+ETA*CP/RCH + Q1=Q2+ETA_KINEMATIC*CP/RCH +! +! ---------------------------------------------------------------------- +! DETERMINE SENSIBLE HEAT (H) IN ENERGY UNITS (W M-2) +! ---------------------------------------------------------------------- + + SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 ) + IF(UA_PHYS) SHEAT = SHEAT + FLX4 +! +! FASDAS +! + IF ( fasdas == 1 ) THEN + HFX_PHY = SHEAT + ENDIF +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! CONVERT EVAP TERMS FROM KINEMATIC (KG M-2 S-1) TO ENERGY UNITS (W M-2) +! ---------------------------------------------------------------------- + EDIR = EDIR * LVH2O + EC = EC * LVH2O + DO K=1,4 + ET(K) = ET(K) * LVH2O + ENDDO + ETT = ETT * LVH2O + + ETPND1=ETPND1 * LVH2O + + ESNOW = ESNOW * LSUBS + ETP = ETP*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS) + IF(UA_PHYS) ETPN = ETPN*((1.-SNCOVR)*LVH2O + SNCOVR*LSUBS) + IF (ETP .GT. 0.) THEN + ETA = EDIR + EC + ETT + ESNOW + ELSE + ETA = ETP + ENDIF +! ---------------------------------------------------------------------- +! DETERMINE BETA (RATIO OF ACTUAL TO POTENTIAL EVAP) +! ---------------------------------------------------------------------- + IF (ETP == 0.0) THEN + BETA = 0.0 + ELSE + BETA = ETA/ETP + ENDIF + +! ---------------------------------------------------------------------- +! CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT: +! SSOIL>0: WARM THE SURFACE (NIGHT TIME) +! SSOIL<0: COOL THE SURFACE (DAY TIME) +! ---------------------------------------------------------------------- + SSOIL = -1.0* SSOIL + +! ---------------------------------------------------------------------- +! FOR THE CASE OF LAND: +! CONVERT RUNOFF3 (INTERNAL LAYER RUNOFF FROM SUPERSAT) FROM M TO M S-1 +! AND ADD TO SUBSURFACE RUNOFF/DRAINAGE/BASEFLOW. RUNOFF2 IS ALREADY +! A RATE AT THIS POINT +! ---------------------------------------------------------------------- + RUNOFF3 = RUNOFF3/ DT + RUNOFF2 = RUNOFF2+ RUNOFF3 + SOILM = -1.0* SMC (1)* ZSOIL (1) + DO K = 2,NSOIL + SOILM = SOILM + SMC (K)* (ZSOIL (K -1) - ZSOIL (K)) + END DO + SOILWM = -1.0* (SMCMAX - SMCWLT)* ZSOIL (1) + SOILWW = -1.0* (SMC (1) - SMCWLT)* ZSOIL (1) + + DO K = 1,NSOIL + SMAV(K)=(SMC(K) - SMCWLT)/(SMCMAX - SMCWLT) + END DO + + IF (NROOT >= 2) THEN + DO K = 2,NROOT + SOILWM = SOILWM + (SMCMAX - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K)) + SOILWW = SOILWW + (SMC(K) - SMCWLT)* (ZSOIL (K -1) - ZSOIL (K)) + END DO + END IF + IF (SOILWM .LT. 1.E-6) THEN + SOILWM = 0.0 + SOILW = 0.0 + SOILM = 0.0 + ELSE + SOILW = SOILWW / SOILWM + END IF + +! ---------------------------------------------------------------------- + END SUBROUTINE SFLX +! ---------------------------------------------------------------------- + + SUBROUTINE ALCALC (ALB,SNOALB,EMBRD,SHDFAC,SHDMIN,SNCOVR,TSNOW,ALBEDO,EMISSI, & + DT,SNOWNG,SNOTIME1,LVCOEF) + +! ---------------------------------------------------------------------- +! CALCULATE ALBEDO INCLUDING SNOW EFFECT (0 -> 1) +! ALB SNOWFREE ALBEDO +! SNOALB MAXIMUM (DEEP) SNOW ALBEDO +! SHDFAC AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! SHDMIN MINIMUM AREAL FRACTIONAL COVERAGE OF GREEN VEGETATION +! SNCOVR FRACTIONAL SNOW COVER +! ALBEDO SURFACE ALBEDO INCLUDING SNOW EFFECT +! TSNOW SNOW SURFACE TEMPERATURE (K) +! ---------------------------------------------------------------------- + IMPLICIT NONE + +! ---------------------------------------------------------------------- +! SNOALB IS ARGUMENT REPRESENTING MAXIMUM ALBEDO OVER DEEP SNOW, +! AS PASSED INTO SFLX, AND ADAPTED FROM THE SATELLITE-BASED MAXIMUM +! SNOW ALBEDO FIELDS PROVIDED BY D. ROBINSON AND G. KUKLA +! (1985, JCAM, VOL 24, 402-411) +! ---------------------------------------------------------------------- + REAL, INTENT(IN) :: ALB, SNOALB, EMBRD, SHDFAC, SHDMIN, SNCOVR, TSNOW + REAL, INTENT(IN) :: DT + LOGICAL, INTENT(IN) :: SNOWNG + REAL, INTENT(INOUT):: SNOTIME1 + REAL, INTENT(OUT) :: ALBEDO, EMISSI + REAL :: SNOALB2 + REAL :: TM,SNOALB1 + REAL, INTENT(IN) :: LVCOEF + REAL, PARAMETER :: SNACCA=0.94,SNACCB=0.58,SNTHWA=0.82,SNTHWB=0.46 +! turn of vegetation effect +! ALBEDO = ALB + (1.0- (SHDFAC - SHDMIN))* SNCOVR * (SNOALB - ALB) +! ALBEDO = (1.0-SNCOVR)*ALB + SNCOVR*SNOALB !this is equivalent to below + ALBEDO = ALB + SNCOVR*(SNOALB-ALB) + EMISSI = EMBRD + SNCOVR*(EMISSI_S - EMBRD) + +! BASE FORMULATION (DICKINSON ET AL., 1986, COGLEY ET AL., 1990) +! IF (TSNOW.LE.263.16) THEN +! ALBEDO=SNOALB +! ELSE +! IF (TSNOW.LT.273.16) THEN +! TM=0.1*(TSNOW-263.16) +! SNOALB1=0.5*((0.9-0.2*(TM**3))+(0.8-0.16*(TM**3))) +! ELSE +! SNOALB1=0.67 +! IF(SNCOVR.GT.0.95) SNOALB1= 0.6 +! SNOALB1 = ALB + SNCOVR*(SNOALB-ALB) +! ENDIF +! ENDIF +! ALBEDO = ALB + SNCOVR*(SNOALB1-ALB) + +! ISBA FORMULATION (VERSEGHY, 1991; BAKER ET AL., 1990) +! SNOALB1 = SNOALB+COEF*(0.85-SNOALB) +! SNOALB2=SNOALB1 +!!m LSTSNW=LSTSNW+1 +! SNOTIME1 = SNOTIME1 + DT +! IF (SNOWNG) THEN +! SNOALB2=SNOALB +!!m LSTSNW=0 +! SNOTIME1 = 0.0 +! ELSE +! IF (TSNOW.LT.273.16) THEN +!! SNOALB2=SNOALB-0.008*LSTSNW*DT/86400 +!!m SNOALB2=SNOALB-0.008*SNOTIME1/86400 +! SNOALB2=(SNOALB2-0.65)*EXP(-0.05*DT/3600)+0.65 +!! SNOALB2=(ALBEDO-0.65)*EXP(-0.01*DT/3600)+0.65 +! ELSE +! SNOALB2=(SNOALB2-0.5)*EXP(-0.0005*DT/3600)+0.5 +!! SNOALB2=(SNOALB-0.5)*EXP(-0.24*LSTSNW*DT/86400)+0.5 +!!m SNOALB2=(SNOALB-0.5)*EXP(-0.24*SNOTIME1/86400)+0.5 +! ENDIF +! ENDIF +! +!! print*,'SNOALB2',SNOALB2,'ALBEDO',ALBEDO,'DT',DT +! ALBEDO = ALB + SNCOVR*(SNOALB2-ALB) +! IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2 +!!m LSTSNW1=LSTSNW +!! SNOTIME = SNOTIME1 + +! formulation by Livneh +! ---------------------------------------------------------------------- +! SNOALB IS CONSIDERED AS THE MAXIMUM SNOW ALBEDO FOR NEW SNOW, AT +! A VALUE OF 85%. SNOW ALBEDO CURVE DEFAULTS ARE FROM BRAS P.263. SHOULD +! NOT BE CHANGED EXCEPT FOR SERIOUS PROBLEMS WITH SNOW MELT. +! TO IMPLEMENT ACCUMULATIN PARAMETERS, SNACCA AND SNACCB, ASSERT THAT IT +! IS INDEED ACCUMULATION SEASON. I.E. THAT SNOW SURFACE TEMP IS BELOW +! ZERO AND THE DATE FALLS BETWEEN OCTOBER AND FEBRUARY +! ---------------------------------------------------------------------- + SNOALB1 = SNOALB+LVCOEF*(0.85-SNOALB) + SNOALB2=SNOALB1 +! ---------------- Initial LSTSNW -------------------------------------- + IF (SNOWNG) THEN + SNOTIME1 = 0. + ELSE + SNOTIME1=SNOTIME1+DT +! IF (TSNOW.LT.273.16) THEN + SNOALB2=SNOALB1*(SNACCA**((SNOTIME1/86400.0)**SNACCB)) +! ELSE +! SNOALB2 =SNOALB1*(SNTHWA**((SNOTIME1/86400.0)**SNTHWB)) +! ENDIF + ENDIF +! + SNOALB2 = MAX ( SNOALB2, ALB ) + ALBEDO = ALB + SNCOVR*(SNOALB2-ALB) + IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2 + +! IF (TSNOW.LT.273.16) THEN +! ALBEDO=SNOALB-0.008*DT/86400 +! ELSE +! ALBEDO=(SNOALB-0.5)*EXP(-0.24*DT/86400)+0.5 +! ENDIF + +! IF (ALBEDO > SNOALB) ALBEDO = SNOALB + +! ---------------------------------------------------------------------- + END SUBROUTINE ALCALC +! ---------------------------------------------------------------------- + + SUBROUTINE CANRES (SOLAR,CH,SFCTMP,Q2,SFCPRS,SMC,ZSOIL,NSOIL, & + SMCWLT,SMCREF,RSMIN,RC,PC,NROOT,Q2SAT,DQSDT2, & + TOPT,RSMAX,RGL,HS,XLAI, & + RCS,RCT,RCQ,RCSOIL,EMISSI,CP,RD,SIGMA) + +! ---------------------------------------------------------------------- +! SUBROUTINE CANRES +! ---------------------------------------------------------------------- +! CALCULATE CANOPY RESISTANCE WHICH DEPENDS ON INCOMING SOLAR RADIATION, +! AIR TEMPERATURE, ATMOSPHERIC WATER VAPOR PRESSURE DEFICIT AT THE +! LOWEST MODEL LEVEL, AND SOIL MOISTURE (PREFERABLY UNFROZEN SOIL +! MOISTURE RATHER THAN TOTAL) +! ---------------------------------------------------------------------- +! SOURCE: JARVIS (1976), NOILHAN AND PLANTON (1989, MWR), JACQUEMIN AND +! NOILHAN (1990, BLM) +! SEE ALSO: CHEN ET AL (1996, JGR, VOL 101(D3), 7251-7268), EQNS 12-14 +! AND TABLE 2 OF SEC. 3.1.2 +! ---------------------------------------------------------------------- +! INPUT: +! SOLAR INCOMING SOLAR RADIATION +! CH SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE +! SFCTMP AIR TEMPERATURE AT 1ST LEVEL ABOVE GROUND +! Q2 AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND +! Q2SAT SATURATION AIR HUMIDITY AT 1ST LEVEL ABOVE GROUND +! DQSDT2 SLOPE OF SATURATION HUMIDITY FUNCTION WRT TEMP +! SFCPRS SURFACE PRESSURE +! SMC VOLUMETRIC SOIL MOISTURE +! ZSOIL SOIL DEPTH (NEGATIVE SIGN, AS IT IS BELOW GROUND) +! NSOIL NO. OF SOIL LAYERS +! NROOT NO. OF SOIL LAYERS IN ROOT ZONE (1.LE.NROOT.LE.NSOIL) +! XLAI LEAF AREA INDEX +! SMCWLT WILTING POINT +! SMCREF REFERENCE SOIL MOISTURE (WHERE SOIL WATER DEFICIT STRESS +! SETS IN) +! RSMIN, RSMAX, TOPT, RGL, HS ARE CANOPY STRESS PARAMETERS SET IN +! SURBOUTINE REDPRM +! CP specific heat of dry air at constant pressure +! OUTPUT: +! PC PLANT COEFFICIENT +! RC CANOPY RESISTANCE +! ---------------------------------------------------------------------- + + IMPLICIT NONE + INTEGER, INTENT(IN) :: NROOT,NSOIL + INTEGER K + REAL, INTENT(IN) :: CH,DQSDT2,HS,Q2,Q2SAT,RSMIN,RGL,RSMAX, & + SFCPRS,SFCTMP,SMCREF,SMCWLT, SOLAR,TOPT,XLAI, & + EMISSI, CP, RD, SIGMA + REAL,DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL + REAL, INTENT(OUT):: PC,RC,RCQ,RCS,RCSOIL,RCT + REAL :: DELTA,FF,GX,P,RR + REAL, DIMENSION(1:NSOIL) :: PART + REAL, PARAMETER :: SLV = 2.501000E6 + + +! ---------------------------------------------------------------------- +! INITIALIZE CANOPY RESISTANCE MULTIPLIER TERMS. +! ---------------------------------------------------------------------- + RCS = 0.0 + RCT = 0.0 + RCQ = 0.0 + RCSOIL = 0.0 + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO INCOMING SOLAR RADIATION +! ---------------------------------------------------------------------- + RC = 0.0 + FF = 0.55*2.0* SOLAR / (RGL * XLAI) + RCS = (FF + RSMIN / RSMAX) / (1.0+ FF) + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO AIR TEMPERATURE AT FIRST MODEL LEVEL ABOVE GROUND +! RCT EXPRESSION FROM NOILHAN AND PLANTON (1989, MWR). +! ---------------------------------------------------------------------- + RCS = MAX (RCS,0.0001) + RCT = 1.0- 0.0016* ( (TOPT - SFCTMP)**2.0) + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO VAPOR PRESSURE DEFICIT AT FIRST MODEL LEVEL. +! RCQ EXPRESSION FROM SSIB +! ---------------------------------------------------------------------- + RCT = MAX (RCT,0.0001) + RCQ = 1.0/ (1.0+ HS * (Q2SAT - Q2)) + +! ---------------------------------------------------------------------- +! CONTRIBUTION DUE TO SOIL MOISTURE AVAILABILITY. +! DETERMINE CONTRIBUTION FROM EACH SOIL LAYER, THEN ADD THEM UP. +! ---------------------------------------------------------------------- + RCQ = MAX (RCQ,0.01) + GX = (SMC (1) - SMCWLT) / (SMCREF - SMCWLT) + IF (GX > 1.) GX = 1. + IF (GX < 0.) GX = 0. + +! ---------------------------------------------------------------------- +! USE SOIL DEPTH AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR +! PART(1) = RTDIS(1) * GX +! ---------------------------------------------------------------------- + PART (1) = (ZSOIL (1)/ ZSOIL (NROOT)) * GX + DO K = 2,NROOT + GX = (SMC (K) - SMCWLT) / (SMCREF - SMCWLT) + IF (GX > 1.) GX = 1. + IF (GX < 0.) GX = 0. +! ---------------------------------------------------------------------- +! USE SOIL DEPTH AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! USE ROOT DISTRIBUTION AS WEIGHTING FACTOR +! PART(K) = RTDIS(K) * GX +! ---------------------------------------------------------------------- + PART (K) = ( (ZSOIL (K) - ZSOIL (K -1))/ ZSOIL (NROOT)) * GX + END DO + DO K = 1,NROOT + RCSOIL = RCSOIL + PART (K) + END DO + +! ---------------------------------------------------------------------- +! DETERMINE CANOPY RESISTANCE DUE TO ALL FACTORS. CONVERT CANOPY +! RESISTANCE (RC) TO PLANT COEFFICIENT (PC) TO BE USED WITH POTENTIAL +! EVAP IN DETERMINING ACTUAL EVAP. PC IS DETERMINED BY: +! PC * LINERIZED PENMAN POTENTIAL EVAP = +! PENMAN-MONTEITH ACTUAL EVAPORATION (CONTAINING RC TERM). +! ---------------------------------------------------------------------- + RCSOIL = MAX (RCSOIL,0.0001) + + RC = RSMIN / (XLAI * RCS * RCT * RCQ * RCSOIL) +! RR = (4.* SIGMA * RD / CP)* (SFCTMP **4.)/ (SFCPRS * CH) + 1.0 + RR = (4.* EMISSI *SIGMA * RD / CP)* (SFCTMP **4.)/ (SFCPRS * CH) & + + 1.0 + + DELTA = (SLV / CP)* DQSDT2 + + PC = (RR + DELTA)/ (RR * (1. + RC * CH) + DELTA) + +! ---------------------------------------------------------------------- + END SUBROUTINE CANRES +! ---------------------------------------------------------------------- + + SUBROUTINE CSNOW (SNCOND,DSNOW) + +! ---------------------------------------------------------------------- +! SUBROUTINE CSNOW +! FUNCTION CSNOW +! ---------------------------------------------------------------------- +! CALCULATE SNOW TERMAL CONDUCTIVITY +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: DSNOW + REAL, INTENT(OUT):: SNCOND + REAL :: C + REAL, PARAMETER :: UNIT = 0.11631 + +! ---------------------------------------------------------------------- +! SNCOND IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C) +! CSNOW IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C) +! BASIC VERSION IS DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4 +! ---------------------------------------------------------------------- + C = 0.328*10** (2.25* DSNOW) +! CSNOW=UNIT*C + +! ---------------------------------------------------------------------- +! DE VAUX EQUATION (1933), IN RANGE 0.1-0.6 +! ---------------------------------------------------------------------- +! SNCOND=0.0293*(1.+100.*DSNOW**2) +! CSNOW=0.0293*(1.+100.*DSNOW**2) + +! ---------------------------------------------------------------------- +! E. ANDERSEN FROM FLERCHINGER +! ---------------------------------------------------------------------- +! SNCOND=0.021+2.51*DSNOW**2 +! CSNOW=0.021+2.51*DSNOW**2 + +! SNCOND = UNIT * C +! double snow thermal conductivity + SNCOND = 2.0 * UNIT * C + +! ---------------------------------------------------------------------- + END SUBROUTINE CSNOW +! ---------------------------------------------------------------------- + SUBROUTINE DEVAP (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP, & + DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP) + +! ---------------------------------------------------------------------- +! SUBROUTINE DEVAP +! FUNCTION DEVAP +! ---------------------------------------------------------------------- +! CALCULATE DIRECT SOIL EVAPORATION +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: ETP1,SMC,BEXP,DKSAT,DWSAT,FXEXP, & + SHDFAC,SMCDRY,SMCMAX,ZSOIL,SMCREF,SMCWLT + REAL, INTENT(OUT):: EDIR + REAL :: FX, SRATIO + + +! ---------------------------------------------------------------------- +! DIRECT EVAP A FUNCTION OF RELATIVE SOIL MOISTURE AVAILABILITY, LINEAR +! WHEN FXEXP=1. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! FX > 1 REPRESENTS DEMAND CONTROL +! FX < 1 REPRESENTS FLUX CONTROL +! ---------------------------------------------------------------------- + + SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY) + IF (SRATIO > 0.) THEN + FX = SRATIO**FXEXP + FX = MAX ( MIN ( FX, 1. ) ,0. ) + ELSE + FX = 0. + ENDIF + +! ---------------------------------------------------------------------- +! ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE +! ---------------------------------------------------------------------- + EDIR = FX * ( 1.0- SHDFAC ) * ETP1 + +! ---------------------------------------------------------------------- + END SUBROUTINE DEVAP + + SUBROUTINE DEVAP_hydro (EDIR,ETP1,SMC,ZSOIL,SHDFAC,SMCMAX,BEXP, & + DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP, & + SFHEAD1RT,ETPND1,DT) + +! ---------------------------------------------------------------------- +! SUBROUTINE DEVAP +! FUNCTION DEVAP +! ---------------------------------------------------------------------- +! CALCULATE DIRECT SOIL EVAPORATION +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: ETP1,SMC,BEXP,DKSAT,DWSAT,FXEXP, & + SHDFAC,SMCDRY,SMCMAX,ZSOIL,SMCREF,SMCWLT + REAL, INTENT(OUT):: EDIR + REAL :: FX, SRATIO + + REAL, INTENT(INOUT) :: SFHEAD1RT,ETPND1 + REAL, INTENT(IN ) :: DT + REAL :: EDIRTMP + + + +! ---------------------------------------------------------------------- +! DIRECT EVAP A FUNCTION OF RELATIVE SOIL MOISTURE AVAILABILITY, LINEAR +! WHEN FXEXP=1. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! FX > 1 REPRESENTS DEMAND CONTROL +! FX < 1 REPRESENTS FLUX CONTROL +! ---------------------------------------------------------------------- + + SRATIO = (SMC - SMCDRY) / (SMCMAX - SMCDRY) + IF (SRATIO > 0.) THEN + FX = SRATIO**FXEXP + FX = MAX ( MIN ( FX, 1. ) ,0. ) + ELSE + FX = 0. + ENDIF + +!DJG NDHMS/WRF-Hydro edits... Adjustment for ponded surface water : Reduce ETP1 + EDIRTMP = 0. + ETPND1 = 0. + +!DJG NDHMS/WRF-Hydro edits... Calc Max Potential Dir Evap. (ETP1 units: }=m/s) + +!DJG NDHMS/WRF-Hydro...currently set ponded water evap to 0.0 until further notice...11/5/2012 +!EDIRTMP = ( 1.0- SHDFAC ) * ETP1 + +! Convert all units to (m) +! Convert EDIRTMP from (kg m{-2} s{-1}=m/s) to (m) ... + EDIRTMP = EDIRTMP * DT + +!DJG NDHMS/WRF-Hydro edits... Convert SFHEAD from (mm) to (m) ... + SFHEAD1RT=SFHEAD1RT * 0.001 + + + +!DJG NDHMS/WRF-Hydro edits... Calculate ETPND as reduction in EDIR(TMP)... + IF (EDIRTMP > 0.) THEN + IF ( EDIRTMP > SFHEAD1RT ) THEN + ETPND1 = SFHEAD1RT + SFHEAD1RT=0. + EDIRTMP = EDIRTMP - ETPND1 + ELSE + ETPND1 = EDIRTMP + EDIRTMP = 0. + SFHEAD1RT = SFHEAD1RT - ETPND1 + END IF + END IF + +!DJG NDHMS/WRF-Hydro edits... Convert SFHEAD units back to (mm) + IF ( SFHEAD1RT /= 0.) SFHEAD1RT=SFHEAD1RT * 1000. + +!DJG NDHMS/WRF-Hydro edits...Convert ETPND and EDIRTMP back to (mm/s=kg m{-2} s{-1}) + ETPND1 = ETPND1 / DT + EDIRTMP = EDIRTMP / DT +!DEBUG print *, "After DEVAP...SFCHEAD+ETPND1",SFHEAD1RT+ETPND1*DT + + +! ---------------------------------------------------------------------- +! ALLOW FOR THE DIRECT-EVAP-REDUCING EFFECT OF SHADE +! ---------------------------------------------------------------------- +!DJG NDHMS/WRF-Hydro edits... +! EDIR = FX * ( 1.0- SHDFAC ) * ETP1 + EDIR = FX * EDIRTMP + + + + +! ---------------------------------------------------------------------- + END SUBROUTINE DEVAP_hydro +! ---------------------------------------------------------------------- + + SUBROUTINE EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL, & + SH2O, & + SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT, & + SMCREF,SHDFAC,CMCMAX, & + SMCDRY,CFACTR, & + EDIR,EC,ET,ETT,SFCTMP,Q2,NROOT,RTDIS,FXEXP, & + SFHEAD1RT,ETPND1) + +! ---------------------------------------------------------------------- +! SUBROUTINE EVAPO +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE FLUX. THE SOIL MOISTURE CONTENT (SMC - A PER +! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH +! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED. +! FROZEN GROUND VERSION: NEW STATES ADDED: SH2O, AND FROZEN GROUND +! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL, NROOT + INTEGER :: I,K + REAL, INTENT(IN) :: BEXP, CFACTR,CMC,CMCMAX,DKSAT, & + DT,DWSAT,ETP1,FXEXP,PC,Q2,SFCTMP, & + SHDFAC,SMCDRY,SMCMAX,SMCREF,SMCWLT + REAL, INTENT(OUT) :: EC,EDIR,ETA1,ETT + REAL :: CMC2MS + REAL,DIMENSION(1:NSOIL), INTENT(IN) :: RTDIS, SMC, SH2O, ZSOIL + REAL,DIMENSION(1:NSOIL), INTENT(OUT) :: ET + + REAL, INTENT(INOUT) :: SFHEAD1RT,ETPND1 + +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE IF THE POTENTIAL EVAPOTRANSPIRATION IS +! GREATER THAN ZERO. +! ---------------------------------------------------------------------- + EDIR = 0. + EC = 0. + ETT = 0. + DO K = 1,NSOIL + ET (K) = 0. + END DO + +! ---------------------------------------------------------------------- +! RETRIEVE DIRECT EVAPORATION FROM SOIL SURFACE. CALL THIS FUNCTION +! ONLY IF VEG COVER NOT COMPLETE. +! FROZEN GROUND VERSION: SH2O STATES REPLACE SMC STATES. +! ---------------------------------------------------------------------- + IF (ETP1 > 0.0) THEN + IF (SHDFAC < 1.) THEN +#ifdef WRF_HYDRO +! CALL DEVAP_hydro (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX, & +! BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP, & +! SFHEAD1RT,ETPND1,DT) +!DJG Reduce ETP1 by EDIR & ETPND1... +! ETP1=ETP1-EDIR-ETPND1 + +! following is the temparay setting ... + CALL DEVAP (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX, & + BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP) +! ETP1=ETP1-EDIR +#else + CALL DEVAP (EDIR,ETP1,SMC (1),ZSOIL (1),SHDFAC,SMCMAX, & + BEXP,DKSAT,DWSAT,SMCDRY,SMCREF,SMCWLT,FXEXP) +#endif + END IF +! ---------------------------------------------------------------------- +! INITIALIZE PLANT TOTAL TRANSPIRATION, RETRIEVE PLANT TRANSPIRATION, +! AND ACCUMULATE IT FOR ALL SOIL LAYERS. +! ---------------------------------------------------------------------- + + IF (SHDFAC > 0.0) THEN + CALL TRANSP (ET,NSOIL,ETP1,SH2O,CMC,ZSOIL,SHDFAC,SMCWLT, & + CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT,RTDIS) + DO K = 1,NSOIL + ETT = ETT + ET ( K ) + END DO +! ---------------------------------------------------------------------- +! CALCULATE CANOPY EVAPORATION. +! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR CMC=0.0. +! ---------------------------------------------------------------------- + IF (CMC > 0.0) THEN + EC = SHDFAC * ( ( CMC / CMCMAX ) ** CFACTR ) * ETP1 + ELSE + EC = 0.0 + END IF +! ---------------------------------------------------------------------- +! EC SHOULD BE LIMITED BY THE TOTAL AMOUNT OF AVAILABLE WATER ON THE +! CANOPY. -F.CHEN, 18-OCT-1994 +! ---------------------------------------------------------------------- + CMC2MS = CMC / DT + EC = MIN ( CMC2MS, EC ) + END IF + END IF +! ---------------------------------------------------------------------- +! TOTAL UP EVAP AND TRANSP TYPES TO OBTAIN ACTUAL EVAPOTRANSP +! ---------------------------------------------------------------------- + ETA1 = EDIR + ETT + EC + +! ---------------------------------------------------------------------- + END SUBROUTINE EVAPO +! ---------------------------------------------------------------------- + + SUBROUTINE FAC2MIT(SMCMAX,FLIMIT) + IMPLICIT NONE + REAL, INTENT(IN) :: SMCMAX + REAL, INTENT(OUT) :: FLIMIT + + FLIMIT = 0.90 + + IF ( SMCMAX == 0.395 ) THEN + FLIMIT = 0.59 + ELSE IF ( ( SMCMAX == 0.434 ) .OR. ( SMCMAX == 0.404 ) ) THEN + FLIMIT = 0.85 + ELSE IF ( ( SMCMAX == 0.465 ) .OR. ( SMCMAX == 0.406 ) ) THEN + FLIMIT = 0.86 + ELSE IF ( ( SMCMAX == 0.476 ) .OR. ( SMCMAX == 0.439 ) ) THEN + FLIMIT = 0.74 + ELSE IF ( ( SMCMAX == 0.200 ) .OR. ( SMCMAX == 0.464 ) ) THEN + FLIMIT = 0.80 + ENDIF + +! ---------------------------------------------------------------------- + END SUBROUTINE FAC2MIT +! ---------------------------------------------------------------------- + + SUBROUTINE FRH2O (FREE,TKELV,SMC,SH2O,SMCMAX,BEXP,PSIS) + +! ---------------------------------------------------------------------- +! SUBROUTINE FRH2O +! ---------------------------------------------------------------------- +! CALCULATE AMOUNT OF SUPERCOOLED LIQUID SOIL WATER CONTENT IF +! TEMPERATURE IS BELOW 273.15K (T0). REQUIRES NEWTON-TYPE ITERATION TO +! SOLVE THE NONLINEAR IMPLICIT EQUATION GIVEN IN EQN 17 OF KOREN ET AL +! (1999, JGR, VOL 104(D16), 19569-19585). +! ---------------------------------------------------------------------- +! NEW VERSION (JUNE 2001): MUCH FASTER AND MORE ACCURATE NEWTON +! ITERATION ACHIEVED BY FIRST TAKING LOG OF EQN CITED ABOVE -- LESS THAN +! 4 (TYPICALLY 1 OR 2) ITERATIONS ACHIEVES CONVERGENCE. ALSO, EXPLICIT +! 1-STEP SOLUTION OPTION FOR SPECIAL CASE OF PARAMETER CK=0, WHICH +! REDUCES THE ORIGINAL IMPLICIT EQUATION TO A SIMPLER EXPLICIT FORM, +! KNOWN AS THE "FLERCHINGER EQN". IMPROVED HANDLING OF SOLUTION IN THE +! LIMIT OF FREEZING POINT TEMPERATURE T0. +! ---------------------------------------------------------------------- +! INPUT: + +! TKELV.........TEMPERATURE (Kelvin) +! SMC...........TOTAL SOIL MOISTURE CONTENT (VOLUMETRIC) +! SH2O..........LIQUID SOIL MOISTURE CONTENT (VOLUMETRIC) +! SMCMAX........SATURATION SOIL MOISTURE CONTENT (FROM REDPRM) +! B.............SOIL TYPE "B" PARAMETER (FROM REDPRM) +! PSIS..........SATURATED SOIL MATRIC POTENTIAL (FROM REDPRM) + +! OUTPUT: +! FRH2O.........SUPERCOOLED LIQUID WATER CONTENT +! FREE..........SUPERCOOLED LIQUID WATER CONTENT +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: BEXP,PSIS,SH2O,SMC,SMCMAX,TKELV + REAL, INTENT(OUT) :: FREE + REAL :: BX,DENOM,DF,DSWL,FK,SWL,SWLK + INTEGER :: NLOG,KCOUNT +! PARAMETER(CK = 0.0) + REAL, PARAMETER :: CK = 8.0, BLIM = 5.5, ERROR = 0.005, & + HLICE = 3.335E5, GS = 9.81,DICE = 920.0, & + DH2O = 1000.0, T0 = 273.15 + +! ---------------------------------------------------------------------- +! LIMITS ON PARAMETER B: B < 5.5 (use parameter BLIM) +! SIMULATIONS SHOWED IF B > 5.5 UNFROZEN WATER CONTENT IS +! NON-REALISTICALLY HIGH AT VERY LOW TEMPERATURES. +! ---------------------------------------------------------------------- + BX = BEXP + +! ---------------------------------------------------------------------- +! INITIALIZING ITERATIONS COUNTER AND ITERATIVE SOLUTION FLAG. +! ---------------------------------------------------------------------- + IF (BEXP > BLIM) BX = BLIM + NLOG = 0 + +! ---------------------------------------------------------------------- +! IF TEMPERATURE NOT SIGNIFICANTLY BELOW FREEZING (T0), SH2O = SMC +! ---------------------------------------------------------------------- + KCOUNT = 0 +! FRH2O = SMC + IF (TKELV > (T0- 1.E-3)) THEN + FREE = SMC + ELSE + +! ---------------------------------------------------------------------- +! OPTION 1: ITERATED SOLUTION FOR NONZERO CK +! IN KOREN ET AL, JGR, 1999, EQN 17 +! ---------------------------------------------------------------------- +! INITIAL GUESS FOR SWL (frozen content) +! ---------------------------------------------------------------------- + IF (CK /= 0.0) THEN + SWL = SMC - SH2O +! ---------------------------------------------------------------------- +! KEEP WITHIN BOUNDS. +! ---------------------------------------------------------------------- + IF (SWL > (SMC -0.02)) SWL = SMC -0.02 + +! ---------------------------------------------------------------------- +! START OF ITERATIONS +! ---------------------------------------------------------------------- + IF (SWL < 0.) SWL = 0. + 1001 Continue + IF (.NOT.( (NLOG < 10) .AND. (KCOUNT == 0))) goto 1002 + NLOG = NLOG +1 + DF = ALOG ( ( PSIS * GS / HLICE ) * ( ( 1. + CK * SWL )**2.) * & + ( SMCMAX / (SMC - SWL) )** BX) - ALOG ( - ( & + TKELV - T0)/ TKELV) + DENOM = 2. * CK / ( 1. + CK * SWL ) + BX / ( SMC - SWL ) + SWLK = SWL - DF / DENOM +! ---------------------------------------------------------------------- +! BOUNDS USEFUL FOR MATHEMATICAL SOLUTION. +! ---------------------------------------------------------------------- + IF (SWLK > (SMC -0.02)) SWLK = SMC - 0.02 + IF (SWLK < 0.) SWLK = 0. + +! ---------------------------------------------------------------------- +! MATHEMATICAL SOLUTION BOUNDS APPLIED. +! ---------------------------------------------------------------------- + DSWL = ABS (SWLK - SWL) + +! ---------------------------------------------------------------------- +! IF MORE THAN 10 ITERATIONS, USE EXPLICIT METHOD (CK=0 APPROX.) +! WHEN DSWL LESS OR EQ. ERROR, NO MORE ITERATIONS REQUIRED. +! ---------------------------------------------------------------------- + SWL = SWLK + IF ( DSWL <= ERROR ) THEN + KCOUNT = KCOUNT +1 + END IF +! ---------------------------------------------------------------------- +! END OF ITERATIONS +! ---------------------------------------------------------------------- +! BOUNDS APPLIED WITHIN DO-BLOCK ARE VALID FOR PHYSICAL SOLUTION. +! ---------------------------------------------------------------------- +! FRH2O = SMC - SWL + goto 1001 + 1002 continue + FREE = SMC - SWL + END IF +! ---------------------------------------------------------------------- +! END OPTION 1 +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! OPTION 2: EXPLICIT SOLUTION FOR FLERCHINGER EQ. i.e. CK=0 +! IN KOREN ET AL., JGR, 1999, EQN 17 +! APPLY PHYSICAL BOUNDS TO FLERCHINGER SOLUTION +! ---------------------------------------------------------------------- + IF (KCOUNT == 0) THEN +! PRINT *,'Flerchinger USEd in NEW version. Iterations=',NLOG + FK = ( ( (HLICE / (GS * ( - PSIS)))* & + ( (TKELV - T0)/ TKELV))** ( -1/ BX))* SMCMAX +! FRH2O = MIN (FK, SMC) + IF (FK < 0.02) FK = 0.02 + FREE = MIN (FK, SMC) +! ---------------------------------------------------------------------- +! END OPTION 2 +! ---------------------------------------------------------------------- + END IF + END IF +! ---------------------------------------------------------------------- + END SUBROUTINE FRH2O +! ---------------------------------------------------------------------- + + SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1, & + TBOT,ZBOT,PSISAT,SH2O,DT,BEXP,SOILTYP,OPT_THCND, & + F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN & + ,HCPCT_FASDAS ) !fasdas + +! ---------------------------------------------------------------------- +! SUBROUTINE HRT +! ---------------------------------------------------------------------- +! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL +! THERMAL DIFFUSION EQUATION. ALSO TO COMPUTE ( PREPARE ) THE MATRIX +! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME. +! ---------------------------------------------------------------------- + IMPLICIT NONE + LOGICAL :: ITAVG + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NSOIL, VEGTYP, SOILTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER :: I, K + + REAL, INTENT(IN) :: BEXP, CSOIL, DF1, DT,F1,PSISAT,QUARTZ, & + SMCMAX ,TBOT,YY,ZZ1, ZBOT + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC,STC,ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SH2O + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTS + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI,CI + REAL :: DDZ, DDZ2, DENOM, DF1N, DF1K, DTSDZ, & + DTSDZ2,HCPCT,QTOT,SSOIL,SICE,TAVG,TBK, & + TBK1,TSNSR,TSURF,CSOIL_LOC + REAL, PARAMETER :: T0 = 273.15, CAIR = 1004.0, CICE = 2.106E6,& + CH2O = 4.2E6 + +! +! FASDAS +! + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! + +!urban + IF( VEGTYP == ISURBAN ) then + CSOIL_LOC=3.0E6 + ELSE + CSOIL_LOC=CSOIL + ENDIF + +! ---------------------------------------------------------------------- +! INITIALIZE LOGICAL FOR SOIL LAYER TEMPERATURE AVERAGING. +! ---------------------------------------------------------------------- + ITAVG = .TRUE. +! ---------------------------------------------------------------------- +! BEGIN SECTION FOR TOP SOIL LAYER +! ---------------------------------------------------------------------- +! CALC THE HEAT CAPACITY OF THE TOP SOIL LAYER +! ---------------------------------------------------------------------- + HCPCT = SH2O (1)* CH2O + (1.0- SMCMAX)* CSOIL_LOC + (SMCMAX - SMC (1))& + * CAIR & + + ( SMC (1) - SH2O (1) )* CICE +! +! FASDAS +! + HCPCT_FASDAS = HCPCT +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER +! ---------------------------------------------------------------------- + DDZ = 1.0 / ( -0.5 * ZSOIL (2) ) + AI (1) = 0.0 + CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT) + +! ---------------------------------------------------------------------- +! CALCULATE THE VERTICAL SOIL TEMP GRADIENT BTWN THE 1ST AND 2ND SOIL +! LAYERS. THEN CALCULATE THE SUBSURFACE HEAT FLUX. USE THE TEMP +! GRADIENT AND SUBSFC HEAT FLUX TO CALC "RIGHT-HAND SIDE TENDENCY +! TERMS", OR "RHSTS", FOR TOP SOIL LAYER. +! ---------------------------------------------------------------------- + BI (1) = - CI (1) + DF1 / (0.5 * ZSOIL (1) * ZSOIL (1)* HCPCT * & + ZZ1) + DTSDZ = (STC (1) - STC (2)) / ( -0.5 * ZSOIL (2)) + SSOIL = DF1 * (STC (1) - YY) / (0.5 * ZSOIL (1) * ZZ1) +! RHSTS(1) = (DF1 * DTSDZ - SSOIL) / (ZSOIL(1) * HCPCT) + DENOM = (ZSOIL (1) * HCPCT) + +! ---------------------------------------------------------------------- +! NEXT CAPTURE THE VERTICAL DIFFERENCE OF THE HEAT FLUX AT TOP AND +! BOTTOM OF FIRST SOIL LAYER FOR USE IN HEAT FLUX CONSTRAINT APPLIED TO +! POTENTIAL SOIL FREEZING/THAWING IN ROUTINE SNKSRC. +! ---------------------------------------------------------------------- +! QTOT = SSOIL - DF1*DTSDZ + RHSTS (1) = (DF1 * DTSDZ - SSOIL) / DENOM + +! ---------------------------------------------------------------------- +! CALCULATE FROZEN WATER CONTENT IN 1ST SOIL LAYER. +! ---------------------------------------------------------------------- + QTOT = -1.0* RHSTS (1)* DENOM + +! ---------------------------------------------------------------------- +! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP): +! SET TEMP "TSURF" AT TOP OF SOIL COLUMN (FOR USE IN FREEZING SOIL +! PHYSICS LATER IN FUNCTION SUBROUTINE SNKSRC). IF SNOWPACK CONTENT IS +! ZERO, THEN TSURF EXPRESSION BELOW GIVES TSURF = SKIN TEMP. IF +! SNOWPACK IS NONZERO (HENCE ARGUMENT ZZ1=1), THEN TSURF EXPRESSION +! BELOW YIELDS SOIL COLUMN TOP TEMPERATURE UNDER SNOWPACK. THEN +! CALCULATE TEMPERATURE AT BOTTOM INTERFACE OF 1ST SOIL LAYER FOR USE +! LATER IN FUNCTION SUBROUTINE SNKSRC +! ---------------------------------------------------------------------- + SICE = SMC (1) - SH2O (1) + IF (ITAVG) THEN + TSURF = (YY + (ZZ1-1) * STC (1)) / ZZ1 +! ---------------------------------------------------------------------- +! IF FROZEN WATER PRESENT OR ANY OF LAYER-1 MID-POINT OR BOUNDING +! INTERFACE TEMPERATURES BELOW FREEZING, THEN CALL SNKSRC TO +! COMPUTE HEAT SOURCE/SINK (AND CHANGE IN FROZEN WATER CONTENT) +! DUE TO POSSIBLE SOIL WATER PHASE CHANGE +! ---------------------------------------------------------------------- + CALL TBND (STC (1),STC (2),ZSOIL,ZBOT,1,NSOIL,TBK) + IF ( (SICE > 0.) .OR. (STC (1) < T0) .OR. & + (TSURF < T0) .OR. (TBK < T0) ) THEN +! TSNSR = SNKSRC (TAVG,SMC(1),SH2O(1), + CALL TMPAVG (TAVG,TSURF,STC (1),TBK,ZSOIL,NSOIL,1) + CALL SNKSRC (TSNSR,TAVG,SMC (1),SH2O (1), & + ZSOIL,NSOIL,SMCMAX,PSISAT,BEXP,DT,1,QTOT) +! RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT ) + RHSTS (1) = RHSTS (1) - TSNSR / DENOM + END IF + ELSE +! TSNSR = SNKSRC (STC(1),SMC(1),SH2O(1), + IF ( (SICE > 0.) .OR. (STC (1) < T0) ) THEN + CALL SNKSRC (TSNSR,STC (1),SMC (1),SH2O (1), & + ZSOIL,NSOIL,SMCMAX,PSISAT,BEXP,DT,1,QTOT) +! RHSTS(1) = RHSTS(1) - TSNSR / ( ZSOIL(1) * HCPCT ) + RHSTS (1) = RHSTS (1) - TSNSR / DENOM + END IF +! ---------------------------------------------------------------------- +! THIS ENDS SECTION FOR TOP SOIL LAYER. +! ---------------------------------------------------------------------- + END IF + +! INITIALIZE DDZ2 +! ---------------------------------------------------------------------- + + DDZ2 = 0.0 + DF1K = DF1 + +! ---------------------------------------------------------------------- +! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS +! (EXCEPT SUBSFC OR "GROUND" HEAT FLUX NOT REPEATED IN LOWER LAYERS) +! ---------------------------------------------------------------------- +! CALCULATE HEAT CAPACITY FOR THIS SOIL LAYER. +! ---------------------------------------------------------------------- + DO K = 2,NSOIL + HCPCT = SH2O (K)* CH2O + (1.0- SMCMAX)* CSOIL_LOC + (SMCMAX - SMC ( & + K))* CAIR + ( SMC (K) - SH2O (K) )* CICE +! ---------------------------------------------------------------------- +! THIS SECTION FOR LAYER 2 OR GREATER, BUT NOT LAST LAYER. +! ---------------------------------------------------------------------- +! CALCULATE THERMAL DIFFUSIVITY FOR THIS LAYER. +! ---------------------------------------------------------------------- + IF (K /= NSOIL) THEN + +! ---------------------------------------------------------------------- +! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER +! ---------------------------------------------------------------------- + CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K),BEXP, PSISAT, SOILTYP, OPT_THCND) + +!urban + IF ( VEGTYP == ISURBAN ) DF1N = 3.24 + + DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) ) + +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT +! ---------------------------------------------------------------------- + DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM + DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1)) + +! ---------------------------------------------------------------------- +! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP): CALCULATE +! TEMP AT BOTTOM OF LAYER. +! ---------------------------------------------------------------------- + CI (K) = - DF1N * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K)) * & + HCPCT) + IF (ITAVG) THEN + CALL TBND (STC (K),STC (K +1),ZSOIL,ZBOT,K,NSOIL,TBK1) + END IF + + ELSE +! ---------------------------------------------------------------------- +! SPECIAL CASE OF BOTTOM SOIL LAYER: CALCULATE THERMAL DIFFUSIVITY FOR +! BOTTOM LAYER. +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! CALC THE VERTICAL SOIL TEMP GRADIENT THRU BOTTOM LAYER. +! ---------------------------------------------------------------------- + CALL TDFCND (DF1N,SMC (K),QUARTZ,SMCMAX,SH2O (K),BEXP, PSISAT, SOILTYP, OPT_THCND) + + +!urban + IF ( VEGTYP == ISURBAN ) DF1N = 3.24 + + DENOM = .5 * (ZSOIL (K -1) + ZSOIL (K)) - ZBOT + +! ---------------------------------------------------------------------- +! SET MATRIX COEF, CI TO ZERO IF BOTTOM LAYER. +! ---------------------------------------------------------------------- + DTSDZ2 = (STC (K) - TBOT) / DENOM + +! ---------------------------------------------------------------------- +! IF TEMPERATURE AVERAGING INVOKED (ITAVG=TRUE; ELSE SKIP): CALCULATE +! TEMP AT BOTTOM OF LAST LAYER. +! ---------------------------------------------------------------------- + CI (K) = 0. + IF (ITAVG) THEN + CALL TBND (STC (K),TBOT,ZSOIL,ZBOT,K,NSOIL,TBK1) + END IF +! ---------------------------------------------------------------------- +! THIS ENDS SPECIAL LOOP FOR BOTTOM LAYER. + END IF +! ---------------------------------------------------------------------- +! CALCULATE RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT. +! ---------------------------------------------------------------------- + DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT + RHSTS (K) = ( DF1N * DTSDZ2- DF1K * DTSDZ ) / DENOM + QTOT = -1.0* DENOM * RHSTS (K) + + SICE = SMC (K) - SH2O (K) + IF (ITAVG) THEN + CALL TMPAVG (TAVG,TBK,STC (K),TBK1,ZSOIL,NSOIL,K) +! TSNSR = SNKSRC(TAVG,SMC(K),SH2O(K),ZSOIL,NSOIL, + IF ( (SICE > 0.) .OR. (STC (K) < T0) .OR. & + (TBK .lt. T0) .OR. (TBK1 .lt. T0) ) THEN + CALL SNKSRC (TSNSR,TAVG,SMC (K),SH2O (K),ZSOIL,NSOIL, & + SMCMAX,PSISAT,BEXP,DT,K,QTOT) + RHSTS (K) = RHSTS (K) - TSNSR / DENOM + END IF + ELSE +! TSNSR = SNKSRC(STC(K),SMC(K),SH2O(K),ZSOIL,NSOIL, + IF ( (SICE > 0.) .OR. (STC (K) < T0) ) THEN + CALL SNKSRC (TSNSR,STC (K),SMC (K),SH2O (K),ZSOIL,NSOIL, & + SMCMAX,PSISAT,BEXP,DT,K,QTOT) + RHSTS (K) = RHSTS (K) - TSNSR / DENOM + END IF + END IF + +! ---------------------------------------------------------------------- +! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER. +! ---------------------------------------------------------------------- + AI (K) = - DF1K * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT) + +! ---------------------------------------------------------------------- +! RESET VALUES OF DF1, DTSDZ, DDZ, AND TBK FOR LOOP TO NEXT SOIL LAYER. +! ---------------------------------------------------------------------- + BI (K) = - (AI (K) + CI (K)) + TBK = TBK1 + DF1K = DF1N + DTSDZ = DTSDZ2 + DDZ = DDZ2 + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE HRT +! ---------------------------------------------------------------------- + + SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI) + +! ---------------------------------------------------------------------- +! SUBROUTINE HSTEP +! ---------------------------------------------------------------------- +! CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: K + + REAL, DIMENSION(1:NSOIL), INTENT(IN):: STCIN + REAL, DIMENSION(1:NSOIL), INTENT(OUT):: STCOUT + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: AI,BI,CI + REAL, DIMENSION(1:NSOIL) :: RHSTSin + REAL, DIMENSION(1:NSOIL) :: CIin + REAL :: DT + +! ---------------------------------------------------------------------- +! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTS (K) = RHSTS (K) * DT + AI (K) = AI (K) * DT + BI (K) = 1. + BI (K) * DT + CI (K) = CI (K) * DT + END DO +! ---------------------------------------------------------------------- +! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12 +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTSin (K) = RHSTS (K) + END DO + DO K = 1,NSOIL + CIin (K) = CI (K) + END DO +! ---------------------------------------------------------------------- +! SOLVE THE TRI-DIAGONAL MATRIX EQUATION +! ---------------------------------------------------------------------- + CALL ROSR12 (CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL) +! ---------------------------------------------------------------------- +! CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + STCOUT (K) = STCIN (K) + CI (K) + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE HSTEP +! ---------------------------------------------------------------------- + + SUBROUTINE NOPAC (ETP,ETA,PRCP,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT,SHDFAC, & + SBETA,Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,EMISSI, & + SSOIL, & + STC,EPSCA,BEXP,PC,RCH,RR,CFACTR, & + SH2O,SLOPE,KDT,FRZFACT,PSISAT,ZSOIL, & + DKSAT,DWSAT,TBOT,ZBOT,RUNOFF1,RUNOFF2, & + RUNOFF3,EDIR,EC,ET,ETT,NROOT,RTDIS, & + QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX3,VEGTYP,ISURBAN, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,XSDA_QFX,QFX_PHY,XQNORM,fasdas,HCPCT_FASDAS, & + SIGMA,CPH2O) !fasdas + +! ---------------------------------------------------------------------- +! SUBROUTINE NOPAC +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES AND UPDATE SOIL MOISTURE +! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN NO SNOW PACK IS +! PRESENT. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NROOT,NSOIL,VEGTYP,SOILTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER :: K + + REAL, INTENT(IN) :: BEXP,CFACTR, CMCMAX,CSOIL,DKSAT,DT,DWSAT, & + EPSCA,ETP,FDOWN,F1,FXEXP,FRZFACT,KDT,PC, & + PRCP,PSISAT,Q2,QUARTZ,RCH,RR,SBETA,SFCTMP,& + SHDFAC,SLOPE,SMCDRY,SMCMAX,SMCREF,SMCWLT, & + T24,TBOT,TH2,ZBOT,EMISSI,SIGMA,CPH2O + REAL, INTENT(INOUT) :: CMC,BETA,T1 + REAL, INTENT(OUT) :: DEW,DRIP,EC,EDIR,ETA,ETT,FLX1,FLX3, & + RUNOFF1,RUNOFF2,RUNOFF3,SSOIL +!DJG NDHMS/WRF-Hydro edit... + REAL, INTENT(INOUT) :: SFHEAD1RT,INFXS1RT,ETPND1 + + REAL, DIMENSION(1:NSOIL),INTENT(IN) :: RTDIS,ZSOIL + REAL, DIMENSION(1:NSOIL),INTENT(OUT) :: ET + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC + REAL, DIMENSION(1:NSOIL) :: ET1 + REAL :: EC1,EDIR1,ETT1,DF1,ETA1,ETP1,PRCP1,YY, & + YYNUM,ZZ1 +! +! FASDAS +! + REAL :: XSDA_QFX, QFX_PHY, XQNORM + INTEGER :: fasdas + REAL , DIMENSION(1:NSOIL) :: EFT(NSOIL), wetty(1:NSOIL) + REAL :: EFDIR, EFC, EALL_now + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE: +! CONVERT ETP Fnd PRCP FROM KG M-2 S-1 TO M S-1 AND INITIALIZE DEW. +! ---------------------------------------------------------------------- + PRCP1 = PRCP * 0.001 + ETP1 = ETP * 0.001 + DEW = 0.0 +! ---------------------------------------------------------------------- +! INITIALIZE EVAP TERMS. +! ---------------------------------------------------------------------- +! +! FASDAS +! + QFX_PHY = 0.0 +! +! END FASDAS +! + EDIR = 0. + EDIR1 = 0. + EC1 = 0. + EC = 0. + DO K = 1,NSOIL + ET(K) = 0. + ET1(K) = 0. +! +! FASDAS +! + wetty(K) = 1.0 +! +! END FASDAS +! + END DO + ETT = 0. + ETT1 = 0. + +!DJG NDHMS/WRF-Hydro edit... + ETPND1 = 0. + + + IF (ETP > 0.0) THEN + CALL EVAPO (ETA1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL, & + SH2O, & + SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT, & + SMCREF,SHDFAC,CMCMAX, & + SMCDRY,CFACTR, & + EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS,FXEXP, & + SFHEAD1RT,ETPND1 ) +! +! FASDAS +! + IF( fasdas == 1 ) THEN + DO K=1,NSOIL + QFX_PHY = QFX_PHY + ET1(K) ! m/s +! dont add moisture fluxes if soil moisture is = or > smcref + IF(SMC(K).GE.SMCREF.and.XSDA_QFX.gt.0.0) wetty(K)=0.0 + END DO + QFX_PHY = EDIR1+EC1+QFX_PHY ! m/s + EALL_now = QFX_PHY ! m/s + QFX_PHY = QFX_PHY*1000.0 ! Kg/m2/s + + if(EALL_now.ne.0.0) then + EFDIR = (EDIR1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFDIR = EFDIR * wetty(1) + !TWG2015 Bugfix Flip Sign to conform to Net upward Flux + EDIR1 = EDIR1 + EFDIR ! new value + + EFC = (EC1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + !TWG2015 Bugfix Flip Sign to conform to Net upward Flux + EC1 = EC1 + EFC ! new value + + + DO K=1,NSOIL + EFT(K) = (ET1(K)/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFT(K) = EFT(K) * wetty(K) + !TWG2015 Bugfix Flip Sign to conform to Net upward Flux + ET1(K) = ET1(K) + EFT(K) ! new value + END DO + + + END IF ! for non-zero eall_now + ELSE + QFX_PHY = 0.0 + ENDIF +! +! END FASDAS +! + CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + SH2O,SLOPE,KDT,FRZFACT, & + SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + SHDFAC,CMCMAX, & + RUNOFF1,RUNOFF2,RUNOFF3, & + EDIR1,EC1,ET1, & + DRIP, SFHEAD1RT,INFXS1RT) + +! ---------------------------------------------------------------------- +! CONVERT MODELED EVAPOTRANSPIRATION FROM M S-1 TO KG M-2 S-1. +! ---------------------------------------------------------------------- + + ETA = ETA1 * 1000.0 + +! ---------------------------------------------------------------------- +! IF ETP < 0, ASSUME DEW FORMS (TRANSFORM ETP1 INTO DEW AND REINITIALIZE +! ETP1 TO ZERO). +! ---------------------------------------------------------------------- + ELSE + DEW = - ETP1 + +! ---------------------------------------------------------------------- +! CONVERT PRCP FROM 'KG M-2 S-1' TO 'M S-1' AND ADD DEW AMOUNT. +! ---------------------------------------------------------------------- + + PRCP1 = PRCP1+ DEW +! +! FASDAS +! + IF( fasdas == 1 ) THEN + DO K=1,NSOIL + QFX_PHY = QFX_PHY + ET1(K) ! m/s +! dont add moisture fluxes if soil moisture is = or > smcref + IF(SMC(K).GE.SMCREF.and.XSDA_QFX.gt.0.0) wetty(K)=0.0 + END DO + QFX_PHY = EDIR1+EC1+QFX_PHY ! m/s + EALL_now = QFX_PHY ! m/s + QFX_PHY = QFX_PHY*1000.0 ! Kg/m2/s + + IF(EALL_now.ne.0.0) then + EFDIR = (EDIR1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFDIR = EFDIR * wetty(1) + !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux + EDIR1 = EDIR1 + EFDIR ! new value + + EFC = (EC1/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux + EC1 = EC1+ EFC ! new value + + DO K=1,NSOIL + EFT(K) = (ET1(K)/EALL_now)*XSDA_QFX*1.0E-03*XQNORM + EFT(K) = EFT(K) * wetty(K) + !TWG2015 Bugfix Flip Sign to conform to Net Upward Flux + ET1(K) = ET1(K) + EFT(K) ! new value + END DO + + END IF ! for non-zero eall_now + ELSE + QFX_PHY = 0.0 + ENDIF +! +! END FASDAS +! + CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + SH2O,SLOPE,KDT,FRZFACT, & + SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + SHDFAC,CMCMAX, & + RUNOFF1,RUNOFF2,RUNOFF3, & + EDIR1,EC1,ET1, & + DRIP, SFHEAD1RT,INFXS1RT) + +! ---------------------------------------------------------------------- +! CONVERT MODELED EVAPOTRANSPIRATION FROM 'M S-1' TO 'KG M-2 S-1'. +! ---------------------------------------------------------------------- +! ETA = ETA1 * 1000.0 + END IF + +! ---------------------------------------------------------------------- +! BASED ON ETP AND E VALUES, DETERMINE BETA +! ---------------------------------------------------------------------- + + IF ( ETP <= 0.0 ) THEN + BETA = 0.0 + ETA = ETP + IF ( ETP < 0.0 ) THEN + BETA = 1.0 + END IF + ELSE + BETA = ETA / ETP + END IF + +! ---------------------------------------------------------------------- +! CONVERT MODELED EVAPOTRANSPIRATION COMPONENTS 'M S-1' TO 'KG M-2 S-1'. +! ---------------------------------------------------------------------- + EDIR = EDIR1*1000. + EC = EC1*1000. + DO K = 1,NSOIL + ET(K) = ET1(K)*1000. + END DO + ETT = ETT1*1000. + +! ---------------------------------------------------------------------- +! GET SOIL THERMAL DIFFUXIVITY/CONDUCTIVITY FOR TOP SOIL LYR, +! CALC. ADJUSTED TOP LYR SOIL TEMP AND ADJUSTED SOIL FLUX, THEN +! CALL SHFLX TO COMPUTE/UPDATE SOIL HEAT FLUX AND SOIL TEMPS. +! ---------------------------------------------------------------------- + + CALL TDFCND (DF1,SMC (1),QUARTZ,SMCMAX,SH2O (1),BEXP, PSISAT, SOILTYP, OPT_THCND) + +!urban + IF ( VEGTYP == ISURBAN ) DF1=3.24 +! + +! ---------------------------------------------------------------------- +! VEGETATION GREENNESS FRACTION REDUCTION IN SUBSURFACE HEAT FLUX +! VIA REDUCTION FACTOR, WHICH IS CONVENIENT TO APPLY HERE TO THERMAL +! DIFFUSIVITY THAT IS LATER USED IN HRT TO COMPUTE SUB SFC HEAT FLUX +! (SEE ADDITIONAL COMMENTS ON VEG EFFECT SUB-SFC HEAT FLX IN +! ROUTINE SFLX) +! ---------------------------------------------------------------------- + DF1 = DF1 * EXP (SBETA * SHDFAC) +! ---------------------------------------------------------------------- +! COMPUTE INTERMEDIATE TERMS PASSED TO ROUTINE HRT (VIA ROUTINE +! SHFLX BELOW) FOR USE IN COMPUTING SUBSURFACE HEAT FLUX IN HRT +! ---------------------------------------------------------------------- + YYNUM = FDOWN - EMISSI*SIGMA * T24 + YY = SFCTMP + (YYNUM / RCH + TH2- SFCTMP - BETA * EPSCA) / RR + + ZZ1 = DF1 / ( -0.5 * ZSOIL (1) * RCH * RR ) + 1.0 +!urban + CALL SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & + TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1, & + QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND & + ,HCPCT_FASDAS ) !fasdas + +! ---------------------------------------------------------------------- +! SET FLX1 AND FLX3 (SNOPACK PHASE CHANGE HEAT FLUXES) TO ZERO SINCE +! THEY ARE NOT USED HERE IN SNOPAC. FLX2 (FREEZING RAIN HEAT FLUX) WAS +! SIMILARLY INITIALIZED IN THE PENMAN ROUTINE. +! ---------------------------------------------------------------------- + FLX1 = CPH2O * PRCP * (T1- SFCTMP) + FLX3 = 0.0 + +! ---------------------------------------------------------------------- + END SUBROUTINE NOPAC +! ---------------------------------------------------------------------- + + SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,T2V,TH2,PRCP,FDOWN,T24,SSOIL, & + & Q2,Q2SAT,ETP,RCH,EPSCA,RR,SNOWNG,FRZGRA, & + & DQSDT2,FLX2,EMISSI_IN,SNEQV,T1,SNCOVR,AOASIS, & + & ALBEDO,SOLDN,FVB,GAMA,STC1,ETPN,FLX4,UA_PHYS, & + & CP,RD,SIGMA,CPH2O,CPICE,LSUBF) + +! ---------------------------------------------------------------------- +! SUBROUTINE PENMAN +! ---------------------------------------------------------------------- +! CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT. VARIOUS +! PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND PASSED BACK TO THE +! CALLING ROUTINE FOR LATER USE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + LOGICAL, INTENT(IN) :: SNOWNG, FRZGRA + REAL, INTENT(IN) :: CH, DQSDT2,FDOWN,PRCP, & + Q2, Q2SAT,SSOIL, SFCPRS, SFCTMP, & + T2V, TH2,EMISSI_IN,SNEQV,AOASIS, & + CP, RD, SIGMA, CPH2O, CPICE, LSUBF + REAL, INTENT(IN) :: T1 , SNCOVR + REAL, INTENT(IN) :: ALBEDO,SOLDN,FVB,GAMA,STC1 + LOGICAL, INTENT(IN) :: UA_PHYS +! + REAL, INTENT(OUT) :: EPSCA,ETP,FLX2,RCH,RR,T24 + REAL, INTENT(OUT) :: FLX4,ETPN + REAL :: A, DELTA, FNET,RAD,RHO,EMISSI,ELCP1,LVS + REAL :: TOTABS,UCABS,SIGNCK,FNETN,RADN,EPSCAN + + REAL, PARAMETER :: ELCP = 2.4888E+3, LSUBC = 2.501000E+6 + REAL, PARAMETER :: LSUBS = 2.83E+6 + REAL, PARAMETER :: ALGDSN = 0.5, ALVGSN = 0.13 + +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE: +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION. +! ---------------------------------------------------------------------- + EMISSI=EMISSI_IN + ELCP1 = (1.0-SNCOVR)*ELCP + SNCOVR*ELCP*LSUBS/LSUBC + LVS = (1.0-SNCOVR)*LSUBC + SNCOVR*LSUBS + + FLX2 = 0.0 +! DELTA = ELCP * DQSDT2 + DELTA = ELCP1 * DQSDT2 + T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP +! RR = T24 * 6.48E-8 / (SFCPRS * CH) + 1.0 + RR = EMISSI*T24 * 6.48E-8 / (SFCPRS * CH) + 1.0 + RHO = SFCPRS / (RD * T2V) + +! ---------------------------------------------------------------------- +! ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT +! EFFECTS CAUSED BY FALLING PRECIPITATION. +! ---------------------------------------------------------------------- + RCH = RHO * CP * CH + IF (.NOT. SNOWNG) THEN + IF (PRCP > 0.0) RR = RR + CPH2O * PRCP / RCH + ELSE + RR = RR + CPICE * PRCP / RCH + END IF + +! ---------------------------------------------------------------------- +! INCLUDE THE LATENT HEAT EFFECTS OF FRZNG RAIN CONVERTING TO ICE ON +! IMPACT IN THE CALCULATION OF FLX2 AND FNET. +! ---------------------------------------------------------------------- +! FNET = FDOWN - SIGMA * T24- SSOIL + FNET = FDOWN - EMISSI*SIGMA * T24- SSOIL + + FLX4 = 0.0 + IF(UA_PHYS) THEN + IF(SNEQV > 0. .AND. FNET > 0. .AND. SOLDN > 0. ) THEN + TOTABS = (1.-ALBEDO)*SOLDN*FVB ! solar radiation absorbed + ! by vegetated fraction + UCABS = MIN(TOTABS,((1.0-ALGDSN)*(1.0-ALVGSN)*SOLDN*GAMA)*FVB) +! print*,'penman',UCABS,TOTABS,SOLDN,GAMA,FVB +! UCABS = MIN(TOTABS,(0.44*SOLDN*GAMA)*FVB) + ! UCABS -> solar radiation + ! absorbed under canopy + FLX4 = MIN(TOTABS - UCABS, MIN(250., 0.5*(1.-ALBEDO)*SOLDN)) + ENDIF + + SIGNCK = (STC1-273.15)*(SFCTMP-273.15) + + IF(FLX4 > 0. .AND. (SIGNCK <= 0. .OR. STC1 < 273.15)) THEN + IF(FNET >= FLX4) THEN + FNETN = FNET - FLX4 + ELSE + FLX4 = FNET + FNETN = 0. + ENDIF + ELSE + FLX4 = 0.0 + FNETN = 0. + ENDIF + ENDIF + + IF (FRZGRA) THEN + FLX2 = - LSUBF * PRCP + FNET = FNET - FLX2 + IF(UA_PHYS) FNETN = FNETN - FLX2 +! ---------------------------------------------------------------------- +! FINISH PENMAN EQUATION CALCULATIONS. +! ---------------------------------------------------------------------- + END IF + RAD = FNET / RCH + TH2- SFCTMP +! A = ELCP * (Q2SAT - Q2) + A = ELCP1 * (Q2SAT - Q2) + EPSCA = (A * RR + RAD * DELTA) / (DELTA + RR) +! Fei-Mike + IF (EPSCA>0.) EPSCA = EPSCA * AOASIS +! ETP = EPSCA * RCH / LSUBC + ETP = EPSCA * RCH / LVS + + IF(UA_PHYS) THEN + RADN = FNETN / RCH + TH2- SFCTMP + EPSCAN = (A * RR + RADN * DELTA) / (DELTA + RR) + ETPN = EPSCAN * RCH / LVS + END IF +! ---------------------------------------------------------------------- + END SUBROUTINE PENMAN +! ---------------------------------------------------------------------- + + SUBROUTINE REDPRM (VEGTYP,SOILTYP,SLOPETYP,CFACTR,CMCMAX,RSMAX, & + TOPT, & + REFKDT,KDT,SBETA, SHDFAC,RSMIN,RGL,HS,ZBOT,FRZX, & + PSISAT,SLOPE,SNUP,SALP,BEXP,DKSAT,DWSAT, & + SMCMAX,SMCWLT,SMCREF,SMCDRY,F1,QUARTZ,FXEXP, & + RTDIS,SLDPTH,ZSOIL, NROOT,NSOIL,CZIL, & + LAIMIN, LAIMAX, EMISSMIN, EMISSMAX, ALBEDOMIN, & + ALBEDOMAX, Z0MIN, Z0MAX, CSOIL, PTU, LLANDUSE, & + LSOIL, LOCAL,LVCOEF,ZTOPV,ZBOTV,errmsg,errflg) + + IMPLICIT NONE +! ---------------------------------------------------------------------- +! Internally set (default valuess) +! all soil and vegetation parameters required for the execusion oF +! the Noah lsm are defined in VEGPARM.TBL, SOILPARM.TB, and GENPARM.TBL. +! ---------------------------------------------------------------------- +! Vegetation parameters: +! ALBBRD: SFC background snow-free albedo +! CMXTBL: MAX CNPY Capacity +! Z0BRD: Background roughness length +! SHDFAC: Green vegetation fraction +! NROOT: Rooting depth +! RSMIN: Mimimum stomatal resistance +! RSMAX: Max. stomatal resistance +! RGL: Parameters used in radiation stress function +! HS: Parameter used in vapor pressure deficit functio +! TOPT: Optimum transpiration air temperature. +! CMCMAX: Maximum canopy water capacity +! CFACTR: Parameter used in the canopy inteception calculation +! SNUP: Threshold snow depth (in water equivalent m) that +! implies 100 percent snow cover +! LAI: Leaf area index +! +! ---------------------------------------------------------------------- +! Soil parameters: +! SMCMAX: MAX soil moisture content (porosity) +! SMCREF: Reference soil moisture (field capacity) +! SMCWLT: Wilting point soil moisture +! SMCWLT: Air dry soil moist content limits +! SSATPSI: SAT (saturation) soil potential +! DKSAT: SAT soil conductivity +! BEXP: B parameter +! SSATDW: SAT soil diffusivity +! F1: Soil thermal diffusivity/conductivity coef. +! QUARTZ: Soil quartz content +! Modified by F. Chen (12/22/97) to use the STATSGO soil map +! Modified By F. Chen (01/22/00) to include PLaya, Lava, and White San +! Modified By F. Chen (08/05/02) to include additional parameters for the Noah +! NOTE: SATDW = BB*SATDK*(SATPSI/MAXSMC) +! F11 = ALOG10(SATPSI) + BB*ALOG10(MAXSMC) + 2.0 +! REFSMC1=MAXSMC*(5.79E-9/SATDK)**(1/(2*BB+3)) 5.79E-9 m/s= 0.5 mm +! REFSMC=REFSMC1+1./3.(MAXSMC-REFSMC1) +! WLTSMC1=MAXSMC*(200./SATPSI)**(-1./BB) (Wetzel and Chang, 198 +! WLTSMC=WLTSMC1-0.5*WLTSMC1 +! Note: the values for playa is set for it to have a thermal conductivit +! as sand and to have a hydrulic conductivity as clay +! +! ---------------------------------------------------------------------- +! Class parameter 'SLOPETYP' was included to estimate linear reservoir +! coefficient 'SLOPE' to the baseflow runoff out of the bottom layer. +! lowest class (slopetyp=0) means highest slope parameter = 1. +! definition of slopetyp from 'zobler' slope type: +! slope class percent slope +! 1 0-8 +! 2 8-30 +! 3 > 30 +! 4 0-30 +! 5 0-8 & > 30 +! 6 8-30 & > 30 +! 7 0-8, 8-30, > 30 +! 9 GLACIAL ICE +! BLANK OCEAN/SEA +! SLOPE_DATA: linear reservoir coefficient +! SBETA_DATA: parameter used to caluculate vegetation effect on soil heat +! FXEXP_DAT: soil evaporation exponent used in DEVAP +! CSOIL_DATA: soil heat capacity [J M-3 K-1] +! SALP_DATA: shape parameter of distribution function of snow cover +! REFDK_DATA and REFKDT_DATA: parameters in the surface runoff parameteriz +! FRZK_DATA: frozen ground parameter +! ZBOT_DATA: depth[M] of lower boundary soil temperature +! CZIL_DATA: calculate roughness length of heat +! SMLOW_DATA and MHIGH_DATA: two soil moisture wilt, soil moisture referen +! parameters +! Set maximum number of soil-, veg-, and slopetyp in data statement. +! ---------------------------------------------------------------------- + INTEGER, PARAMETER :: MAX_SLOPETYP=30,MAX_SOILTYP=30,MAX_VEGTYP=30 + LOGICAL :: LOCAL + CHARACTER (LEN=256), INTENT(IN):: LLANDUSE, LSOIL + +! Veg parameters + INTEGER, INTENT(IN) :: VEGTYP + INTEGER, INTENT(OUT) :: NROOT + REAL, INTENT(INOUT) :: SHDFAC + REAL, INTENT(OUT) :: HS,RSMIN,RGL,SNUP, & + CMCMAX,RSMAX,TOPT, & + EMISSMIN, EMISSMAX, & + LAIMIN, LAIMAX, & + Z0MIN, Z0MAX, & + ALBEDOMIN, ALBEDOMAX, ZTOPV, ZBOTV +! Soil parameters + INTEGER, INTENT(IN) :: SOILTYP + REAL, INTENT(OUT) :: BEXP,DKSAT,DWSAT,F1,QUARTZ,SMCDRY, & + SMCMAX,SMCREF,SMCWLT,PSISAT +! General parameters + INTEGER, INTENT(IN) :: SLOPETYP,NSOIL + INTEGER :: I + + REAL, INTENT(OUT) :: SLOPE,CZIL,SBETA,FXEXP, & + CSOIL,SALP,FRZX,KDT,CFACTR, & + ZBOT,REFKDT,PTU + REAL, INTENT(OUT) :: LVCOEF + REAL,DIMENSION(1:NSOIL),INTENT(IN) :: SLDPTH,ZSOIL + REAL,DIMENSION(1:NSOIL),INTENT(OUT):: RTDIS + REAL :: FRZFACT,FRZK,REFDK + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + CHARACTER*256 :: err_message + errmsg = '' + errflg = 0 + +! SAVE +! ---------------------------------------------------------------------- +! + IF (SOILTYP .gt. SLCATS) THEN + errflg = 1 + errmsg = 'Warning: too many input soil types' + return + END IF + IF (VEGTYP .gt. LUCATS) THEN + errflg = 1 + errmsg = 'Warning: too many input landuse types' + return + END IF + IF (SLOPETYP .gt. SLPCATS) THEN + errflg = 1 + errmsg = 'Warning: too many input slope types' + return + END IF + +! ---------------------------------------------------------------------- +! SET-UP SOIL PARAMETERS +! ---------------------------------------------------------------------- + CSOIL = CSOIL_DATA + BEXP = BB (SOILTYP) + DKSAT = SATDK (SOILTYP) + DWSAT = SATDW (SOILTYP) + F1 = F11 (SOILTYP) + PSISAT = SATPSI (SOILTYP) + QUARTZ = QTZ (SOILTYP) + SMCDRY = DRYSMC (SOILTYP) + SMCMAX = MAXSMC (SOILTYP) + SMCREF = REFSMC (SOILTYP) + SMCWLT = WLTSMC (SOILTYP) +! ---------------------------------------------------------------------- +! Set-up universal parameters (not dependent on SOILTYP, VEGTYP or +! SLOPETYP) +! ---------------------------------------------------------------------- + ZBOT = ZBOT_DATA + SALP = SALP_DATA + SBETA = SBETA_DATA + REFDK = REFDK_DATA + FRZK = FRZK_DATA + FXEXP = FXEXP_DATA + REFKDT = REFKDT_DATA + PTU = 0. ! (not used yet) to satisify intent(out) + KDT = REFKDT * DKSAT / REFDK + CZIL = CZIL_DATA + SLOPE = SLOPE_DATA (SLOPETYP) + LVCOEF = LVCOEF_DATA + +! ---------------------------------------------------------------------- +! TO ADJUST FRZK PARAMETER TO ACTUAL SOIL TYPE: FRZK * FRZFACT +! ---------------------------------------------------------------------- + FRZFACT = (SMCMAX / SMCREF) * (0.412 / 0.468) + FRZX = FRZK * FRZFACT + +! ---------------------------------------------------------------------- +! SET-UP VEGETATION PARAMETERS +! ---------------------------------------------------------------------- + TOPT = TOPT_DATA + CMCMAX = CMCMAX_DATA + CFACTR = CFACTR_DATA + RSMAX = RSMAX_DATA + NROOT = NROTBL (VEGTYP) + SNUP = SNUPTBL (VEGTYP) + RSMIN = RSTBL (VEGTYP) + RGL = RGLTBL (VEGTYP) + HS = HSTBL (VEGTYP) + EMISSMIN = EMISSMINTBL (VEGTYP) + EMISSMAX = EMISSMAXTBL (VEGTYP) + LAIMIN = LAIMINTBL (VEGTYP) + LAIMAX = LAIMAXTBL (VEGTYP) + Z0MIN = Z0MINTBL (VEGTYP) + Z0MAX = Z0MAXTBL (VEGTYP) + ALBEDOMIN = ALBEDOMINTBL (VEGTYP) + ALBEDOMAX = ALBEDOMAXTBL (VEGTYP) + ZTOPV = ZTOPVTBL (VEGTYP) + ZBOTV = ZBOTVTBL (VEGTYP) + + IF (VEGTYP .eq. BARE) SHDFAC = 0.0 + IF (NROOT .gt. NSOIL) THEN + errflg = 1 + WRITE (err_message,*) 'Error: too many root layers ', & + NSOIL,NROOT + errmsg = TRIM(err_message) + return +! ---------------------------------------------------------------------- +! CALCULATE ROOT DISTRIBUTION. PRESENT VERSION ASSUMES UNIFORM +! DISTRIBUTION BASED ON SOIL LAYER DEPTHS. +! ---------------------------------------------------------------------- + END IF + DO I = 1,NROOT + RTDIS (I) = - SLDPTH (I)/ ZSOIL (NROOT) +! ---------------------------------------------------------------------- +! SET-UP SLOPE PARAMETER +! ---------------------------------------------------------------------- + END DO + +! print*,'end of PRMRED' +! print*,'VEGTYP',VEGTYP,'SOILTYP',SOILTYP,'SLOPETYP',SLOPETYP, & +! & 'CFACTR',CFACTR,'CMCMAX',CMCMAX,'RSMAX',RSMAX,'TOPT',TOPT, & +! & 'REFKDT',REFKDT,'KDT',KDT,'SBETA',SBETA, 'SHDFAC',SHDFAC, & +! & 'RSMIN',RSMIN,'RGL',RGL,'HS',HS,'ZBOT',ZBOT,'FRZX',FRZX, & +! & 'PSISAT',PSISAT,'SLOPE',SLOPE,'SNUP',SNUP,'SALP',SALP,'BEXP', & +! & BEXP, & +! & 'DKSAT',DKSAT,'DWSAT',DWSAT, & +! & 'SMCMAX',SMCMAX,'SMCWLT',SMCWLT,'SMCREF',SMCREF,'SMCDRY',SMCDRY, & +! & 'F1',F1,'QUARTZ',QUARTZ,'FXEXP',FXEXP, & +! & 'RTDIS',RTDIS,'SLDPTH',SLDPTH,'ZSOIL',ZSOIL, 'NROOT',NROOT, & +! & 'NSOIL',NSOIL,'Z0',Z0,'CZIL',CZIL,'LAI',LAI, & +! & 'CSOIL',CSOIL,'PTU',PTU, & +! & 'LOCAL', LOCAL + + END SUBROUTINE REDPRM + + SUBROUTINE ROSR12 (P,A,B,C,D,DELTA,NSOIL) + +! ---------------------------------------------------------------------- +! SUBROUTINE ROSR12 +! ---------------------------------------------------------------------- +! INVERT (SOLVE) THE TRI-DIAGONAL MATRIX PROBLEM SHOWN BELOW: +! ### ### ### ### ### ### +! #B(1), C(1), 0 , 0 , 0 , . . . , 0 # # # # # +! #A(2), B(2), C(2), 0 , 0 , . . . , 0 # # # # # +! # 0 , A(3), B(3), C(3), 0 , . . . , 0 # # # # D(3) # +! # 0 , 0 , A(4), B(4), C(4), . . . , 0 # # P(4) # # D(4) # +! # 0 , 0 , 0 , A(5), B(5), . . . , 0 # # P(5) # # D(5) # +! # . . # # . # = # . # +! # . . # # . # # . # +! # . . # # . # # . # +! # 0 , . . . , 0 , A(M-2), B(M-2), C(M-2), 0 # #P(M-2)# #D(M-2)# +! # 0 , . . . , 0 , 0 , A(M-1), B(M-1), C(M-1)# #P(M-1)# #D(M-1)# +! # 0 , . . . , 0 , 0 , 0 , A(M) , B(M) # # P(M) # # D(M) # +! ### ### ### ### ### ### +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: K, KK + + REAL, DIMENSION(1:NSOIL), INTENT(IN):: A, B, D + REAL, DIMENSION(1:NSOIL),INTENT(INOUT):: C,P,DELTA + +! ---------------------------------------------------------------------- +! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER +! ---------------------------------------------------------------------- + C (NSOIL) = 0.0 + P (1) = - C (1) / B (1) +! ---------------------------------------------------------------------- +! SOLVE THE COEFS FOR THE 1ST SOIL LAYER +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! SOLVE THE COEFS FOR SOIL LAYERS 2 THRU NSOIL +! ---------------------------------------------------------------------- + DELTA (1) = D (1) / B (1) + DO K = 2,NSOIL + P (K) = - C (K) * ( 1.0 / (B (K) + A (K) * P (K -1)) ) + DELTA (K) = (D (K) - A (K)* DELTA (K -1))* (1.0/ (B (K) + A (K)& + * P (K -1))) + END DO +! ---------------------------------------------------------------------- +! SET P TO DELTA FOR LOWEST SOIL LAYER +! ---------------------------------------------------------------------- + P (NSOIL) = DELTA (NSOIL) + +! ---------------------------------------------------------------------- +! ADJUST P FOR SOIL LAYERS 2 THRU NSOIL +! ---------------------------------------------------------------------- + DO K = 2,NSOIL + KK = NSOIL - K + 1 + P (KK) = P (KK) * P (KK +1) + DELTA (KK) + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE ROSR12 +! ---------------------------------------------------------------------- + + + SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & + TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1, & + QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND & + ,HCPCT_FASDAS ) ! fasdas + +! ---------------------------------------------------------------------- +! SUBROUTINE SHFLX +! ---------------------------------------------------------------------- +! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL +! DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL MOISTURE CONTENT BASED +! ON THE TEMPERATURE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NSOIL, VEGTYP, ISURBAN, SOILTYP + INTEGER :: I + + REAL, INTENT(IN) :: BEXP,CSOIL,DF1,DT,F1,PSISAT,QUARTZ, & + SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1 + REAL, INTENT(INOUT) :: T1 + REAL, INTENT(OUT) :: SSOIL + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SH2O + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC + REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS + REAL, PARAMETER :: T0 = 273.15 + +! +! FASDAS +! + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN +! ---------------------------------------------------------------------- + + ! Land case + + CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT, & + ZBOT,PSISAT,SH2O,DT,BEXP,SOILTYP,OPT_THCND, & + F1,DF1,QUARTZ,CSOIL,AI,BI,CI,VEGTYP,ISURBAN & + ,HCPCT_FASDAS ) !fasdas + + CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI) + + DO I = 1,NSOIL + STC (I) = STCF (I) + ENDDO + +! ---------------------------------------------------------------------- +! IN THE NO SNOWPACK CASE (VIA ROUTINE NOPAC BRANCH,) UPDATE THE GRND +! (SKIN) TEMPERATURE HERE IN RESPONSE TO THE UPDATED SOIL TEMPERATURE +! PROFILE ABOVE. (NOTE: INSPECTION OF ROUTINE SNOPAC SHOWS THAT T1 +! BELOW IS A DUMMY VARIABLE ONLY, AS SKIN TEMPERATURE IS UPDATED +! DIFFERENTLY IN ROUTINE SNOPAC) +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALCULATE SURFACE SOIL HEAT FLUX +! ---------------------------------------------------------------------- + T1 = (YY + (ZZ1- 1.0) * STC (1)) / ZZ1 + SSOIL = DF1 * (STC (1) - T1) / (0.5 * ZSOIL (1)) + +! ---------------------------------------------------------------------- + END SUBROUTINE SHFLX +! ---------------------------------------------------------------------- + + SUBROUTINE SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + & SH2O,SLOPE,KDT,FRZFACT, & + & SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + & SHDFAC,CMCMAX, & + & RUNOFF1,RUNOFF2,RUNOFF3, & + & EDIR,EC,ET, & + & DRIP, SFHEAD1RT,INFXS1RT) + +! ---------------------------------------------------------------------- +! SUBROUTINE SMFLX +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE FLUX. THE SOIL MOISTURE CONTENT (SMC - A PER +! UNIT VOLUME MEASUREMENT) IS A DEPENDENT VARIABLE THAT IS UPDATED WITH +! PROGNOSTIC EQNS. THE CANOPY MOISTURE CONTENT (CMC) IS ALSO UPDATED. +! FROZEN GROUND VERSION: NEW STATES ADDED: SH2O, AND FROZEN GROUND +! CORRECTION FACTOR, FRZFACT AND PARAMETER SLOPE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: I,K + + REAL, INTENT(IN) :: BEXP, CMCMAX, DKSAT,DWSAT, DT, EC, EDIR, & + KDT, PRCP1, SHDFAC, SLOPE, SMCMAX, SMCWLT + REAL, INTENT(OUT) :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3 + REAL, INTENT(INOUT) :: CMC + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ET,ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: SMC, SH2O + REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS, RHSTT, & + SICE, SH2OA, SH2OFG + REAL :: DUMMY, EXCESS,FRZFACT,PCPDRP,RHSCT,TRHSCT + REAL :: FAC2 + REAL :: FLIMIT + + REAL, INTENT(INOUT) :: SFHEAD1RT,INFXS1RT + +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! COMPUTE THE RIGHT HAND SIDE OF THE CANOPY EQN TERM ( RHSCT ) +! ---------------------------------------------------------------------- + DUMMY = 0. + +! ---------------------------------------------------------------------- +! CONVERT RHSCT (A RATE) TO TRHSCT (AN AMOUNT) AND ADD IT TO EXISTING +! CMC. IF RESULTING AMT EXCEEDS MAX CAPACITY, IT BECOMES DRIP AND WILL +! FALL TO THE GRND. +! ---------------------------------------------------------------------- + RHSCT = SHDFAC * PRCP1- EC + DRIP = 0. + TRHSCT = DT * RHSCT + EXCESS = CMC + TRHSCT + +! ---------------------------------------------------------------------- +! PCPDRP IS THE COMBINED PRCP1 AND DRIP (FROM CMC) THAT GOES INTO THE +! SOIL +! ---------------------------------------------------------------------- + IF (EXCESS > CMCMAX) DRIP = EXCESS - CMCMAX + PCPDRP = (1. - SHDFAC) * PRCP1+ DRIP / DT + +! ---------------------------------------------------------------------- +! STORE ICE CONTENT AT EACH SOIL LAYER BEFORE CALLING SRT and SSTEP +! + DO I = 1,NSOIL + SICE (I) = SMC (I) - SH2O (I) + END DO +! ---------------------------------------------------------------------- +! CALL SUBROUTINES SRT AND SSTEP TO SOLVE THE SOIL MOISTURE +! TENDENCY EQUATIONS. +! IF THE INFILTRATING PRECIP RATE IS NONTRIVIAL, +! (WE CONSIDER NONTRIVIAL TO BE A PRECIP TOTAL OVER THE TIME STEP +! EXCEEDING ONE ONE-THOUSANDTH OF THE WATER HOLDING CAPACITY OF +! THE FIRST SOIL LAYER) +! THEN CALL THE SRT/SSTEP SUBROUTINE PAIR TWICE IN THE MANNER OF +! TIME SCHEME "F" (IMPLICIT STATE, AVERAGED COEFFICIENT) +! OF SECTION 2 OF KALNAY AND KANAMITSU (1988, MWR, VOL 116, +! PAGES 1945-1958)TO MINIMIZE 2-DELTA-T OSCILLATIONS IN THE +! SOIL MOISTURE VALUE OF THE TOP SOIL LAYER THAT CAN ARISE BECAUSE +! OF THE EXTREME NONLINEAR DEPENDENCE OF THE SOIL HYDRAULIC +! DIFFUSIVITY COEFFICIENT AND THE HYDRAULIC CONDUCTIVITY ON THE +! SOIL MOISTURE STATE +! OTHERWISE CALL THE SRT/SSTEP SUBROUTINE PAIR ONCE IN THE MANNER OF +! TIME SCHEME "D" (IMPLICIT STATE, EXPLICIT COEFFICIENT) +! OF SECTION 2 OF KALNAY AND KANAMITSU +! PCPDRP IS UNITS OF KG/M**2/S OR MM/S, ZSOIL IS NEGATIVE DEPTH IN M +! ---------------------------------------------------------------------- +! According to Dr. Ken Mitchell's suggestion, add the second contraint +! to remove numerical instability of runoff and soil moisture +! FLIMIT is a limit value for FAC2 + FAC2=0.0 + DO I=1,NSOIL + FAC2=MAX(FAC2,SH2O(I)/SMCMAX) + ENDDO + CALL FAC2MIT(SMCMAX,FLIMIT) + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! SMC STATES REPLACED BY SH2O STATES IN SRT SUBR. SH2O & SICE STATES +! INC&UDED IN SSTEP SUBR. FROZEN GROUND CORRECTION FACTOR, FRZFACT +! ADDED. ALL WATER BALANCE CALCULATIONS USING UNFROZEN WATER +! ---------------------------------------------------------------------- + +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... Add previous ponded water to new precip drip... + PCPDRP = PCPDRP + SFHEAD1RT/1000./DT ! convert SFHEAD1RT to (m/s) +#endif + + + IF ( ( (PCPDRP * DT) > (0.0001*1000.0* (- ZSOIL (1))* SMCMAX) ) & + .OR. (FAC2 > FLIMIT) ) THEN + CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL, & + DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT) + CALL SSTEP (SH2OFG,SH2O,DUMMY,RHSTT,RHSCT,DT,NSOIL,SMCMAX, & + CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT) + DO K = 1,NSOIL + SH2OA (K) = (SH2O (K) + SH2OFG (K)) * 0.5 + END DO + CALL SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP,ZSOIL, & + DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT) + CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX, & + CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT) + + ELSE + CALL SRT (RHSTT,EDIR,ET,SH2O,SH2O,NSOIL,PCPDRP,ZSOIL, & + DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZFACT,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT) + CALL SSTEP (SH2O,SH2O,CMC,RHSTT,RHSCT,DT,NSOIL,SMCMAX, & + CMCMAX,RUNOFF3,ZSOIL,SMC,SICE,AI,BI,CI,INFXS1RT) +! RUNOF = RUNOFF + + END IF + +! ---------------------------------------------------------------------- + END SUBROUTINE SMFLX +! ---------------------------------------------------------------------- + + + SUBROUTINE SNFRAC (SNEQV,SNUP,SALP,SNOWH,SNCOVR, & + XLAI,SHDFAC,FVB,GAMA,FBUR, & + FGSN,ZTOPV,ZBOTV,UA_PHYS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNFRAC +! ---------------------------------------------------------------------- +! CALCULATE SNOW FRACTION (0 -> 1) +! SNEQV SNOW WATER EQUIVALENT (M) +! SNUP THRESHOLD SNEQV DEPTH ABOVE WHICH SNCOVR=1 +! SALP TUNING PARAMETER +! SNCOVR FRACTIONAL SNOW COVER +! ---------------------------------------------------------------------- + IMPLICIT NONE + + REAL, INTENT(IN) :: SNEQV,SNUP,SALP,SNOWH + REAL, INTENT(OUT) :: SNCOVR + REAL :: RSNOW, Z0N + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(IN) :: ZTOPV ! UA: height of canopy top + REAL, INTENT(IN) :: ZBOTV ! UA: height of canopy bottom + REAL, INTENT(IN) :: SHDFAC ! UA: vegetation fraction + REAL, INTENT(INOUT) :: XLAI ! UA: LAI modified by snow + REAL, INTENT(OUT) :: FVB ! UA: frac. veg. w/snow beneath + REAL, INTENT(OUT) :: GAMA ! UA: = EXP(-1.* XLAI) + REAL, INTENT(OUT) :: FBUR ! UA: fraction of canopy buried + REAL, INTENT(OUT) :: FGSN ! UA: ground snow cover fraction + + REAL :: SNUPGRD = 0.02 ! UA: SWE limit for ground cover + +! ---------------------------------------------------------------------- +! SNUP IS VEG-CLASS DEPENDENT SNOWDEPTH THRESHHOLD (SET IN ROUTINE +! REDPRM) ABOVE WHICH SNOCVR=1. +! ---------------------------------------------------------------------- + IF (SNEQV < SNUP) THEN + RSNOW = SNEQV / SNUP + SNCOVR = 1. - ( EXP ( - SALP * RSNOW) - RSNOW * EXP ( - SALP)) + ELSE + SNCOVR = 1.0 + END IF + +! FORMULATION OF DICKINSON ET AL. 1986 +! Z0N = 0.035 + +! SNCOVR=SNOWH/(SNOWH + 5*Z0N) + +! FORMULATION OF MARSHALL ET AL. 1994 +! SNCOVR=SNEQV/(SNEQV + 2*Z0N) + + IF(UA_PHYS) THEN + +!--------------------------------------------------------------------- +! FGSN: FRACTION OF SOIL COVERED WITH SNOW +!--------------------------------------------------------------------- + IF (SNEQV < SNUPGRD) THEN + FGSN = SNEQV / SNUPGRD + ELSE + FGSN = 1.0 + END IF +!------------------------------------------------------------------ +! FBUR: VERTICAL FRACTION OF VEGETATION COVERED BY SNOW +! GRASS, CROP, AND SHRUB: MULTIPLY 0.4 BY ZTOPV AND ZBOTV BECAUSE +! THEY WILL BE PRESSED DOWN BY THE SNOW. +! FOREST: DON'T NEED TO CHANGE ZTOPV AND ZBOTV. + + IF(ZBOTV > 0. .AND. SNOWH > ZBOTV) THEN + IF(ZBOTV <= 0.5) THEN + FBUR = (SNOWH - 0.4*ZBOTV) / (0.4*(ZTOPV-ZBOTV)) ! short veg. + ELSE + FBUR = (SNOWH - ZBOTV) / (ZTOPV-ZBOTV) ! tall veg. + ENDIF + ELSE + FBUR = 0. + ENDIF + + FBUR = MIN(MAX(FBUR,0.0),1.0) + +! XLAI IS ADJUSTED FOR VERTICAL BURYING BY SNOW + XLAI = XLAI * (1.0 - FBUR) +! ---------------------------------------------------------------------- +! SNOW-COVERED SOIL: (1-SHDFAC)*FGSN +! VEGETATION WITH SNOW ABOVE DUE TO BURIAL FVEG_SN_AB = SHDFAC*FBUR +! SNOW ON THE GROUND THAT CAN BE "SEEN" BY SATELLITE +! (IF XLAI GOES TO ZERO): GAMA*FVB +! Where GAMA = exp(-XLAI) +! ---------------------------------------------------------------------- + +! VEGETATION WITH SNOW BELOW + FVB = SHDFAC * FGSN * (1.0 - FBUR) + +! GAMA IS USED TO DIVIDE FVB INTO TWO PARTS: +! GAMA=1 FOR XLAI=0 AND GAMA=0 FOR XLAI=6 + GAMA = EXP(-1.* XLAI) + ELSE + ! Define intent(out) terms for .NOT. UA_PHYS case + FVB = 0.0 + GAMA = 0.0 + FBUR = 0.0 + FGSN = 0.0 + END IF ! UA_PHYS + +! ---------------------------------------------------------------------- + END SUBROUTINE SNFRAC +! ---------------------------------------------------------------------- + + SUBROUTINE SNKSRC (TSNSR,TAVG,SMC,SH2O,ZSOIL,NSOIL, & + & SMCMAX,PSISAT,BEXP,DT,K,QTOT) +! ---------------------------------------------------------------------- +! SUBROUTINE SNKSRC +! ---------------------------------------------------------------------- +! CALCULATE SINK/SOURCE TERM OF THE TERMAL DIFFUSION EQUATION. (SH2O) IS +! AVAILABLE LIQUED WATER. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: K,NSOIL + REAL, INTENT(IN) :: BEXP, DT, PSISAT, QTOT, SMC, SMCMAX, & + TAVG + REAL, INTENT(INOUT) :: SH2O + + REAL, DIMENSION(1:NSOIL), INTENT(IN):: ZSOIL + + REAL :: DF, DZ, DZH, FREE, TSNSR, & + TDN, TM, TUP, TZ, X0, XDN, XH2O, XUP + + REAL, PARAMETER :: DH2O = 1.0000E3, HLICE = 3.3350E5, & + T0 = 2.7315E2 + + IF (K == 1) THEN + DZ = - ZSOIL (1) + ELSE + DZ = ZSOIL (K -1) - ZSOIL (K) + END IF +! ---------------------------------------------------------------------- +! VIA FUNCTION FRH2O, COMPUTE POTENTIAL OR 'EQUILIBRIUM' UNFROZEN +! SUPERCOOLED FREE WATER FOR GIVEN SOIL TYPE AND SOIL LAYER TEMPERATURE. +! FUNCTION FRH20 INVOKES EQN (17) FROM V. KOREN ET AL (1999, JGR, VOL. +! 104, PG 19573). (ASIDE: LATTER EQN IN JOURNAL IN CENTIGRADE UNITS. +! ROUTINE FRH2O USE FORM OF EQN IN KELVIN UNITS.) +! ---------------------------------------------------------------------- +! FREE = FRH2O(TAVG,SMC,SH2O,SMCMAX,BEXP,PSISAT) + +! ---------------------------------------------------------------------- +! IN NEXT BLOCK OF CODE, INVOKE EQN 18 OF V. KOREN ET AL (1999, JGR, +! VOL. 104, PG 19573.) THAT IS, FIRST ESTIMATE THE NEW AMOUNTOF LIQUID +! WATER, 'XH2O', IMPLIED BY THE SUM OF (1) THE LIQUID WATER AT THE BEGIN +! OF CURRENT TIME STEP, AND (2) THE FREEZE OF THAW CHANGE IN LIQUID +! WATER IMPLIED BY THE HEAT FLUX 'QTOT' PASSED IN FROM ROUTINE HRT. +! SECOND, DETERMINE IF XH2O NEEDS TO BE BOUNDED BY 'FREE' (EQUIL AMT) OR +! IF 'FREE' NEEDS TO BE BOUNDED BY XH2O. +! ---------------------------------------------------------------------- + CALL FRH2O (FREE,TAVG,SMC,SH2O,SMCMAX,BEXP,PSISAT) + +! ---------------------------------------------------------------------- +! FIRST, IF FREEZING AND REMAINING LIQUID LESS THAN LOWER BOUND, THEN +! REDUCE EXTENT OF FREEZING, THEREBY LETTING SOME OR ALL OF HEAT FLUX +! QTOT COOL THE SOIL TEMP LATER IN ROUTINE HRT. +! ---------------------------------------------------------------------- + XH2O = SH2O + QTOT * DT / (DH2O * HLICE * DZ) + IF ( XH2O < SH2O .AND. XH2O < FREE) THEN + IF ( FREE > SH2O ) THEN + XH2O = SH2O + ELSE + XH2O = FREE + END IF + END IF +! ---------------------------------------------------------------------- +! SECOND, IF THAWING AND THE INCREASE IN LIQUID WATER GREATER THAN UPPER +! BOUND, THEN REDUCE EXTENT OF THAW, THEREBY LETTING SOME OR ALL OF HEAT +! FLUX QTOT WARM THE SOIL TEMP LATER IN ROUTINE HRT. +! ---------------------------------------------------------------------- + IF ( XH2O > SH2O .AND. XH2O > FREE ) THEN + IF ( FREE < SH2O ) THEN + XH2O = SH2O + ELSE + XH2O = FREE + END IF + END IF + +! ---------------------------------------------------------------------- +! CALCULATE PHASE-CHANGE HEAT SOURCE/SINK TERM FOR USE IN ROUTINE HRT +! AND UPDATE LIQUID WATER TO REFLCET FINAL FREEZE/THAW INCREMENT. +! ---------------------------------------------------------------------- +! SNKSRC = -DH2O*HLICE*DZ*(XH2O-SH2O)/DT + IF (XH2O < 0.) XH2O = 0. + IF (XH2O > SMC) XH2O = SMC + TSNSR = - DH2O * HLICE * DZ * (XH2O - SH2O)/ DT + SH2O = XH2O + +! ---------------------------------------------------------------------- + END SUBROUTINE SNKSRC +! ---------------------------------------------------------------------- + + SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,SMC,SMCMAX,SMCWLT, & + SMCREF,SMCDRY,CMC,CMCMAX,NSOIL,DT, & + SBETA,DF1, & + Q2,T1,SFCTMP,T24,TH2,FDOWN,F1,SSOIL,STC,EPSCA,& + SFCPRS,BEXP,PC,RCH,RR,CFACTR,SNCOVR,ESD,SNDENS,& + SNOWH,SH2O,SLOPE,KDT,FRZFACT,PSISAT, & + ZSOIL,DWSAT,DKSAT,TBOT,ZBOT,SHDFAC,RUNOFF1, & + RUNOFF2,RUNOFF3,EDIR,EC,ET,ETT,NROOT,SNOMLT, & + RTDIS,QUARTZ,FXEXP,CSOIL, & + BETA,DRIP,DEW,FLX1,FLX2,FLX3,ESNOW,ETNS,EMISSI,& + RIBB,SOLDN, & + ISURBAN, & + VEGTYP, & + ETPN,FLX4,UA_PHYS, & + SFHEAD1RT,INFXS1RT,ETPND1,SOILTYP,OPT_THCND & + ,QFX_PHY,fasdas,HCPCT_FASDAS, & !fasdas + SIGMA,CPH2O,CPICE,LSUBF) +! ---------------------------------------------------------------------- +! SUBROUTINE SNOPAC +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE SOIL MOISTURE +! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN A SNOW PACK IS +! PRESENT. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: OPT_THCND + INTEGER, INTENT(IN) :: NROOT, NSOIL,VEGTYP,SOILTYP + INTEGER, INTENT(IN) :: ISURBAN + INTEGER :: K +! +! kmh 09/03/2006 add IT16 for surface temperature iteration +! + INTEGER :: IT16 + LOGICAL, INTENT(IN) :: SNOWNG + +!DJG NDHMS/WRF-Hydro edit... + REAL, INTENT(INOUT) :: SFHEAD1RT,INFXS1RT,ETPND1 + + REAL, INTENT(IN) :: BEXP,CFACTR, CMCMAX,CSOIL,DF1,DKSAT, & + DT,DWSAT, EPSCA,FDOWN,F1,FXEXP, & + FRZFACT,KDT,PC, PRCP,PSISAT,Q2,QUARTZ, & + RCH,RR,SBETA,SFCPRS, SFCTMP, SHDFAC, & + SLOPE,SMCDRY,SMCMAX,SMCREF,SMCWLT, T24, & + TBOT,TH2,ZBOT,EMISSI,SOLDN,SIGMA,CPH2O, & + CPICE,LSUBF + REAL, INTENT(INOUT) :: CMC, BETA, ESD,FLX2,PRCPF,SNOWH,SNCOVR, & + SNDENS, T1, RIBB, ETP + REAL, INTENT(OUT) :: DEW,DRIP,EC,EDIR, ETNS, ESNOW,ETT, & + FLX1,FLX3, RUNOFF1,RUNOFF2,RUNOFF3, & + SSOIL,SNOMLT + REAL, DIMENSION(1:NSOIL),INTENT(IN) :: RTDIS,ZSOIL + REAL, DIMENSION(1:NSOIL),INTENT(OUT) :: ET + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: SMC,SH2O,STC + REAL, DIMENSION(1:NSOIL) :: ET1 + REAL :: DENOM,DSOIL,DTOT,EC1,EDIR1,ESDFLX,ETA, & + ETT1, ESNOW1, ESNOW2, ETA1,ETP1,ETP2, & + ETP3, ETNS1, ETANRG, ETAX, EX, FLX3X, & + FRCSNO,FRCSOI, PRCP1, QSAT,RSNOW, SEH, & + SNCOND,SSOIL1, T11,T12, T12A, T12AX, & + T12B, T14, YY, ZZ1 +! T12B, T14, YY, ZZ1,EMISSI_S +! +! kmh 01/11/2007 add T15, T16, and DTOT2 for SFC T iteration and snow heat flux +! + REAL :: T15, T16, DTOT2 + REAL, PARAMETER :: ESDMIN = 1.E-6, LSUBC = 2.501000E+6, & + LSUBS = 2.83E+6, TFREEZ = 273.15, & + SNOEXP = 2.0 + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(INOUT) :: FLX4 ! UA: energy removed by canopy + REAL, INTENT(IN) :: ETPN ! UA: adjusted pot. evap. [mm/s] + REAL :: ETP1N ! UA: adjusted pot. evap. [m/s] + +! +! FASDAS +! + REAL :: QFX_PHY + INTEGER :: fasdas + REAL, INTENT( OUT) :: HCPCT_FASDAS +! +! END FASDAS +! +! ---------------------------------------------------------------------- +! EXECUTABLE CODE BEGINS HERE: +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! INITIALIZE EVAP TERMS. +! ---------------------------------------------------------------------- +! conversions: +! ESNOW [KG M-2 S-1] +! ESDFLX [KG M-2 S-1] .le. ESNOW +! ESNOW1 [M S-1] +! ESNOW2 [M] +! ETP [KG M-2 S-1] +! ETP1 [M S-1] +! ETP2 [M] +! ---------------------------------------------------------------------- + DEW = 0. + EDIR = 0. + EDIR1 = 0. + EC1 = 0. + EC = 0. +! EMISSI_S=0.95 ! For snow + + DO K = 1,NSOIL + ET (K) = 0. + ET1 (K) = 0. + END DO + ETT = 0. + ETT1 = 0. + +!DJG NDHMS/WRF-Hydro edit... + ETPND1 = 0. + + + ETNS = 0. + ETNS1 = 0. + ESNOW = 0. + ESNOW1 = 0. + ESNOW2 = 0. + +! ---------------------------------------------------------------------- +! CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO ETP1 IN M S-1 +! ---------------------------------------------------------------------- + PRCP1 = PRCPF *0.001 +! ---------------------------------------------------------------------- +! IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE). +! ---------------------------------------------------------------------- + BETA = 1.0 + IF (ETP <= 0.0) THEN + IF ( ( RIBB >= 0.1 ) .AND. ( FDOWN > 150.0 ) ) THEN + ETP=(MIN(ETP*(1.0-RIBB),0.)*SNCOVR/0.980 + ETP*(0.980-SNCOVR))/0.980 + ENDIF + IF(ETP == 0.) BETA = 0.0 + ETP1 = ETP * 0.001 + IF(UA_PHYS) ETP1N = ETPN * 0.001 + DEW = -ETP1 + ESNOW2 = ETP1*DT + ETANRG = ETP*((1.-SNCOVR)*LSUBC + SNCOVR*LSUBS) + ELSE + ETP1 = ETP * 0.001 + IF(UA_PHYS) ETP1N = ETPN * 0.001 + ! LAND CASE + IF (SNCOVR < 1.) THEN + CALL EVAPO (ETNS1,SMC,NSOIL,CMC,ETP1,DT,ZSOIL, & + SH2O, & + SMCMAX,BEXP,PC,SMCWLT,DKSAT,DWSAT, & + SMCREF,SHDFAC,CMCMAX, & + SMCDRY,CFACTR, & + EDIR1,EC1,ET1,ETT1,SFCTMP,Q2,NROOT,RTDIS, & + FXEXP, SFHEAD1RT,ETPND1) +! ---------------------------------------------------------------------------- + EDIR1 = EDIR1* (1. - SNCOVR) + EC1 = EC1* (1. - SNCOVR) + DO K = 1,NSOIL + ET1 (K) = ET1 (K)* (1. - SNCOVR) + END DO + ETT1 = ETT1*(1.-SNCOVR) +! ETNS1 = EDIR1+ EC1+ ETT1 + ETNS1 = ETNS1*(1.-SNCOVR) +! ---------------------------------------------------------------------------- + EDIR = EDIR1*1000. + EC = EC1*1000. + DO K = 1,NSOIL + ET (K) = ET1 (K)*1000. + END DO +! +! FASDAS +! + if( fasdas == 1 ) then + QFX_PHY = EDIR + EC + DO K=1,NSOIL + QFX_PHY = QFX_PHY + ET(K) + END DO + endif +! +! END FASDAS +! + ETT = ETT1*1000. + ETNS = ETNS1*1000. + + +!DJG NDHMS/WRF-Hydro edit... + ETPND1 = ETPND1*1000. + + +! ---------------------------------------------------------------------- + + ENDIF + ESNOW = ETP*SNCOVR + IF(UA_PHYS) ESNOW = ETPN*SNCOVR ! USE ADJUSTED ETP + ESNOW1 = ESNOW*0.001 + ESNOW2 = ESNOW1*DT + ETANRG = ESNOW*LSUBS + ETNS*LSUBC + ENDIF + +! ---------------------------------------------------------------------- +! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY +! ACCUMULATING PRECIP. NOTE THAT THIS REFLECTS THE FLUX APPROPRIATE FOR +! THE NOT-YET-UPDATED SKIN TEMPERATURE (T1). ASSUMES TEMPERATURE OF THE +! SNOWFALL STRIKING THE GROUND IS =SFCTMP (LOWEST MODEL LEVEL AIR TEMP). +! ---------------------------------------------------------------------- + FLX1 = 0.0 + IF (SNOWNG) THEN + FLX1 = CPICE * PRCP * (T1- SFCTMP) + ELSE + IF (PRCP > 0.0) FLX1 = CPH2O * PRCP * (T1- SFCTMP) +! ---------------------------------------------------------------------- +! CALCULATE AN 'EFFECTIVE SNOW-GRND SFC TEMP' (T12) BASED ON HEAT FLUXES +! BETWEEN THE SNOW PACK AND THE SOIL AND ON NET RADIATION. +! INCLUDE FLX1 (PRECIP-SNOW SFC) AND FLX2 (FREEZING RAIN LATENT HEAT) +! FLUXES. FLX1 FROM ABOVE, FLX2 BROUGHT IN VIA COMMOM BLOCK RITE. +! FLX2 REFLECTS FREEZING RAIN LATENT HEAT FLUX USING T1 CALCULATED IN +! PENMAN. +! ---------------------------------------------------------------------- + END IF + DSOIL = - (0.5 * ZSOIL (1)) + DTOT = SNOWH + DSOIL + DENOM = 1.0+ DF1 / (DTOT * RR * RCH) +! surface emissivity weighted by snow cover fraction +! T12A = ( (FDOWN - FLX1 - FLX2 - & +! & ((SNCOVR*EMISSI_S)+EMISSI*(1.0-SNCOVR))*SIGMA *T24)/RCH & +! & + TH2 - SFCTMP - ETANRG/RCH ) / RR + T12A = ( (FDOWN - FLX1- FLX2- EMISSI * SIGMA * T24)/ RCH & + + TH2- SFCTMP - ETANRG / RCH ) / RR + + T12B = DF1 * STC (1) / (DTOT * RR * RCH) + +! ---------------------------------------------------------------------- +! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW +! MELT WILL OCCUR. SET THE SKIN TEMP TO THIS EFFECTIVE TEMP. REDUCE +! (BY SUBLIMINATION ) OR INCREASE (BY FROST) THE DEPTH OF THE SNOWPACK, +! DEPENDING ON SIGN OF ETP. +! UPDATE SOIL HEAT FLUX (SSOIL) USING NEW SKIN TEMPERATURE (T1) +! SINCE NO SNOWMELT, SET ACCUMULATED SNOWMELT TO ZERO, SET 'EFFECTIVE' +! PRECIP FROM SNOWMELT TO ZERO, SET PHASE-CHANGE HEAT FLUX FROM SNOWMELT +! TO ZERO. +! ---------------------------------------------------------------------- +! SUB-FREEZING BLOCK +! ---------------------------------------------------------------------- + T12 = (SFCTMP + T12A + T12B) / DENOM + IF (T12 <= TFREEZ) THEN + T1 = T12 + SSOIL = DF1 * (T1- STC (1)) / DTOT +! ESD = MAX (0.0, ESD- ETP2) + ESD = MAX(0.0, ESD-ESNOW2) + FLX3 = 0.0 + EX = 0.0 + + SNOMLT = 0.0 + IF(UA_PHYS) FLX4 = 0.0 +! ---------------------------------------------------------------------- +! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT +! WILL OCCUR. CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT. REVISE THE +! EFFECTIVE SNOW DEPTH. REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD +! DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT +! RELEASED, FLX3. SET THE EFFECTIVE PRECIP, PRCP1 TO THE SNOW MELT RATE, +! EX FOR USE IN SMFLX. ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES. +! CALCULATE QSAT VALID AT FREEZING POINT. NOTE THAT ESAT (SATURATION +! VAPOR PRESSURE) VALUE OF 6.11E+2 USED HERE IS THAT VALID AT FRZZING +! POINT. NOTE THAT ETP FROM CALL PENMAN IN SFLX IS IGNORED HERE IN +! FAVOR OF BULK ETP OVER 'OPEN WATER' AT FREEZING TEMP. +! UPDATE SOIL HEAT FLUX (S) USING NEW SKIN TEMPERATURE (T1) +! ---------------------------------------------------------------------- +! ABOVE FREEZING BLOCK +! ---------------------------------------------------------------------- + ELSE +! From V3.9 original code (commented) replaced to allow complete melting of small snow amounts +! T1 = TFREEZ * SNCOVR ** SNOEXP + T12 * (1.0- SNCOVR ** SNOEXP) + T1 = TFREEZ * max(0.01,SNCOVR ** SNOEXP) + T12 * (1.0- max(0.01,SNCOVR ** SNOEXP)) + BETA = 1.0 + +! ---------------------------------------------------------------------- +! IF POTENTIAL EVAP (SUBLIMATION) GREATER THAN DEPTH OF SNOWPACK. +! BETA<1 +! SNOWPACK HAS SUBLIMATED AWAY, SET DEPTH TO ZERO. +! ---------------------------------------------------------------------- + SSOIL = DF1 * (T1- STC (1)) / DTOT + IF (ESD-ESNOW2 <= ESDMIN) THEN + ESD = 0.0 + EX = 0.0 + SNOMLT = 0.0 + FLX3 = 0.0 + IF(UA_PHYS) FLX4 = 0.0 +! ---------------------------------------------------------------------- +! SUBLIMATION LESS THAN DEPTH OF SNOWPACK +! SNOWPACK (ESD) REDUCED BY ESNOW2 (DEPTH OF SUBLIMATED SNOW) +! ---------------------------------------------------------------------- + ELSE + ESD = ESD-ESNOW2 + ETP3 = ETP * LSUBC + SEH = RCH * (T1- TH2) + T14 = T1* T1 + T14 = T14* T14 +! FLX3 = FDOWN - FLX1 - FLX2 - & +! ((SNCOVR*EMISSI_S)+EMISSI*(1-SNCOVR))*SIGMA*T14 - & +! SSOIL - SEH - ETANRG + FLX3 = FDOWN - FLX1- FLX2- EMISSI*SIGMA * T14- SSOIL - SEH - ETANRG + IF (FLX3 <= 0.0) FLX3 = 0.0 + + IF(UA_PHYS .AND. FLX4 > 0. .AND. FLX3 > 0.) THEN + IF(FLX3 >= FLX4) THEN + FLX3 = FLX3 - FLX4 + ELSE + FLX4 = FLX3 + FLX3 = 0. + ENDIF + ELSE + FLX4 = 0.0 + ENDIF + +! ---------------------------------------------------------------------- +! SNOWMELT REDUCTION DEPENDING ON SNOW COVER +! ---------------------------------------------------------------------- + EX = FLX3*0.001/ LSUBF + +! ---------------------------------------------------------------------- +! ESDMIN REPRESENTS A SNOWPACK DEPTH THRESHOLD VALUE BELOW WHICH WE +! CHOOSE NOT TO RETAIN ANY SNOWPACK, AND INSTEAD INCLUDE IT IN SNOWMELT. +! ---------------------------------------------------------------------- + SNOMLT = EX * DT + IF (ESD- SNOMLT >= ESDMIN) THEN + ESD = ESD- SNOMLT +! ---------------------------------------------------------------------- +! SNOWMELT EXCEEDS SNOW DEPTH +! ---------------------------------------------------------------------- + ELSE + EX = ESD / DT + FLX3 = EX *1000.0* LSUBF + SNOMLT = ESD + + ESD = 0.0 +! ---------------------------------------------------------------------- +! END OF 'ESD .LE. ETP2' IF-BLOCK +! ---------------------------------------------------------------------- + END IF + END IF + +! ---------------------------------------------------------------------- +! END OF 'T12 .LE. TFREEZ' IF-BLOCK +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! IF NON-GLACIAL LAND, ADD SNOWMELT RATE (EX) TO PRECIP RATE TO BE USED +! IN SUBROUTINE SMFLX (SOIL MOISTURE EVOLUTION) VIA INFILTRATION. +! +! RUNOFF/BASEFLOW LATER NEAR THE END OF SFLX (AFTER RETURN FROM CALL TO +! SUBROUTINE SNOPAC) +! ---------------------------------------------------------------------- + PRCP1 = PRCP1+ EX + +! ---------------------------------------------------------------------- +! SET THE EFFECTIVE POTNL EVAPOTRANSP (ETP1) TO ZERO SINCE THIS IS SNOW +! CASE, SO SURFACE EVAP NOT CALCULATED FROM EDIR, EC, OR ETT IN SMFLX +! (BELOW). +! SMFLX RETURNS UPDATED SOIL MOISTURE VALUES FOR NON-GLACIAL LAND. +! ---------------------------------------------------------------------- + END IF + CALL SMFLX (SMC,NSOIL,CMC,DT,PRCP1,ZSOIL, & + SH2O,SLOPE,KDT,FRZFACT, & + SMCMAX,BEXP,SMCWLT,DKSAT,DWSAT, & + SHDFAC,CMCMAX, & + RUNOFF1,RUNOFF2,RUNOFF3, & + EDIR1,EC1,ET1, & + DRIP, SFHEAD1RT,INFXS1RT) +! ---------------------------------------------------------------------- +! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO +! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX +! MATCHES THAT ALREADY COMPUTER FOR BELOW THE SNOWPACK, THUS THE SFC +! HEAT FLUX TO BE COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE +! SNOW TOP SURFACE. T11 IS A DUMMY ARGUEMENT SO WE WILL NOT USE THE +! SKIN TEMP VALUE AS REVISED BY SHFLX. +! ---------------------------------------------------------------------- + ZZ1 = 1.0 + YY = STC (1) -0.5* SSOIL * ZSOIL (1)* ZZ1/ DF1 + +! ---------------------------------------------------------------------- +! SHFLX WILL CALC/UPDATE THE SOIL TEMPS. NOTE: THE SUB-SFC HEAT FLUX +! (SSOIL1) AND THE SKIN TEMP (T11) OUTPUT FROM THIS SHFLX CALL ARE NOT +! USED IN ANY SUBSEQUENT CALCULATIONS. RATHER, THEY ARE DUMMY VARIABLES +! HERE IN THE SNOPAC CASE, SINCE THE SKIN TEMP AND SUB-SFC HEAT FLUX ARE +! UPDATED INSTEAD NEAR THE BEGINNING OF THE CALL TO SNOPAC. +! ---------------------------------------------------------------------- + T11 = T1 + CALL SHFLX (SSOIL1,STC,SMC,SMCMAX,NSOIL,T11,DT,YY,ZZ1,ZSOIL, & + TBOT,ZBOT,SMCWLT,PSISAT,SH2O,BEXP,F1,DF1, & + QUARTZ,CSOIL,VEGTYP,ISURBAN,SOILTYP,OPT_THCND & + ,HCPCT_FASDAS ) !fasdas + +! ---------------------------------------------------------------------- +! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION. YY IS +! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN. +! ---------------------------------------------------------------------- + ! LAND + IF (ESD > 0.) THEN + CALL SNOWPACK (ESD,DT,SNOWH,SNDENS,T1,YY,SNOMLT,UA_PHYS) + ELSE + ESD = 0. + SNOWH = 0. + SNDENS = 0. + SNCOND = 1. + SNCOVR = 0. + END IF + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOPAC +! ---------------------------------------------------------------------- + + + SUBROUTINE SNOWPACK (ESD,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL,SNOMLT,UA_PHYS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNOWPACK +! ---------------------------------------------------------------------- +! CALCULATE COMPACTION OF SNOWPACK UNDER CONDITIONS OF INCREASING SNOW +! DENSITY, AS OBTAINED FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S +! DIFFERENTIAL EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, BY VICTOR +! KOREN, 03/25/95. +! ---------------------------------------------------------------------- +! ESD WATER EQUIVALENT OF SNOW (M) +! DTSEC TIME STEP (SEC) +! SNOWH SNOW DEPTH (M) +! SNDENS SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY) +! TSNOW SNOW SURFACE TEMPERATURE (K) +! TSOIL SOIL SURFACE TEMPERATURE (K) + +! SUBROUTINE WILL RETURN NEW VALUES OF SNOWH AND SNDENS +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER :: IPOL, J + REAL, INTENT(IN) :: ESD, DTSEC,TSNOW,TSOIL + REAL, INTENT(INOUT) :: SNOWH, SNDENS + REAL :: BFAC,DSX,DTHR,DW,SNOWHC,PEXP, & + TAVGC,TSNOWC,TSOILC,ESDC,ESDCX + REAL, PARAMETER :: C1 = 0.01, C2 = 21.0, G = 9.81, & + KN = 4000.0 + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(IN) :: SNOMLT ! UA: snow melt [m] + REAL :: SNOMLTC ! UA: snow melt [cm] +! ---------------------------------------------------------------------- +! CONVERSION INTO SIMULATION UNITS +! ---------------------------------------------------------------------- + SNOWHC = SNOWH *100. + ESDC = ESD *100. + IF(UA_PHYS) SNOMLTC = SNOMLT *100. + DTHR = DTSEC /3600. + TSNOWC = TSNOW -273.15 + TSOILC = TSOIL -273.15 + +! ---------------------------------------------------------------------- +! CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION +! SNDENS=DS0*(EXP(BFAC*ESD)-1.)/(BFAC*ESD) +! BFAC=DTHR*C1*EXP(0.08*TAVGC-C2*DS0) +! NOTE: BFAC*ESD IN SNDENS EQN ABOVE HAS TO BE CAREFULLY TREATED +! NUMERICALLY BELOW: +! C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR)) +! C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G +! ---------------------------------------------------------------------- + TAVGC = 0.5* (TSNOWC + TSOILC) + IF (ESDC > 1.E-2) THEN + ESDCX = ESDC + ELSE + ESDCX = 1.E-2 + END IF + +! DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC)) +! ---------------------------------------------------------------------- +! THE FUNCTION OF THE FORM (e**x-1)/x EMBEDDED IN ABOVE EXPRESSION +! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x" +! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT +! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS +! "x" APPROACHES ZERO), HENCE BELOW WE REPLACE THE (e**x-1)/x +! EXPRESSION WITH AN EQUIVALENT, NUMERICALLY WELL-BEHAVED +! POLYNOMIAL EXPANSION. + +! NUMBER OF TERMS OF POLYNOMIAL EXPANSION, AND HENCE ITS ACCURACY, +! IS GOVERNED BY ITERATION LIMIT "IPOL". +! IPOL GREATER THAN 9 ONLY MAKES A DIFFERENCE ON DOUBLE +! PRECISION (RELATIVE ERRORS GIVEN IN PERCENT %). +! IPOL=9, FOR REL.ERROR <~ 1.6 E-6 % (8 SIGNIFICANT DIGITS) +! IPOL=8, FOR REL.ERROR <~ 1.8 E-5 % (7 SIGNIFICANT DIGITS) +! IPOL=7, FOR REL.ERROR <~ 1.8 E-4 % ... +! ---------------------------------------------------------------------- + BFAC = DTHR * C1* EXP (0.08* TAVGC - C2* SNDENS) + IPOL = 4 + PEXP = 0. +! PEXP = (1. + PEXP)*BFAC*ESDC/REAL(J+1) + DO J = IPOL,1, -1 + PEXP = (1. + PEXP)* BFAC * ESDCX / REAL (J +1) + END DO + + PEXP = PEXP + 1. +! ---------------------------------------------------------------------- +! ABOVE LINE ENDS POLYNOMIAL SUBSTITUTION +! ---------------------------------------------------------------------- +! END OF KOREAN FORMULATION + +! BASE FORMULATION (COGLEY ET AL., 1990) +! CONVERT DENSITY FROM G/CM3 TO KG/M3 +! DSM=SNDENS*1000.0 + +! DSX=DSM+DTSEC*0.5*DSM*G*ESD/ +! & (1E7*EXP(-0.02*DSM+KN/(TAVGC+273.16)-14.643)) + +! & CONVERT DENSITY FROM KG/M3 TO G/CM3 +! DSX=DSX/1000.0 + +! END OF COGLEY ET AL. FORMULATION + +! ---------------------------------------------------------------------- +! SET UPPER/LOWER LIMIT ON SNOW DENSITY +! ---------------------------------------------------------------------- + DSX = SNDENS * (PEXP) + IF (DSX > 0.40) DSX = 0.40 + IF (DSX < 0.05) DSX = 0.05 +! ---------------------------------------------------------------------- +! UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER DURING +! SNOWMELT. ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED IN SNOW PER +! DAY DURING SNOWMELT TILL SNOW DENSITY 0.40. +! ---------------------------------------------------------------------- + SNDENS = DSX + IF (TSNOWC >= 0.) THEN + DW = 0.13* DTHR /24. + IF ( UA_PHYS .AND. TSOILC >= 0.) THEN + DW = MIN (DW, 0.13*SNOMLTC/(ESDCX+0.13*SNOMLTC)) + ENDIF + SNDENS = SNDENS * (1. - DW) + DW + IF (SNDENS >= 0.40) SNDENS = 0.40 +! ---------------------------------------------------------------------- +! CALCULATE SNOW DEPTH (CM) FROM SNOW WATER EQUIVALENT AND SNOW DENSITY. +! CHANGE SNOW DEPTH UNITS TO METERS +! ---------------------------------------------------------------------- + END IF + SNOWHC = ESDC / SNDENS + SNOWH = SNOWHC *0.01 + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOWPACK +! ---------------------------------------------------------------------- + + SUBROUTINE SNOWZ0 (SNCOVR,Z0, Z0BRD, SNOWH,FBUR,FGSN,SHDMAX,UA_PHYS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNOWZ0 +! ---------------------------------------------------------------------- +! CALCULATE TOTAL ROUGHNESS LENGTH OVER SNOW +! SNCOVR FRACTIONAL SNOW COVER +! Z0 ROUGHNESS LENGTH (m) +! Z0S SNOW ROUGHNESS LENGTH:=0.001 (m) +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: SNCOVR, Z0BRD + REAL, INTENT(OUT) :: Z0 + REAL, PARAMETER :: Z0S=0.001 + REAL, INTENT(IN) :: SNOWH + REAL :: BURIAL + REAL :: Z0EFF + LOGICAL, INTENT(IN) :: UA_PHYS ! UA: flag for UA option + REAL, INTENT(IN) :: FBUR ! UA: fraction of canopy buried + REAL, INTENT(IN) :: FGSN ! UA: ground snow cover fraction + REAL, INTENT(IN) :: SHDMAX ! UA: maximum vegetation fraction + REAL, PARAMETER :: Z0G=0.01 ! UA: soil roughness + REAL :: FV,A1,A2 + + IF(UA_PHYS) THEN + + FV = SHDMAX * (1.-FBUR) + A1 = (1.-FV)**2*((1.-FGSN**2)*LOG(Z0G) + (FGSN**2)*LOG(Z0S)) + A2 = (1.-(1.-FV)**2)*LOG(Z0BRD) + Z0 = EXP(A1+A2) + + ELSE + +!m Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0S + BURIAL = 7.0*Z0BRD - SNOWH + IF(BURIAL.LE.0.0007) THEN + Z0EFF = Z0S + ELSE + Z0EFF = BURIAL/7.0 + ENDIF + + Z0 = (1.- SNCOVR)* Z0BRD + SNCOVR * Z0EFF + + ENDIF +! ---------------------------------------------------------------------- + END SUBROUTINE SNOWZ0 +! ---------------------------------------------------------------------- + + + SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SNOW_NEW +! ---------------------------------------------------------------------- +! CALCULATE SNOW DEPTH AND DENSITY TO ACCOUNT FOR THE NEW SNOWFALL. +! NEW VALUES OF SNOW DEPTH & DENSITY RETURNED. + +! TEMP AIR TEMPERATURE (K) +! NEWSN NEW SNOWFALL (M) +! SNOWH SNOW DEPTH (M) +! SNDENS SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY) +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: NEWSN, TEMP + REAL, INTENT(INOUT) :: SNDENS, SNOWH + REAL :: DSNEW, HNEWC, SNOWHC,NEWSNC,TEMPC + +! ---------------------------------------------------------------------- +! CONVERSION INTO SIMULATION UNITS +! ---------------------------------------------------------------------- + SNOWHC = SNOWH *100. + NEWSNC = NEWSN *100. + +! ---------------------------------------------------------------------- +! CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE +! EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED +! AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE, +! VEMADOLEN, SWEDEN, 1980, 172-177PP. +!----------------------------------------------------------------------- + TEMPC = TEMP -273.15 + IF (TEMPC <= -15.) THEN + DSNEW = 0.05 + ELSE + DSNEW = 0.05+0.0017* (TEMPC +15.)**1.5 + END IF +! ---------------------------------------------------------------------- +! ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL +! ---------------------------------------------------------------------- + HNEWC = NEWSNC / DSNEW + IF (SNOWHC + HNEWC .LT. 1.0E-3) THEN + SNDENS = MAX(DSNEW,SNDENS) + ELSE + SNDENS = (SNOWHC * SNDENS + HNEWC * DSNEW)/ (SNOWHC + HNEWC) + ENDIF + SNOWHC = SNOWHC + HNEWC + SNOWH = SNOWHC *0.01 + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOW_NEW +! ---------------------------------------------------------------------- + + SUBROUTINE SRT (RHSTT,EDIR,ET,SH2O,SH2OA,NSOIL,PCPDRP, & + ZSOIL,DWSAT,DKSAT,SMCMAX,BEXP,RUNOFF1, & + RUNOFF2,DT,SMCWLT,SLOPE,KDT,FRZX,SICE,AI,BI,CI, & + SFHEAD1RT,INFXS1RT ) + +! ---------------------------------------------------------------------- +! SUBROUTINE SRT +! ---------------------------------------------------------------------- +! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL +! WATER DIFFUSION EQUATION. ALSO TO COMPUTE ( PREPARE ) THE MATRIX +! COEFFICIENTS FOR THE TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: IALP1, IOHINF, J, JJ, K, KS + +!DJG NDHMS/WRF-Hydro edit... Variables used in OV routing infiltration calcs + REAL, INTENT(INOUT) :: SFHEAD1RT, INFXS1RT + REAL :: SFCWATR,chcksm + + + + REAL, INTENT(IN) :: BEXP, DKSAT, DT, DWSAT, EDIR, FRZX, & + KDT, PCPDRP, SLOPE, SMCMAX, SMCWLT + REAL, INTENT(OUT) :: RUNOFF1, RUNOFF2 + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ET, SH2O, SH2OA, SICE, & + ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTT + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI, CI + REAL, DIMENSION(1:NSOIL) :: DMAX + REAL :: ACRT, DD, DDT, DDZ, DDZ2, DENOM, & + DENOM2,DICE, DSMDZ, DSMDZ2, DT1, & + FCR,INFMAX,MXSMC,MXSMC2,NUMER,PDDUM, & + PX, SICEMAX,SLOPX, SMCAV, SSTT, & + SUM, VAL, WCND, WCND2, WDF, WDF2 + INTEGER, PARAMETER :: CVFRZ = 3 + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! REFERENCE FROZEN GROUND PARAMETER, CVFRZ, IS A SHAPE PARAMETER OF +! AREAL DISTRIBUTION FUNCTION OF SOIL ICE CONTENT WHICH EQUALS 1/CV. +! CV IS A COEFFICIENT OF SPATIAL VARIATION OF SOIL ICE CONTENT. BASED +! ON FIELD DATA CV DEPENDS ON AREAL MEAN OF FROZEN DEPTH, AND IT CLOSE +! TO CONSTANT = 0.6 IF AREAL MEAN FROZEN DEPTH IS ABOVE 20 CM. THAT IS +! WHY PARAMETER CVFRZ = 3 (INT{1/0.6*0.6}). +! CURRENT LOGIC DOESN'T ALLOW CVFRZ BE BIGGER THAN 3 +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF. INCLUDE THE +! INFILTRATION FORMULE FROM SCHAAKE AND KOREN MODEL. +! MODIFIED BY Q DUAN +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! LET SICEMAX BE THE GREATEST, IF ANY, FROZEN WATER CONTENT WITHIN SOIL +! LAYERS. +! ---------------------------------------------------------------------- + IOHINF = 1 + SICEMAX = 0.0 + DO KS = 1,NSOIL + IF (SICE (KS) > SICEMAX) SICEMAX = SICE (KS) +! ---------------------------------------------------------------------- +! DETERMINE RAINFALL INFILTRATION RATE AND RUNOFF +! ---------------------------------------------------------------------- + END DO + +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG Use previously merged Precip and Sfchead for infil. cap. calc. + SFCWATR = PCPDRP + PDDUM = SFCWATR +!DJG original PDDUM = PCPDRP + RUNOFF1 = 0.0 + INFXS1RT = 0.0 +#else + PDDUM = PCPDRP + RUNOFF1 = 0.0 +#endif + + + +! ---------------------------------------------------------------------- +! MODIFIED BY Q. DUAN, 5/16/94 +! ---------------------------------------------------------------------- +! IF (IOHINF == 1) THEN + +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG IF (PCPDRP /= 0.0) THEN + IF (SFCWATR /= 0.0) THEN +#else + IF (PCPDRP /= 0.0) THEN +#endif + DT1 = DT /86400. + SMCAV = SMCMAX - SMCWLT + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! ---------------------------------------------------------------------- + DMAX (1)= - ZSOIL (1)* SMCAV + + DICE = - ZSOIL (1) * SICE (1) + DMAX (1)= DMAX (1)* (1.0- (SH2OA (1) + SICE (1) - SMCWLT)/ & + SMCAV) + + DD = DMAX (1) + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! ---------------------------------------------------------------------- + DO KS = 2,NSOIL + + DICE = DICE+ ( ZSOIL (KS -1) - ZSOIL (KS) ) * SICE (KS) + DMAX (KS) = (ZSOIL (KS -1) - ZSOIL (KS))* SMCAV + DMAX (KS) = DMAX (KS)* (1.0- (SH2OA (KS) + SICE (KS) & + - SMCWLT)/ SMCAV) + DD = DD+ DMAX (KS) +! ---------------------------------------------------------------------- +! VAL = (1.-EXP(-KDT*SQRT(DT1))) +! IN BELOW, REMOVE THE SQRT IN ABOVE +! ---------------------------------------------------------------------- + END DO + VAL = (1. - EXP ( - KDT * DT1)) + DDT = DD * VAL +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG PX = PCPDRP * DT + PX = SFCWATR * DT +#else + PX = PCPDRP * DT +#endif + IF (PX < 0.0) PX = 0.0 + + + +! ---------------------------------------------------------------------- +! FROZEN GROUND VERSION: +! REDUCTION OF INFILTRATION BASED ON FROZEN GROUND PARAMETERS +! ---------------------------------------------------------------------- + INFMAX = (PX * (DDT / (PX + DDT)))/ DT + FCR = 1. + IF (DICE > 1.E-2) THEN + ACRT = CVFRZ * FRZX / DICE + SUM = 1. + IALP1 = CVFRZ - 1 + DO J = 1,IALP1 + K = 1 + DO JJ = J +1,IALP1 + K = K * JJ + END DO + SUM = SUM + (ACRT ** ( CVFRZ - J)) / FLOAT (K) + END DO + FCR = 1. - EXP ( - ACRT) * SUM + END IF + +! ---------------------------------------------------------------------- +! CORRECTION OF INFILTRATION LIMITATION: +! IF INFMAX .LE. HYDROLIC CONDUCTIVITY ASSIGN INFMAX THE VALUE OF +! HYDROLIC CONDUCTIVITY +! ---------------------------------------------------------------------- +! MXSMC = MAX ( SH2OA(1), SH2OA(2) ) + INFMAX = INFMAX * FCR + + MXSMC = SH2OA (1) + CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) + INFMAX = MAX (INFMAX,WCND) + + INFMAX = MIN (INFMAX,PX/DT) +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG IF (PCPDRP > INFMAX) THEN + IF (SFCWATR > INFMAX) THEN +!DJG RUNOFF1 = PCPDRP - INFMAX + RUNOFF1 = SFCWATR - INFMAX +#else + IF (PCPDRP > INFMAX) THEN + RUNOFF1 = PCPDRP - INFMAX +#endif + INFXS1RT = RUNOFF1*DT*1000. + PDDUM = INFMAX + END IF + +! ---------------------------------------------------------------------- +! TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN LINE +! BELOW REPLACED WITH NEW APPROACH IN 2ND LINE: +! 'MXSMC = MAX(SH2OA(1), SH2OA(2))' +! ---------------------------------------------------------------------- + END IF + + MXSMC = SH2OA (1) + CALL WDFCND (WDF,WCND,MXSMC,SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER +! ---------------------------------------------------------------------- + DDZ = 1. / ( - .5 * ZSOIL (2) ) + AI (1) = 0.0 + BI (1) = WDF * DDZ / ( - ZSOIL (1) ) + +! ---------------------------------------------------------------------- +! CALC RHSTT FOR THE TOP LAYER AFTER CALC'NG THE VERTICAL SOIL MOISTURE +! GRADIENT BTWN THE TOP AND NEXT TO TOP LAYERS. +! ---------------------------------------------------------------------- + CI (1) = - BI (1) + DSMDZ = ( SH2O (1) - SH2O (2) ) / ( - .5 * ZSOIL (2) ) + RHSTT (1) = (WDF * DSMDZ + WCND- PDDUM + EDIR + ET (1))/ ZSOIL (1) + +! ---------------------------------------------------------------------- +! INITIALIZE DDZ2 +! ---------------------------------------------------------------------- + SSTT = WDF * DSMDZ + WCND+ EDIR + ET (1) + +! ---------------------------------------------------------------------- +! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABV PROCESS +! ---------------------------------------------------------------------- + DDZ2 = 0.0 + DO K = 2,NSOIL + DENOM2 = (ZSOIL (K -1) - ZSOIL (K)) + IF (K /= NSOIL) THEN + +! ---------------------------------------------------------------------- +! AGAIN, TO AVOID SPURIOUS DRAINAGE BEHAVIOR, 'UPSTREAM DIFFERENCING' IN +! LINE BELOW REPLACED WITH NEW APPROACH IN 2ND LINE: +! 'MXSMC2 = MAX (SH2OA(K), SH2OA(K+1))' +! ---------------------------------------------------------------------- + SLOPX = 1. + + MXSMC2 = SH2OA (K) + CALL WDFCND (WDF2,WCND2,MXSMC2,SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) +! ----------------------------------------------------------------------- +! CALC SOME PARTIAL PRODUCTS FOR LATER USE IN CALC'NG RHSTT +! ---------------------------------------------------------------------- + DENOM = (ZSOIL (K -1) - ZSOIL (K +1)) + +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT +! ---------------------------------------------------------------------- + DSMDZ2 = (SH2O (K) - SH2O (K +1)) / (DENOM * 0.5) + DDZ2 = 2.0 / DENOM + CI (K) = - WDF2 * DDZ2 / DENOM2 + + ELSE +! ---------------------------------------------------------------------- +! SLOPE OF BOTTOM LAYER IS INTRODUCED +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! RETRIEVE THE SOIL WATER DIFFUSIVITY AND HYDRAULIC CONDUCTIVITY FOR +! THIS LAYER +! ---------------------------------------------------------------------- + SLOPX = SLOPE + CALL WDFCND (WDF2,WCND2,SH2OA (NSOIL),SMCMAX,BEXP,DKSAT,DWSAT, & + SICEMAX) + +! ---------------------------------------------------------------------- +! CALC A PARTIAL PRODUCT FOR LATER USE IN CALC'NG RHSTT +! ---------------------------------------------------------------------- + +! ---------------------------------------------------------------------- +! SET MATRIX COEF CI TO ZERO +! ---------------------------------------------------------------------- + DSMDZ2 = 0.0 + CI (K) = 0.0 +! ---------------------------------------------------------------------- +! CALC RHSTT FOR THIS LAYER AFTER CALC'NG ITS NUMERATOR +! ---------------------------------------------------------------------- + END IF + NUMER = (WDF2 * DSMDZ2) + SLOPX * WCND2- (WDF * DSMDZ) & + - WCND+ ET (K) + +! ---------------------------------------------------------------------- +! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER +! ---------------------------------------------------------------------- + RHSTT (K) = NUMER / ( - DENOM2) + AI (K) = - WDF * DDZ / DENOM2 + +! ---------------------------------------------------------------------- +! RESET VALUES OF WDF, WCND, DSMDZ, AND DDZ FOR LOOP TO NEXT LYR +! RUNOFF2: SUB-SURFACE OR BASEFLOW RUNOFF +! ---------------------------------------------------------------------- + BI (K) = - ( AI (K) + CI (K) ) + IF (K .eq. NSOIL) THEN + RUNOFF2 = SLOPX * WCND2 + END IF + IF (K .ne. NSOIL) THEN + WDF = WDF2 + WCND = WCND2 + DSMDZ = DSMDZ2 + DDZ = DDZ2 + END IF + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE SRT +! ---------------------------------------------------------------------- + + SUBROUTINE SSTEP (SH2OOUT,SH2OIN,CMC,RHSTT,RHSCT,DT, & + NSOIL,SMCMAX,CMCMAX,RUNOFF3,ZSOIL,SMC,SICE, & + AI,BI,CI, INFXS1RT) + +! ---------------------------------------------------------------------- +! SUBROUTINE SSTEP +! ---------------------------------------------------------------------- +! CALCULATE/UPDATE SOIL MOISTURE CONTENT VALUES AND CANOPY MOISTURE +! CONTENT VALUES. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: I, K, KK11 + +!!DJG NDHMS/WRF-Hydro edit... + REAL, INTENT(INOUT) :: INFXS1RT + REAL :: AVAIL + + REAL, INTENT(IN) :: CMCMAX, DT, SMCMAX + REAL, INTENT(OUT) :: RUNOFF3 + REAL, INTENT(INOUT) :: CMC + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SH2OIN, SICE, ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: SH2OOUT + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: RHSTT, SMC + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: AI, BI, CI + REAL, DIMENSION(1:NSOIL) :: RHSTTin + REAL, DIMENSION(1:NSOIL) :: CIin + REAL :: DDZ, RHSCT, STOT, WPLUS + +! ---------------------------------------------------------------------- +! CREATE 'AMOUNT' VALUES OF VARIABLES TO BE INPUT TO THE +! TRI-DIAGONAL MATRIX ROUTINE. +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTT (K) = RHSTT (K) * DT + AI (K) = AI (K) * DT + BI (K) = 1. + BI (K) * DT + CI (K) = CI (K) * DT + END DO +! ---------------------------------------------------------------------- +! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12 +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTTin (K) = RHSTT (K) + END DO + DO K = 1,NSOIL + CIin (K) = CI (K) + END DO +! ---------------------------------------------------------------------- +! CALL ROSR12 TO SOLVE THE TRI-DIAGONAL MATRIX +! ---------------------------------------------------------------------- + CALL ROSR12 (CI,AI,BI,CIin,RHSTTin,RHSTT,NSOIL) +! ---------------------------------------------------------------------- +! SUM THE PREVIOUS SMC VALUE AND THE MATRIX SOLUTION TO GET A +! NEW VALUE. MIN ALLOWABLE VALUE OF SMC WILL BE 0.02. +! RUNOFF3: RUNOFF WITHIN SOIL LAYERS +! ---------------------------------------------------------------------- + WPLUS = 0.0 + RUNOFF3 = 0. + + DDZ = - ZSOIL (1) + DO K = 1,NSOIL + IF (K /= 1) DDZ = ZSOIL (K - 1) - ZSOIL (K) + SH2OOUT (K) = SH2OIN (K) + CI (K) + WPLUS / DDZ + STOT = SH2OOUT (K) + SICE (K) + IF (STOT > SMCMAX) THEN + IF (K .eq. 1) THEN + DDZ = - ZSOIL (1) + ELSE + KK11 = K - 1 + DDZ = - ZSOIL (K) + ZSOIL (KK11) + END IF + WPLUS = (STOT - SMCMAX) * DDZ + ELSE + WPLUS = 0. + END IF + SMC (K) = MAX ( MIN (STOT,SMCMAX),0.02 ) + SH2OOUT (K) = MAX ( (SMC (K) - SICE (K)),0.0) + END DO +#ifdef WRF_HYDRO +!DJG NDHMS/WRF-Hydro edit... +!DJG Modifications to redstribute WPLUS/RUNOFF3 (soil moisture closure error) to soil profile +!DJG beginning at bottom layer (NSOIL) + IF (WPLUS > 0.) THEN + DO K=NSOIL,2,-1 + + IF (K .eq. 2) THEN !Assign soil depths + DDZ = -ZSOIL(1) + ELSE + DDZ = ZSOIL(K-2)-ZSOIL(K-1) + END IF + + AVAIL = (SMCMAX - SMC(K-1)) * DDZ !Det. Avail. Stor. + +! print *, "ZZZZZ", K,DDZ,AVAIL,WPLUS,SMC(K),SMC(K-1),SMCMAX + + IF (WPLUS <= AVAIL) THEN + SMC(K-1) = SMC(K-1) + WPLUS/DDZ + WPLUS = 0. + ELSE + SMC(K-1) = SMCMAX + WPLUS = WPLUS - AVAIL + IF (K-1 .eq. 1) THEN + INFXS1RT = INFXS1RT + WPLUS*1000 + WPLUS = 0. + END IF + END IF + +! SMC (K) = MAX ( MIN (STOT,SMCMAX),0.02 ) + SH2OOUT (K) = MAX ( (SMC (K) - SICE (K)),0.0) + + END DO + END IF +!DJG NDHMS/WRF-Hydro edit...End of modification +#endif + + +! ---------------------------------------------------------------------- +! UPDATE CANOPY WATER CONTENT/INTERCEPTION (CMC). CONVERT RHSCT TO +! AN 'AMOUNT' VALUE AND ADD TO PREVIOUS CMC VALUE TO GET NEW CMC. +! ---------------------------------------------------------------------- + RUNOFF3 = WPLUS + CMC = CMC + DT * RHSCT + IF (CMC < 1.E-20) CMC = 0.0 + CMC = MIN (CMC,CMCMAX) + +! ---------------------------------------------------------------------- + END SUBROUTINE SSTEP +! ---------------------------------------------------------------------- + + SUBROUTINE TBND (TU,TB,ZSOIL,ZBOT,K,NSOIL,TBND1) + +! ---------------------------------------------------------------------- +! SUBROUTINE TBND +! ---------------------------------------------------------------------- +! CALCULATE TEMPERATURE ON THE BOUNDARY OF THE LAYER BY INTERPOLATION OF +! THE MIDDLE LAYER TEMPERATURES +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: K + REAL, INTENT(IN) :: TB, TU, ZBOT + REAL, INTENT(OUT) :: TBND1 + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL + REAL :: ZB, ZUP + REAL, PARAMETER :: T0 = 273.15 + +! ---------------------------------------------------------------------- +! USE SURFACE TEMPERATURE ON THE TOP OF THE FIRST LAYER +! ---------------------------------------------------------------------- + IF (K == 1) THEN + ZUP = 0. + ELSE + ZUP = ZSOIL (K -1) + END IF +! ---------------------------------------------------------------------- +! USE DEPTH OF THE CONSTANT BOTTOM TEMPERATURE WHEN INTERPOLATE +! TEMPERATURE INTO THE LAST LAYER BOUNDARY +! ---------------------------------------------------------------------- + IF (K == NSOIL) THEN + ZB = 2.* ZBOT - ZSOIL (K) + ELSE + ZB = ZSOIL (K +1) + END IF +! ---------------------------------------------------------------------- +! LINEAR INTERPOLATION BETWEEN THE AVERAGE LAYER TEMPERATURES +! ---------------------------------------------------------------------- + + TBND1 = TU + (TB - TU)* (ZUP - ZSOIL (K))/ (ZUP - ZB) +! ---------------------------------------------------------------------- + END SUBROUTINE TBND +! ---------------------------------------------------------------------- + + + SUBROUTINE TDFCND ( DF, SMC, QZ, SMCMAX, SH2O, BEXP, PSISAT, SOILTYP, OPT_THCND) + +! ---------------------------------------------------------------------- +! SUBROUTINE TDFCND +! ---------------------------------------------------------------------- +! CALCULATE THERMAL DIFFUSIVITY AND CONDUCTIVITY OF THE SOIL FOR A GIVEN +! POINT AND TIME. +! ---------------------------------------------------------------------- +! PETERS-LIDARD APPROACH (PETERS-LIDARD et al., 1998) +! June 2001 CHANGES: FROZEN SOIL CONDITION. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: SOILTYP, OPT_THCND + REAL, INTENT(IN) :: QZ, SMC, SMCMAX, SH2O, BEXP, PSISAT + REAL, INTENT(OUT) :: DF + REAL :: AKE, GAMMD, THKDRY, THKICE, THKO, & + THKQTZ,THKSAT,THKS,THKW,SATRATIO,XU, & + XUNFROZ,AKEI,AKEL,PSIF,PF + +! ---------------------------------------------------------------------- +! WE NOW GET QUARTZ AS AN INPUT ARGUMENT (SET IN ROUTINE REDPRM): +! DATA QUARTZ /0.82, 0.10, 0.25, 0.60, 0.52, +! & 0.35, 0.60, 0.40, 0.82/ +! ---------------------------------------------------------------------- +! IF THE SOIL HAS ANY MOISTURE CONTENT COMPUTE A PARTIAL SUM/PRODUCT +! OTHERWISE USE A CONSTANT VALUE WHICH WORKS WELL WITH MOST SOILS +! ---------------------------------------------------------------------- +! THKW ......WATER THERMAL CONDUCTIVITY +! THKQTZ ....THERMAL CONDUCTIVITY FOR QUARTZ +! THKO ......THERMAL CONDUCTIVITY FOR OTHER SOIL COMPONENTS +! THKS ......THERMAL CONDUCTIVITY FOR THE SOLIDS COMBINED(QUARTZ+OTHER) +! THKICE ....ICE THERMAL CONDUCTIVITY +! SMCMAX ....POROSITY (= SMCMAX) +! QZ .........QUARTZ CONTENT (SOIL TYPE DEPENDENT) +! ---------------------------------------------------------------------- +! USE AS IN PETERS-LIDARD, 1998 (MODIF. FROM JOHANSEN, 1975). + +! PABLO GRUNMANN, 08/17/98 +! REFS.: +! FAROUKI, O.T.,1986: THERMAL PROPERTIES OF SOILS. SERIES ON ROCK +! AND SOIL MECHANICS, VOL. 11, TRANS TECH, 136 PP. +! JOHANSEN, O., 1975: THERMAL CONDUCTIVITY OF SOILS. PH.D. THESIS, +! UNIVERSITY OF TRONDHEIM, +! PETERS-LIDARD, C. D., ET AL., 1998: THE EFFECT OF SOIL THERMAL +! CONDUCTIVITY PARAMETERIZATION ON SURFACE ENERGY FLUXES +! AND TEMPERATURES. JOURNAL OF THE ATMOSPHERIC SCIENCES, +! VOL. 55, PP. 1209-1224. +! ---------------------------------------------------------------------- + +IF ( OPT_THCND == 1 .OR. ( OPT_THCND == 2 .AND. (SOILTYP /= 4 .AND. SOILTYP /= 3)) )THEN + +! NEEDS PARAMETERS +! POROSITY(SOIL TYPE): +! POROS = SMCMAX +! SATURATION RATIO: +! PARAMETERS W/(M.K) + SATRATIO = SMC / SMCMAX +! ICE CONDUCTIVITY: + THKICE = 2.2 +! WATER CONDUCTIVITY: + THKW = 0.57 +! THERMAL CONDUCTIVITY OF "OTHER" SOIL COMPONENTS +! IF (QZ .LE. 0.2) THKO = 3.0 + THKO = 2.0 +! QUARTZ' CONDUCTIVITY + THKQTZ = 7.7 +! SOLIDS' CONDUCTIVITY + THKS = (THKQTZ ** QZ)* (THKO ** (1. - QZ)) + +! UNFROZEN FRACTION (FROM 1., i.e., 100%LIQUID, TO 0. (100% FROZEN)) + XUNFROZ = SH2O / SMC +! UNFROZEN VOLUME FOR SATURATION (POROSITY*XUNFROZ) + XU = XUNFROZ * SMCMAX + +! SATURATED THERMAL CONDUCTIVITY + THKSAT = THKS ** (1. - SMCMAX)* THKICE ** (SMCMAX - XU)* THKW ** & + (XU) + +! DRY DENSITY IN KG/M3 + GAMMD = (1. - SMCMAX)*2700. + +! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1 + THKDRY = (0.135* GAMMD+ 64.7)/ (2700. - 0.947* GAMMD) +! FROZEN + AKEI = SATRATIO +! UNFROZEN +! RANGE OF VALIDITY FOR THE KERSTEN NUMBER (AKE) + +! KERSTEN NUMBER (USING "FINE" FORMULA, VALID FOR SOILS CONTAINING AT +! LEAST 5% OF PARTICLES WITH DIAMETER LESS THAN 2.E-6 METERS.) +! (FOR "COARSE" FORMULA, SEE PETERS-LIDARD ET AL., 1998). + + IF ( SATRATIO > 0.1 ) THEN + + AKEL = LOG10 (SATRATIO) + 1.0 + +! USE K = KDRY + ELSE + + AKEL = 0.0 + END IF + AKE = ((SMC-SH2O)*AKEI + SH2O*AKEL)/SMC +! THERMAL CONDUCTIVITY + + + DF = AKE * (THKSAT - THKDRY) + THKDRY + + ELSE + +! use the Mccumber and Pielke approach for silt loam (4), sandy loam (3) + + PSIF = PSISAT*100.*(SMCMAX/(SMC))**BEXP +!--- PSIF should be in [CM] to compute PF + PF=log10(abs(PSIF)) +!--- HK is for McCumber thermal conductivity + IF(PF.LE.5.1) THEN + DF=420.*EXP(-(PF+2.7)) + ELSE + DF=.1744 + END IF + + ENDIF ! for OPT_THCND OPTIONS +! ---------------------------------------------------------------------- + END SUBROUTINE TDFCND +! ---------------------------------------------------------------------- + + SUBROUTINE TMPAVG (TAVG,TUP,TM,TDN,ZSOIL,NSOIL,K) + +! ---------------------------------------------------------------------- +! SUBROUTINE TMPAVG +! ---------------------------------------------------------------------- +! CALCULATE SOIL LAYER AVERAGE TEMPERATURE (TAVG) IN FREEZING/THAWING +! LAYER USING UP, DOWN, AND MIDDLE LAYER TEMPERATURES (TUP, TDN, TM), +! WHERE TUP IS AT TOP BOUNDARY OF LAYER, TDN IS AT BOTTOM BOUNDARY OF +! LAYER. TM IS LAYER PROGNOSTIC STATE TEMPERATURE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER K + + INTEGER NSOIL + REAL DZ + REAL DZH + REAL T0 + REAL TAVG + REAL TDN + REAL TM + REAL TUP + REAL X0 + REAL XDN + REAL XUP + + REAL ZSOIL (NSOIL) + +! ---------------------------------------------------------------------- + PARAMETER (T0 = 2.7315E2) + IF (K .eq. 1) THEN + DZ = - ZSOIL (1) + ELSE + DZ = ZSOIL (K -1) - ZSOIL (K) + END IF + + DZH = DZ *0.5 + IF (TUP .lt. T0) THEN + IF (TM .lt. T0) THEN +! ---------------------------------------------------------------------- +! TUP, TM, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + TAVG = (TUP + 2.0* TM + TDN)/ 4.0 +! ---------------------------------------------------------------------- +! TUP & TM < T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + X0 = (T0- TM) * DZH / (TDN - TM) + TAVG = 0.5 * (TUP * DZH + TM * (DZH + X0) + T0* ( & + & 2.* DZH - X0)) / DZ + END IF + ELSE +! ---------------------------------------------------------------------- +! TUP < T0, TM .ge. T0, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + XUP = (T0- TUP) * DZH / (TM - TUP) + XDN = DZH - (T0- TM) * DZH / (TDN - TM) + TAVG = 0.5 * (TUP * XUP + T0* (2.* DZ - XUP - XDN) & + & + TDN * XDN) / DZ +! ---------------------------------------------------------------------- +! TUP < T0, TM .ge. T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + XUP = (T0- TUP) * DZH / (TM - TUP) + TAVG = 0.5 * (TUP * XUP + T0* (2.* DZ - XUP)) / DZ + END IF + END IF + ELSE + IF (TM .lt. T0) THEN +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM < T0, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + XUP = DZH - (T0- TUP) * DZH / (TM - TUP) + TAVG = 0.5 * (T0* (DZ - XUP) + TM * (DZH + XUP) & + & + TDN * DZH) / DZ +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM < T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + XUP = DZH - (T0- TUP) * DZH / (TM - TUP) + XDN = (T0- TM) * DZH / (TDN - TM) + TAVG = 0.5 * (T0* (2.* DZ - XUP - XDN) + TM * & + & (XUP + XDN)) / DZ + END IF + ELSE +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM .ge. T0, TDN < T0 +! ---------------------------------------------------------------------- + IF (TDN .lt. T0) THEN + XDN = DZH - (T0- TM) * DZH / (TDN - TM) + TAVG = (T0* (DZ - XDN) +0.5* (T0+ TDN)* XDN) / DZ +! ---------------------------------------------------------------------- +! TUP .ge. T0, TM .ge. T0, TDN .ge. T0 +! ---------------------------------------------------------------------- + ELSE + TAVG = (TUP + 2.0* TM + TDN) / 4.0 + END IF + END IF + END IF +! ---------------------------------------------------------------------- + END SUBROUTINE TMPAVG +! ---------------------------------------------------------------------- + + SUBROUTINE TRANSP (ET,NSOIL,ETP1,SMC,CMC,ZSOIL,SHDFAC,SMCWLT, & + & CMCMAX,PC,CFACTR,SMCREF,SFCTMP,Q2,NROOT, & + & RTDIS) + +! ---------------------------------------------------------------------- +! SUBROUTINE TRANSP +! ---------------------------------------------------------------------- +! CALCULATE TRANSPIRATION FOR THE VEG CLASS. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER I + INTEGER K + INTEGER NSOIL + + INTEGER NROOT + REAL CFACTR + REAL CMC + REAL CMCMAX + REAL DENOM + REAL ET (NSOIL) + REAL ETP1 + REAL ETP1A +!.....REAL PART(NSOIL) + REAL GX (NROOT) + REAL PC + REAL Q2 + REAL RTDIS (NSOIL) + REAL RTX + REAL SFCTMP + REAL SGX + REAL SHDFAC + REAL SMC (NSOIL) + REAL SMCREF + REAL SMCWLT + +! ---------------------------------------------------------------------- +! INITIALIZE PLANT TRANSP TO ZERO FOR ALL SOIL LAYERS. +! ---------------------------------------------------------------------- + REAL ZSOIL (NSOIL) + DO K = 1,NSOIL + ET (K) = 0. +! ---------------------------------------------------------------------- +! CALCULATE AN 'ADJUSTED' POTENTIAL TRANSPIRATION +! IF STATEMENT BELOW TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO +! NOTE: GX AND OTHER TERMS BELOW REDISTRIBUTE TRANSPIRATION BY LAYER, +! ET(K), AS A FUNCTION OF SOIL MOISTURE AVAILABILITY, WHILE PRESERVING +! TOTAL ETP1A. +! ---------------------------------------------------------------------- + END DO + IF (CMC .ne. 0.0) THEN + ETP1A = SHDFAC * PC * ETP1 * (1.0- (CMC / CMCMAX) ** CFACTR) + ELSE + ETP1A = SHDFAC * PC * ETP1 + END IF + SGX = 0.0 + DO I = 1,NROOT + GX (I) = ( SMC (I) - SMCWLT ) / ( SMCREF - SMCWLT ) + GX (I) = MAX ( MIN ( GX (I), 1. ), 0. ) + SGX = SGX + GX (I) + END DO + + SGX = SGX / NROOT + DENOM = 0. + DO I = 1,NROOT + RTX = RTDIS (I) + GX (I) - SGX + GX (I) = GX (I) * MAX ( RTX, 0. ) + DENOM = DENOM + GX (I) + END DO + + IF (DENOM .le. 0.0) DENOM = 1. + DO I = 1,NROOT + ET (I) = ETP1A * GX (I) / DENOM +! ---------------------------------------------------------------------- +! ABOVE CODE ASSUMES A VERTICALLY UNIFORM ROOT DISTRIBUTION +! CODE BELOW TESTS A VARIABLE ROOT DISTRIBUTION +! ---------------------------------------------------------------------- +! ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * GX * ETP1A +! ET(1) = ( ZSOIL(1) / ZSOIL(NROOT) ) * ETP1A +! ---------------------------------------------------------------------- +! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ET(1) = RTDIS(1) * ETP1A +! ET(1) = ETP1A * PART(1) +! ---------------------------------------------------------------------- +! LOOP DOWN THRU THE SOIL LAYERS REPEATING THE OPERATION ABOVE, +! BUT USING THE THICKNESS OF THE SOIL LAYER (RATHER THAN THE +! ABSOLUTE DEPTH OF EACH LAYER) IN THE FINAL CALCULATION. +! ---------------------------------------------------------------------- +! DO K = 2,NROOT +! GX = ( SMC(K) - SMCWLT ) / ( SMCREF - SMCWLT ) +! GX = MAX ( MIN ( GX, 1. ), 0. ) +! TEST CANOPY RESISTANCE +! GX = 1.0 +! ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*GX*ETP1A +! ET(K) = ((ZSOIL(K)-ZSOIL(K-1))/ZSOIL(NROOT))*ETP1A +! ---------------------------------------------------------------------- +! USING ROOT DISTRIBUTION AS WEIGHTING FACTOR +! ---------------------------------------------------------------------- +! ET(K) = RTDIS(K) * ETP1A +! ET(K) = ETP1A*PART(K) +! END DO + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE TRANSP +! ---------------------------------------------------------------------- + + SUBROUTINE WDFCND (WDF,WCND,SMC,SMCMAX,BEXP,DKSAT,DWSAT, & + & SICEMAX) + +! ---------------------------------------------------------------------- +! SUBROUTINE WDFCND +! ---------------------------------------------------------------------- +! CALCULATE SOIL WATER DIFFUSIVITY AND SOIL HYDRAULIC CONDUCTIVITY. +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL BEXP + REAL DKSAT + REAL DWSAT + REAL EXPON + REAL FACTR1 + REAL FACTR2 + REAL SICEMAX + REAL SMC + REAL SMCMAX + REAL VKwgt + REAL WCND + +! ---------------------------------------------------------------------- +! CALC THE RATIO OF THE ACTUAL TO THE MAX PSBL SOIL H2O CONTENT +! ---------------------------------------------------------------------- + REAL WDF + FACTR1 = 0.05 / SMCMAX + +! ---------------------------------------------------------------------- +! PREP AN EXPNTL COEF AND CALC THE SOIL WATER DIFFUSIVITY +! ---------------------------------------------------------------------- + FACTR2 = SMC / SMCMAX + FACTR1 = MIN(FACTR1,FACTR2) + EXPON = BEXP + 2.0 + +! ---------------------------------------------------------------------- +! FROZEN SOIL HYDRAULIC DIFFUSIVITY. VERY SENSITIVE TO THE VERTICAL +! GRADIENT OF UNFROZEN WATER. THE LATTER GRADIENT CAN BECOME VERY +! EXTREME IN FREEZING/THAWING SITUATIONS, AND GIVEN THE RELATIVELY +! FEW AND THICK SOIL LAYERS, THIS GRADIENT SUFFERES SERIOUS +! TRUNCTION ERRORS YIELDING ERRONEOUSLY HIGH VERTICAL TRANSPORTS OF +! UNFROZEN WATER IN BOTH DIRECTIONS FROM HUGE HYDRAULIC DIFFUSIVITY. +! THEREFORE, WE FOUND WE HAD TO ARBITRARILY CONSTRAIN WDF +! -- +! VERSION D_10CM: ........ FACTR1 = 0.2/SMCMAX +! WEIGHTED APPROACH...................... PABLO GRUNMANN, 28_SEP_1999. +! ---------------------------------------------------------------------- + WDF = DWSAT * FACTR2 ** EXPON + IF (SICEMAX .gt. 0.0) THEN + VKWGT = 1./ (1. + (500.* SICEMAX)**3.) + WDF = VKWGT * WDF + (1. - VKWGT)* DWSAT * FACTR1** EXPON +! ---------------------------------------------------------------------- +! RESET THE EXPNTL COEF AND CALC THE HYDRAULIC CONDUCTIVITY +! ---------------------------------------------------------------------- + END IF + EXPON = (2.0 * BEXP) + 3.0 + WCND = DKSAT * FACTR2 ** EXPON + +! ---------------------------------------------------------------------- + END SUBROUTINE WDFCND +! ---------------------------------------------------------------------- + + SUBROUTINE SFCDIF_off (ZLM,Z0,THZ0,THLM,SFCSPD,CZIL,AKMS,AKHS) + +! ---------------------------------------------------------------------- +! SUBROUTINE SFCDIF (renamed SFCDIF_off to avoid clash with Eta PBL) +! ---------------------------------------------------------------------- +! CALCULATE SURFACE LAYER EXCHANGE COEFFICIENTS VIA ITERATIVE PROCESS. +! SEE CHEN ET AL (1997, BLM) +! ---------------------------------------------------------------------- + + IMPLICIT NONE + REAL WWST, WWST2, G, VKRM, EXCM, BETA, BTG, ELFC, WOLD, WNEW + REAL PIHF, EPSU2, EPSUST, EPSIT, EPSA, ZTMIN, ZTMAX, HPBL, & + & SQVISC + REAL RIC, RRIC, FHNEU, RFC, RFAC, ZZ, PSLMU, PSLMS, PSLHU, & + & PSLHS + REAL XX, PSPMU, YY, PSPMS, PSPHU, PSPHS, ZLM, Z0, THZ0, THLM + REAL SFCSPD, CZIL, AKMS, AKHS, ZILFC, ZU, ZT, RDZ, CXCH + REAL DTHV, DU2, BTGH, WSTAR2, USTAR, ZSLU, ZSLT, RLOGU, RLOGT + REAL RLMO, ZETALT, ZETALU, ZETAU, ZETAT, XLU4, XLT4, XU4, XT4 +!CC ......REAL ZTFC + + REAL XLU, XLT, XU, XT, PSMZ, SIMM, PSHZ, SIMH, USTARK, RLMN, & + & RLMA + + INTEGER ITRMX, ILECH, ITR + PARAMETER & + & (WWST = 1.2,WWST2 = WWST * WWST,G = 9.8,VKRM = 0.40, & + & EXCM = 0.001 & + & ,BETA = 1./270.,BTG = BETA * G,ELFC = VKRM * BTG & + & ,WOLD =.15,WNEW = 1. - WOLD,ITRMX = 05, & + & PIHF = 3.14159265/2.) + PARAMETER & + & (EPSU2 = 1.E-4,EPSUST = 0.07,EPSIT = 1.E-4,EPSA = 1.E-8 & + & ,ZTMIN = -5.,ZTMAX = 1.,HPBL = 1000.0 & + & ,SQVISC = 258.2) + PARAMETER & + & (RIC = 0.183,RRIC = 1.0/ RIC,FHNEU = 0.8,RFC = 0.191 & + & ,RFAC = RIC / (FHNEU * RFC * RFC)) + +! ---------------------------------------------------------------------- +! NOTE: THE TWO CODE BLOCKS BELOW DEFINE FUNCTIONS +! ---------------------------------------------------------------------- +! LECH'S SURFACE FUNCTIONS +! ---------------------------------------------------------------------- + PSLMU (ZZ)= -0.96* log (1.0-4.5* ZZ) + PSLMS (ZZ)= ZZ * RRIC -2.076* (1. -1./ (ZZ +1.)) + PSLHU (ZZ)= -0.96* log (1.0-4.5* ZZ) + +! ---------------------------------------------------------------------- +! PAULSON'S SURFACE FUNCTIONS +! ---------------------------------------------------------------------- + PSLHS (ZZ)= ZZ * RFAC -2.076* (1. -1./ (ZZ +1.)) + PSPMU (XX)= -2.* log ( (XX +1.)*0.5) - log ( (XX * XX +1.)*0.5) & + & +2.* ATAN (XX) & + &- PIHF + PSPMS (YY)= 5.* YY + PSPHU (XX)= -2.* log ( (XX * XX +1.)*0.5) + +! ---------------------------------------------------------------------- +! THIS ROUTINE SFCDIF CAN HANDLE BOTH OVER OPEN WATER (SEA, OCEAN) AND +! OVER SOLID SURFACE (LAND, SEA-ICE). +! ---------------------------------------------------------------------- + PSPHS (YY)= 5.* YY + +! ---------------------------------------------------------------------- +! ZTFC: RATIO OF ZOH/ZOM LESS OR EQUAL THAN 1 +! C......ZTFC=0.1 +! CZIL: CONSTANT C IN Zilitinkevich, S. S.1995,:NOTE ABOUT ZT +! ---------------------------------------------------------------------- + ILECH = 0 + +! ---------------------------------------------------------------------- + ZILFC = - CZIL * VKRM * SQVISC +! C.......ZT=Z0*ZTFC + ZU = Z0 + RDZ = 1./ ZLM + CXCH = EXCM * RDZ + DTHV = THLM - THZ0 + +! ---------------------------------------------------------------------- +! BELJARS CORRECTION OF USTAR +! ---------------------------------------------------------------------- + DU2 = MAX (SFCSPD * SFCSPD,EPSU2) +!cc If statements to avoid TANGENT LINEAR problems near zero + BTGH = BTG * HPBL + IF (BTGH * AKHS * DTHV .ne. 0.0) THEN + WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.) + ELSE + WSTAR2 = 0.0 + END IF + +! ---------------------------------------------------------------------- +! ZILITINKEVITCH APPROACH FOR ZT +! ---------------------------------------------------------------------- + USTAR = MAX (SQRT (AKMS * SQRT (DU2+ WSTAR2)),EPSUST) + +! ---------------------------------------------------------------------- + ZT = EXP (ZILFC * SQRT (USTAR * Z0))* Z0 + ZSLU = ZLM + ZU +! PRINT*,'ZSLT=',ZSLT +! PRINT*,'ZLM=',ZLM +! PRINT*,'ZT=',ZT + + ZSLT = ZLM + ZT + RLOGU = log (ZSLU / ZU) + + RLOGT = log (ZSLT / ZT) +! PRINT*,'RLMO=',RLMO +! PRINT*,'ELFC=',ELFC +! PRINT*,'AKHS=',AKHS +! PRINT*,'DTHV=',DTHV +! PRINT*,'USTAR=',USTAR + + RLMO = ELFC * AKHS * DTHV / USTAR **3 +! ---------------------------------------------------------------------- +! 1./MONIN-OBUKKHOV LENGTH-SCALE +! ---------------------------------------------------------------------- + DO ITR = 1,ITRMX + ZETALT = MAX (ZSLT * RLMO,ZTMIN) + RLMO = ZETALT / ZSLT + ZETALU = ZSLU * RLMO + ZETAU = ZU * RLMO + + ZETAT = ZT * RLMO + IF (ILECH .eq. 0) THEN + IF (RLMO .lt. 0.)THEN + XLU4 = 1. -16.* ZETALU + XLT4 = 1. -16.* ZETALT + XU4 = 1. -16.* ZETAU + + XT4 = 1. -16.* ZETAT + XLU = SQRT (SQRT (XLU4)) + XLT = SQRT (SQRT (XLT4)) + XU = SQRT (SQRT (XU4)) + + XT = SQRT (SQRT (XT4)) +! PRINT*,'-----------1------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSPMU(ZETAU)=',PSPMU(ZETAU) +! PRINT*,'XU=',XU +! PRINT*,'------------------------' + PSMZ = PSPMU (XU) + SIMM = PSPMU (XLU) - PSMZ + RLOGU + PSHZ = PSPHU (XT) + SIMH = PSPHU (XLT) - PSHZ + RLOGT + ELSE + ZETALU = MIN (ZETALU,ZTMAX) + ZETALT = MIN (ZETALT,ZTMAX) +! PRINT*,'-----------2------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSPMS(ZETAU)=',PSPMS(ZETAU) +! PRINT*,'ZETAU=',ZETAU +! PRINT*,'------------------------' + PSMZ = PSPMS (ZETAU) + SIMM = PSPMS (ZETALU) - PSMZ + RLOGU + PSHZ = PSPHS (ZETAT) + SIMH = PSPHS (ZETALT) - PSHZ + RLOGT + END IF +! ---------------------------------------------------------------------- +! LECH'S FUNCTIONS +! ---------------------------------------------------------------------- + ELSE + IF (RLMO .lt. 0.)THEN +! PRINT*,'-----------3------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSLMU(ZETAU)=',PSLMU(ZETAU) +! PRINT*,'ZETAU=',ZETAU +! PRINT*,'------------------------' + PSMZ = PSLMU (ZETAU) + SIMM = PSLMU (ZETALU) - PSMZ + RLOGU + PSHZ = PSLHU (ZETAT) + SIMH = PSLHU (ZETALT) - PSHZ + RLOGT + ELSE + ZETALU = MIN (ZETALU,ZTMAX) + + ZETALT = MIN (ZETALT,ZTMAX) +! PRINT*,'-----------4------------' +! PRINT*,'PSMZ=',PSMZ +! PRINT*,'PSLMS(ZETAU)=',PSLMS(ZETAU) +! PRINT*,'ZETAU=',ZETAU +! PRINT*,'------------------------' + PSMZ = PSLMS (ZETAU) + SIMM = PSLMS (ZETALU) - PSMZ + RLOGU + PSHZ = PSLHS (ZETAT) + SIMH = PSLHS (ZETALT) - PSHZ + RLOGT + END IF +! ---------------------------------------------------------------------- +! BELJAARS CORRECTION FOR USTAR +! ---------------------------------------------------------------------- + END IF + +! ---------------------------------------------------------------------- +! ZILITINKEVITCH FIX FOR ZT +! ---------------------------------------------------------------------- + USTAR = MAX (SQRT (AKMS * SQRT (DU2+ WSTAR2)),EPSUST) + + ZT = EXP (ZILFC * SQRT (USTAR * Z0))* Z0 + ZSLT = ZLM + ZT +!----------------------------------------------------------------------- + RLOGT = log (ZSLT / ZT) + USTARK = USTAR * VKRM + AKMS = MAX (USTARK / SIMM,CXCH) +!----------------------------------------------------------------------- +! IF STATEMENTS TO AVOID TANGENT LINEAR PROBLEMS NEAR ZERO +!----------------------------------------------------------------------- + AKHS = MAX (USTARK / SIMH,CXCH) + IF (BTGH * AKHS * DTHV .ne. 0.0) THEN + WSTAR2 = WWST2* ABS (BTGH * AKHS * DTHV)** (2./3.) + ELSE + WSTAR2 = 0.0 + END IF +!----------------------------------------------------------------------- + RLMN = ELFC * AKHS * DTHV / USTAR **3 +!----------------------------------------------------------------------- +! IF(ABS((RLMN-RLMO)/RLMA).LT.EPSIT) GO TO 110 +!----------------------------------------------------------------------- + RLMA = RLMO * WOLD+ RLMN * WNEW +!----------------------------------------------------------------------- + RLMO = RLMA +! PRINT*,'----------------------------' +! PRINT*,'SFCDIF OUTPUT ! ! ! ! ! ! ! ! ! ! ! !' + +! PRINT*,'ZLM=',ZLM +! PRINT*,'Z0=',Z0 +! PRINT*,'THZ0=',THZ0 +! PRINT*,'THLM=',THLM +! PRINT*,'SFCSPD=',SFCSPD +! PRINT*,'CZIL=',CZIL +! PRINT*,'AKMS=',AKMS +! PRINT*,'AKHS=',AKHS +! PRINT*,'----------------------------' + + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE SFCDIF_off +! ---------------------------------------------------------------------- + +END MODULE module_sf_noahlsm diff --git a/physics/module_sf_noahlsm_glacial_only.F90 b/physics/module_sf_noahlsm_glacial_only.F90 new file mode 100644 index 000000000..602b21e3b --- /dev/null +++ b/physics/module_sf_noahlsm_glacial_only.F90 @@ -0,0 +1,1285 @@ +MODULE module_sf_noahlsm_glacial_only + + USE module_sf_noahlsm, ONLY : EMISSI_S, ROSR12 + USE module_sf_noahlsm, ONLY : LVCOEF_DATA + + PRIVATE :: ALCALC + PRIVATE :: CSNOW + PRIVATE :: HRTICE + PRIVATE :: HSTEP + PRIVATE :: PENMAN + PRIVATE :: SHFLX + PRIVATE :: SNOPAC + PRIVATE :: SNOWPACK + PRIVATE :: SNOWZ0 + PRIVATE :: SNOW_NEW + + integer, private :: iloc, jloc +!$omp threadprivate(iloc, jloc) + +CONTAINS + + SUBROUTINE SFLX_GLACIAL (IILOC,JJLOC,ISICE,FFROZP,DT,ZLVL,NSOIL,SLDPTH, & !C + & LWDN,SOLNET,SFCPRS,PRCP,SFCTMP,Q2, & !F + & TH2,Q2SAT,DQSDT2, & !I + & ALB, SNOALB,TBOT, Z0BRD, Z0, EMISSI, EMBRD, & !S + & T1,STC,SNOWH,SNEQV,ALBEDO,CH, & !H + & CP, RD, SIGMA, CPH2O, CPICE, LSUBF, & +! ---------------------------------------------------------------------- +! OUTPUTS, DIAGNOSTICS, PARAMETERS BELOW GENERALLY NOT NECESSARY WHEN +! COUPLED WITH E.G. A NWP MODEL (SUCH AS THE NOAA/NWS/NCEP MESOSCALE ETA +! MODEL). OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES. +! ---------------------------------------------------------------------- + & ETA,SHEAT, ETA_KINEMATIC,FDOWN, & !O + & ESNOW,DEW, & !O + & ETP,SSOIL, & !O + & FLX1,FLX2,FLX3, & !O + & SNOMLT,SNCOVR, & !O + & RUNOFF1, & !O + & Q1, & !D + & SNOTIME1, & + & RIBB,errflg, errmsg) +! ---------------------------------------------------------------------- +! SUB-DRIVER FOR "Noah LSM" FAMILY OF PHYSICS SUBROUTINES FOR A +! SOIL/VEG/SNOWPACK LAND-SURFACE MODEL TO UPDATE ICE TEMPERATURE, SKIN +! TEMPERATURE, SNOWPACK WATER CONTENT, SNOWDEPTH, AND ALL TERMS OF THE +! SURFACE ENERGY BALANCE (EXCLUDING INPUT ATMOSPHERIC FORCINGS OF +! DOWNWARD RADIATION AND PRECIP) +! ---------------------------------------------------------------------- +! SFLX ARGUMENT LIST KEY: +! ---------------------------------------------------------------------- +! C CONFIGURATION INFORMATION +! F FORCING DATA +! I OTHER (INPUT) FORCING DATA +! S SURFACE CHARACTERISTICS +! H HISTORY (STATE) VARIABLES +! O OUTPUT VARIABLES +! D DIAGNOSTIC OUTPUT +! ---------------------------------------------------------------------- +! 1. CONFIGURATION INFORMATION (C): +! ---------------------------------------------------------------------- +! DT TIMESTEP (SEC) (DT SHOULD NOT EXCEED 3600 SECS, RECOMMEND +! 1800 SECS OR LESS) +! ZLVL HEIGHT (M) ABOVE GROUND OF ATMOSPHERIC FORCING VARIABLES +! NSOIL NUMBER OF SOIL LAYERS (AT LEAST 2, AND NOT GREATER THAN +! PARAMETER NSOLD SET BELOW) +! SLDPTH THE THICKNESS OF EACH SOIL LAYER (M) +! ---------------------------------------------------------------------- +! 3. FORCING DATA (F): +! ---------------------------------------------------------------------- +! LWDN LW DOWNWARD RADIATION (W M-2; POSITIVE, NOT NET LONGWAVE) +! SOLNET NET DOWNWARD SOLAR RADIATION ((W M-2; POSITIVE) +! SFCPRS PRESSURE AT HEIGHT ZLVL ABOVE GROUND (PASCALS) +! PRCP PRECIP RATE (KG M-2 S-1) (NOTE, THIS IS A RATE) +! SFCTMP AIR TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND +! TH2 AIR POTENTIAL TEMPERATURE (K) AT HEIGHT ZLVL ABOVE GROUND +! Q2 MIXING RATIO AT HEIGHT ZLVL ABOVE GROUND (KG KG-1) +! FFROZP FRACTION OF FROZEN PRECIPITATION +! ---------------------------------------------------------------------- +! 4. OTHER FORCING (INPUT) DATA (I): +! ---------------------------------------------------------------------- +! Q2SAT SAT SPECIFIC HUMIDITY AT HEIGHT ZLVL ABOVE GROUND (KG KG-1) +! DQSDT2 SLOPE OF SAT SPECIFIC HUMIDITY CURVE AT T=SFCTMP +! (KG KG-1 K-1) +! ---------------------------------------------------------------------- +! 5. CANOPY/SOIL CHARACTERISTICS (S): +! ---------------------------------------------------------------------- +! ALB BACKROUND SNOW-FREE SURFACE ALBEDO (FRACTION), FOR JULIAN +! DAY OF YEAR (USUALLY FROM TEMPORAL INTERPOLATION OF +! MONTHLY MEAN VALUES' CALLING PROG MAY OR MAY NOT +! INCLUDE DIURNAL SUN ANGLE EFFECT) +! SNOALB UPPER BOUND ON MAXIMUM ALBEDO OVER DEEP SNOW (E.G. FROM +! ROBINSON AND KUKLA, 1985, J. CLIM. & APPL. METEOR.) +! TBOT BOTTOM SOIL TEMPERATURE (LOCAL YEARLY-MEAN SFC AIR +! TEMPERATURE) +! Z0BRD Background fixed roughness length (M) +! Z0 Time varying roughness length (M) as function of snow depth +! EMBRD Background surface emissivity (between 0 and 1) +! EMISSI Surface emissivity (between 0 and 1) +! ---------------------------------------------------------------------- +! 6. HISTORY (STATE) VARIABLES (H): +! ---------------------------------------------------------------------- +! T1 GROUND/CANOPY/SNOWPACK) EFFECTIVE SKIN TEMPERATURE (K) +! STC(NSOIL) SOIL TEMP (K) +! SNOWH ACTUAL SNOW DEPTH (M) +! SNEQV LIQUID WATER-EQUIVALENT SNOW DEPTH (M) +! NOTE: SNOW DENSITY = SNEQV/SNOWH +! ALBEDO SURFACE ALBEDO INCLUDING SNOW EFFECT (UNITLESS FRACTION) +! =SNOW-FREE ALBEDO (ALB) WHEN SNEQV=0, OR +! =FCT(MSNOALB,ALB,SHDFAC,SHDMIN) WHEN SNEQV>0 +! CH SURFACE EXCHANGE COEFFICIENT FOR HEAT AND MOISTURE +! (M S-1); NOTE: CH IS TECHNICALLY A CONDUCTANCE SINCE +! IT HAS BEEN MULTIPLIED BY WIND SPEED. +! ---------------------------------------------------------------------- +! 7. OUTPUT (O): +! ---------------------------------------------------------------------- +! OUTPUT VARIABLES NECESSARY FOR A COUPLED NUMERICAL WEATHER PREDICTION +! MODEL, E.G. NOAA/NWS/NCEP MESOSCALE ETA MODEL. FOR THIS APPLICATION, +! THE REMAINING OUTPUT/DIAGNOSTIC/PARAMETER BLOCKS BELOW ARE NOT +! NECESSARY. OTHER APPLICATIONS MAY REQUIRE DIFFERENT OUTPUT VARIABLES. +! ETA ACTUAL LATENT HEAT FLUX (W m-2: NEGATIVE, IF UP FROM +! SURFACE) +! ETA_KINEMATIC atctual latent heat flux in Kg m-2 s-1 +! SHEAT SENSIBLE HEAT FLUX (W M-2: NEGATIVE, IF UPWARD FROM +! SURFACE) +! FDOWN Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN +! ---------------------------------------------------------------------- +! ESNOW SUBLIMATION FROM (OR DEPOSITION TO IF <0) SNOWPACK +! (W m-2) +! DEW DEWFALL (OR FROSTFALL FOR T<273.15) (M) +! ---------------------------------------------------------------------- +! ETP POTENTIAL EVAPORATION (W m-2) +! SSOIL SOIL HEAT FLUX (W M-2: NEGATIVE IF DOWNWARD FROM SURFACE) +! ---------------------------------------------------------------------- +! FLX1 PRECIP-SNOW SFC (W M-2) +! FLX2 FREEZING RAIN LATENT HEAT FLUX (W M-2) +! FLX3 PHASE-CHANGE HEAT FLUX FROM SNOWMELT (W M-2) +! ---------------------------------------------------------------------- +! SNOMLT SNOW MELT (M) (WATER EQUIVALENT) +! SNCOVR FRACTIONAL SNOW COVER (UNITLESS FRACTION, 0-1) +! ---------------------------------------------------------------------- +! RUNOFF1 SURFACE RUNOFF (M S-1), NOT INFILTRATING THE SURFACE +! ---------------------------------------------------------------------- +! 8. DIAGNOSTIC OUTPUT (D): +! ---------------------------------------------------------------------- +! Q1 Effective mixing ratio at surface (kg kg-1), used for +! diagnosing the mixing ratio at 2 meter for coupled model +! Documentation for SNOTIME1 and SNOABL2 ????? +! What categories of arguments do these variables fall into ???? +! Documentation for RIBB ????? +! What category of argument does RIBB fall into ????? +! ---------------------------------------------------------------------- + + IMPLICIT NONE +! ---------------------------------------------------------------------- + integer, intent(in) :: iiloc, jjloc + INTEGER, INTENT(IN) :: ISICE +! ---------------------------------------------------------------------- + LOGICAL :: FRZGRA, SNOWNG + +! ---------------------------------------------------------------------- +! 1. CONFIGURATION INFORMATION (C): +! ---------------------------------------------------------------------- + INTEGER, INTENT(IN) :: NSOIL + INTEGER :: KZ + +! ---------------------------------------------------------------------- +! 2. LOGICAL: +! ---------------------------------------------------------------------- + + REAL, INTENT(IN) :: DT,DQSDT2,LWDN,PRCP, & + & Q2,Q2SAT,SFCPRS,SFCTMP, SNOALB, & + & SOLNET,TBOT,TH2,ZLVL,FFROZP + REAL, INTENT(IN) :: CP, RD, SIGMA, CPH2O, CPICE, LSUBF + REAL, INTENT(OUT) :: EMBRD, ALBEDO + REAL, INTENT(INOUT):: CH,SNEQV,SNCOVR,SNOWH,T1,Z0BRD,EMISSI,ALB + REAL, INTENT(INOUT):: SNOTIME1 + REAL, INTENT(INOUT):: RIBB + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SLDPTH + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC + REAL, DIMENSION(1:NSOIL) :: ZSOIL + + REAL,INTENT(OUT) :: ETA_KINEMATIC,DEW,ESNOW,ETA, & + & ETP,FLX1,FLX2,FLX3,SHEAT,RUNOFF1, & + & SSOIL,SNOMLT,FDOWN,Q1 + REAL :: DF1,DSOIL,DTOT,FRCSNO,FRCSOI, & + & PRCP1,RCH,RR,RSNOW,SNDENS,SNCOND,SN_NEW, & + & T1V,T24,T2V,TH2V,TSNOW,Z0,PRCPF,RHO + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! ---------------------------------------------------------------------- +! DECLARATIONS - PARAMETERS +! ---------------------------------------------------------------------- + REAL, PARAMETER :: TFREEZ = 273.15 + REAL, PARAMETER :: LVH2O = 2.501E+6 + REAL, PARAMETER :: LSUBS = 2.83E+6 + REAL, PARAMETER :: R = 287.04 + + errmsg = '' + errflg = 0 + +! ---------------------------------------------------------------------- + iloc = iiloc + jloc = jjloc +! ---------------------------------------------------------------------- + ZSOIL (1) = - SLDPTH (1) + DO KZ = 2,NSOIL + ZSOIL (KZ) = - SLDPTH (KZ) + ZSOIL (KZ -1) + END DO + +! ---------------------------------------------------------------------- +! IF S.W.E. (SNEQV) BELOW THRESHOLD LOWER BOUND (0.10 M FOR GLACIAL +! ICE), THEN SET AT LOWER BOUND +! ---------------------------------------------------------------------- + IF ( SNEQV < 0.10 ) THEN + SNEQV = 0.10 + SNOWH = 0.50 + ENDIF +! ---------------------------------------------------------------------- +! IF INPUT SNOWPACK IS NONZERO, THEN COMPUTE SNOW DENSITY "SNDENS" AND +! SNOW THERMAL CONDUCTIVITY "SNCOND" +! ---------------------------------------------------------------------- + SNDENS = SNEQV / SNOWH + IF(SNDENS > 1.0) THEN + errmsg = 'Physical snow depth is less than snow water equiv.' + errflg = 1 + return + ENDIF + + CALL CSNOW (SNCOND,SNDENS) +! ---------------------------------------------------------------------- +! DETERMINE IF IT'S PRECIPITATING AND WHAT KIND OF PRECIP IT IS. +! IF IT'S PRCPING AND THE AIR TEMP IS COLDER THAN 0 C, IT'S SNOWING! +! IF IT'S PRCPING AND THE AIR TEMP IS WARMER THAN 0 C, BUT THE GRND +! TEMP IS COLDER THAN 0 C, FREEZING RAIN IS PRESUMED TO BE FALLING. +! ---------------------------------------------------------------------- + + SNOWNG = .FALSE. + FRZGRA = .FALSE. + IF (PRCP > 0.0) THEN +! ---------------------------------------------------------------------- +! Snow defined when fraction of frozen precip (FFROZP) > 0.5, +! passed in from model microphysics. +! ---------------------------------------------------------------------- + IF (FFROZP .GT. 0.5) THEN + SNOWNG = .TRUE. + ELSE + IF (T1 <= TFREEZ) FRZGRA = .TRUE. + END IF + END IF +! ---------------------------------------------------------------------- +! IF EITHER PRCP FLAG IS SET, DETERMINE NEW SNOWFALL (CONVERTING PRCP +! RATE FROM KG M-2 S-1 TO A LIQUID EQUIV SNOW DEPTH IN METERS) AND ADD +! IT TO THE EXISTING SNOWPACK. +! NOTE THAT SINCE ALL PRECIP IS ADDED TO SNOWPACK, NO PRECIP INFILTRATES +! INTO THE SOIL SO THAT PRCP1 IS SET TO ZERO. +! ---------------------------------------------------------------------- + IF ( (SNOWNG) .OR. (FRZGRA) ) THEN + SN_NEW = PRCP * DT * 0.001 + SNEQV = SNEQV + SN_NEW + PRCPF = 0.0 + +! ---------------------------------------------------------------------- +! UPDATE SNOW DENSITY BASED ON NEW SNOWFALL, USING OLD AND NEW SNOW. +! UPDATE SNOW THERMAL CONDUCTIVITY +! ---------------------------------------------------------------------- + CALL SNOW_NEW (SFCTMP,SN_NEW,SNOWH,SNDENS) + +! ---------------------------------------------------------------------- +! kmh 09/04/2006 set Snow Density at 0.2 g/cm**3 +! for "cold permanent ice" or new "dry" snow +! if soil temperature less than 268.15 K, treat as typical +! Antarctic/Greenland snow firn +! ---------------------------------------------------------------------- + IF ( SNCOVR .GT. 0.99 ) THEN + IF ( STC(1) .LT. (TFREEZ - 5.) ) SNDENS = 0.2 + IF ( SNOWNG .AND. (T1.LT.273.) .AND. (SFCTMP.LT.273.) ) SNDENS=0.2 + ENDIF + + CALL CSNOW (SNCOND,SNDENS) + +! ---------------------------------------------------------------------- +! PRECIP IS LIQUID (RAIN), HENCE SAVE IN THE PRECIP VARIABLE THAT +! LATER CAN WHOLELY OR PARTIALLY INFILTRATE THE SOIL +! ---------------------------------------------------------------------- + ELSE + PRCPF = PRCP + ENDIF + +! ---------------------------------------------------------------------- +! DETERMINE SNOW FRACTIONAL COVERAGE. +! KWM: Set SNCOVR to 1.0 because SNUP is set small in VEGPARM.TBL, +! and SNEQV is at least 0.1 (as set above) +! ---------------------------------------------------------------------- + SNCOVR = 1.0 + +! ---------------------------------------------------------------------- +! DETERMINE SURFACE ALBEDO MODIFICATION DUE TO SNOWDEPTH STATE. +! ---------------------------------------------------------------------- + + CALL ALCALC (ALB,SNOALB,EMBRD,T1,ALBEDO,EMISSI, & + & DT,SNOWNG,SNOTIME1) + +! ---------------------------------------------------------------------- +! THERMAL CONDUCTIVITY +! ---------------------------------------------------------------------- + DF1 = SNCOND + + DSOIL = - (0.5 * ZSOIL (1)) + DTOT = SNOWH + DSOIL + FRCSNO = SNOWH / DTOT + +! 1. HARMONIC MEAN (SERIES FLOW) +! DF1 = (SNCOND*DF1)/(FRCSOI*SNCOND+FRCSNO*DF1) + FRCSOI = DSOIL / DTOT + +! 3. GEOMETRIC MEAN (INTERMEDIATE BETWEEN HARMONIC AND ARITHMETIC MEAN) +! DF1 = (SNCOND**FRCSNO)*(DF1**FRCSOI) + DF1 = FRCSNO * SNCOND + FRCSOI * DF1 + +! ---------------------------------------------------------------------- +! CALCULATE SUBSURFACE HEAT FLUX, SSOIL, FROM FINAL THERMAL DIFFUSIVITY +! OF SURFACE MEDIUMS, DF1 ABOVE, AND SKIN TEMPERATURE AND TOP +! MID-LAYER SOIL TEMPERATURE +! ---------------------------------------------------------------------- + IF ( DTOT .GT. 2.*DSOIL ) then + DTOT = 2.*DSOIL + ENDIF + SSOIL = DF1 * ( T1 - STC(1) ) / DTOT + +! ---------------------------------------------------------------------- +! DETERMINE SURFACE ROUGHNESS OVER SNOWPACK USING SNOW CONDITION FROM +! THE PREVIOUS TIMESTEP. +! ---------------------------------------------------------------------- + + CALL SNOWZ0 (Z0,Z0BRD,SNOWH) + +! ---------------------------------------------------------------------- +! CALCULATE TOTAL DOWNWARD RADIATION (SOLAR PLUS LONGWAVE) NEEDED IN +! PENMAN EP SUBROUTINE THAT FOLLOWS +! ---------------------------------------------------------------------- + + FDOWN = SOLNET + LWDN + +! ---------------------------------------------------------------------- +! CALC VIRTUAL TEMPS AND VIRTUAL POTENTIAL TEMPS NEEDED BY SUBROUTINES +! PENMAN. +! ---------------------------------------------------------------------- + + T2V = SFCTMP * (1.0+ 0.61 * Q2 ) + RHO = SFCPRS / (RD * T2V) + RCH = RHO * 1004.6 * CH + T24 = SFCTMP * SFCTMP * SFCTMP * SFCTMP + +! ---------------------------------------------------------------------- +! CALL PENMAN SUBROUTINE TO CALCULATE POTENTIAL EVAPORATION (ETP), AND +! OTHER PARTIAL PRODUCTS AND SUMS SAVE IN COMMON/RITE FOR LATER +! CALCULATIONS. +! ---------------------------------------------------------------------- + + ! PENMAN returns ETP, FLX2, and RR + CALL PENMAN (SFCTMP,SFCPRS,CH,TH2,PRCP,FDOWN,T24,SSOIL, & + & Q2,Q2SAT,ETP,RCH,RR,SNOWNG,FRZGRA, & + & DQSDT2,FLX2,EMISSI,T1,SIGMA,CPH2O,CPICE,LSUBF) + + CALL SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,NSOIL,DT,DF1, & + & Q2,T1,SFCTMP,T24,TH2,FDOWN,SSOIL,STC, & + & SFCPRS,RCH,RR,SNEQV,SNDENS,SNOWH,ZSOIL,TBOT, & + & SNOMLT,DEW,FLX1,FLX2,FLX3,ESNOW,EMISSI,RIBB, & + & SIGMA,CPH2O,CPICE,LSUBF) + +! ETA_KINEMATIC = ESNOW + ETA_KINEMATIC = ETP + +! ---------------------------------------------------------------------- +! Effective mixing ratio at grnd level (skin) +! ---------------------------------------------------------------------- + Q1=Q2+ETA_KINEMATIC*CP/RCH + +! ---------------------------------------------------------------------- +! DETERMINE SENSIBLE HEAT (H) IN ENERGY UNITS (W M-2) +! ---------------------------------------------------------------------- + SHEAT = - (CH * CP * SFCPRS)/ (R * T2V) * ( TH2- T1 ) + +! ---------------------------------------------------------------------- +! CONVERT EVAP TERMS FROM KINEMATIC (KG M-2 S-1) TO ENERGY UNITS (W M-2) +! ---------------------------------------------------------------------- + ESNOW = ESNOW * LSUBS + ETP = ETP * LSUBS + IF (ETP .GT. 0.) THEN + ETA = ESNOW + ELSE + ETA = ETP + ENDIF + +! ---------------------------------------------------------------------- +! CONVERT THE SIGN OF SOIL HEAT FLUX SO THAT: +! SSOIL>0: WARM THE SURFACE (NIGHT TIME) +! SSOIL<0: COOL THE SURFACE (DAY TIME) +! ---------------------------------------------------------------------- + SSOIL = -1.0* SSOIL + +! ---------------------------------------------------------------------- +! FOR THE CASE OF GLACIAL-ICE, ADD ANY SNOWMELT DIRECTLY TO SURFACE +! RUNOFF (RUNOFF1) SINCE THERE IS NO SOIL MEDIUM +! ---------------------------------------------------------------------- + RUNOFF1 = SNOMLT / DT + +! ---------------------------------------------------------------------- + END SUBROUTINE SFLX_GLACIAL +! ---------------------------------------------------------------------- + + SUBROUTINE ALCALC (ALB,SNOALB,EMBRD,TSNOW,ALBEDO,EMISSI, & + & DT,SNOWNG,SNOTIME1) + +! ---------------------------------------------------------------------- +! CALCULATE ALBEDO INCLUDING SNOW EFFECT (0 -> 1) +! ALB SNOWFREE ALBEDO +! SNOALB MAXIMUM (DEEP) SNOW ALBEDO +! ALBEDO SURFACE ALBEDO INCLUDING SNOW EFFECT +! TSNOW SNOW SURFACE TEMPERATURE (K) +! ---------------------------------------------------------------------- + IMPLICIT NONE + +! ---------------------------------------------------------------------- +! SNOALB IS ARGUMENT REPRESENTING MAXIMUM ALBEDO OVER DEEP SNOW, +! AS PASSED INTO SFLX, AND ADAPTED FROM THE SATELLITE-BASED MAXIMUM +! SNOW ALBEDO FIELDS PROVIDED BY D. ROBINSON AND G. KUKLA +! (1985, JCAM, VOL 24, 402-411) +! ---------------------------------------------------------------------- + REAL, INTENT(IN) :: ALB, SNOALB, EMBRD, TSNOW + REAL, INTENT(IN) :: DT + LOGICAL, INTENT(IN) :: SNOWNG + REAL, INTENT(INOUT) :: SNOTIME1 + REAL, INTENT(OUT) :: ALBEDO, EMISSI + REAL :: SNOALB2 + REAL :: TM,SNOALB1 + REAL, PARAMETER :: SNACCA=0.94,SNACCB=0.58,SNTHWA=0.82,SNTHWB=0.46 +! turn off vegetation effect +! ALBEDO = ALB + (1.0- (SHDFAC - SHDMIN))* SNCOVR * (SNOALB - ALB) +! ALBEDO = (1.0-SNCOVR)*ALB + SNCOVR*SNOALB !this is equivalent to below + ALBEDO = ALB + (SNOALB-ALB) + EMISSI = EMBRD + (EMISSI_S - EMBRD) + +! BASE FORMULATION (DICKINSON ET AL., 1986, COGLEY ET AL., 1990) +! IF (TSNOW.LE.263.16) THEN +! ALBEDO=SNOALB +! ELSE +! IF (TSNOW.LT.273.16) THEN +! TM=0.1*(TSNOW-263.16) +! SNOALB1=0.5*((0.9-0.2*(TM**3))+(0.8-0.16*(TM**3))) +! ELSE +! SNOALB1=0.67 +! IF(SNCOVR.GT.0.95) SNOALB1= 0.6 +! SNOALB1 = ALB + SNCOVR*(SNOALB-ALB) +! ENDIF +! ENDIF +! ALBEDO = ALB + SNCOVR*(SNOALB1-ALB) + +! ISBA FORMULATION (VERSEGHY, 1991; BAKER ET AL., 1990) +! SNOALB1 = SNOALB+COEF*(0.85-SNOALB) +! SNOALB2=SNOALB1 +!!m LSTSNW=LSTSNW+1 +! SNOTIME1 = SNOTIME1 + DT +! IF (SNOWNG) THEN +! SNOALB2=SNOALB +!!m LSTSNW=0 +! SNOTIME1 = 0.0 +! ELSE +! IF (TSNOW.LT.273.16) THEN +!! SNOALB2=SNOALB-0.008*LSTSNW*DT/86400 +!!m SNOALB2=SNOALB-0.008*SNOTIME1/86400 +! SNOALB2=(SNOALB2-0.65)*EXP(-0.05*DT/3600)+0.65 +!! SNOALB2=(ALBEDO-0.65)*EXP(-0.01*DT/3600)+0.65 +! ELSE +! SNOALB2=(SNOALB2-0.5)*EXP(-0.0005*DT/3600)+0.5 +!! SNOALB2=(SNOALB-0.5)*EXP(-0.24*LSTSNW*DT/86400)+0.5 +!!m SNOALB2=(SNOALB-0.5)*EXP(-0.24*SNOTIME1/86400)+0.5 +! ENDIF +! ENDIF +! +!! print*,'SNOALB2',SNOALB2,'ALBEDO',ALBEDO,'DT',DT +! ALBEDO = ALB + SNCOVR*(SNOALB2-ALB) +! IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2 +!!m LSTSNW1=LSTSNW +!! SNOTIME = SNOTIME1 + +! formulation by Livneh +! ---------------------------------------------------------------------- +! SNOALB IS CONSIDERED AS THE MAXIMUM SNOW ALBEDO FOR NEW SNOW, AT +! A VALUE OF 85%. SNOW ALBEDO CURVE DEFAULTS ARE FROM BRAS P.263. SHOULD +! NOT BE CHANGED EXCEPT FOR SERIOUS PROBLEMS WITH SNOW MELT. +! TO IMPLEMENT ACCUMULATIN PARAMETERS, SNACCA AND SNACCB, ASSERT THAT IT +! IS INDEED ACCUMULATION SEASON. I.E. THAT SNOW SURFACE TEMP IS BELOW +! ZERO AND THE DATE FALLS BETWEEN OCTOBER AND FEBRUARY +! ---------------------------------------------------------------------- + SNOALB1 = SNOALB+LVCOEF_DATA*(0.85-SNOALB) + SNOALB2=SNOALB1 +! ---------------- Initial LSTSNW -------------------------------------- + IF (SNOWNG) THEN + SNOTIME1 = 0. + ELSE + SNOTIME1=SNOTIME1+DT +! IF (TSNOW.LT.273.16) THEN + SNOALB2=SNOALB1*(SNACCA**((SNOTIME1/86400.0)**SNACCB)) +! ELSE +! SNOALB2 =SNOALB1*(SNTHWA**((SNOTIME1/86400.0)**SNTHWB)) +! ENDIF + ENDIF + + SNOALB2 = MAX ( SNOALB2, ALB ) + ALBEDO = ALB + (SNOALB2-ALB) + IF (ALBEDO .GT. SNOALB2) ALBEDO=SNOALB2 + +! IF (TSNOW.LT.273.16) THEN +! ALBEDO=SNOALB-0.008*DT/86400 +! ELSE +! ALBEDO=(SNOALB-0.5)*EXP(-0.24*DT/86400)+0.5 +! ENDIF + +! IF (ALBEDO > SNOALB) ALBEDO = SNOALB + +! ---------------------------------------------------------------------- + END SUBROUTINE ALCALC +! ---------------------------------------------------------------------- + + SUBROUTINE CSNOW (SNCOND,DSNOW) + +! ---------------------------------------------------------------------- +! CALCULATE SNOW TERMAL CONDUCTIVITY +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: DSNOW + REAL, INTENT(OUT) :: SNCOND + REAL :: C + REAL, PARAMETER :: UNIT = 0.11631 + +! ---------------------------------------------------------------------- +! SNCOND IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C) +! CSNOW IN UNITS OF CAL/(CM*HR*C), RETURNED IN W/(M*C) +! BASIC VERSION IS DYACHKOVA EQUATION (1960), FOR RANGE 0.1-0.4 +! ---------------------------------------------------------------------- + C = 0.328*10** (2.25* DSNOW) +! CSNOW=UNIT*C + +! ---------------------------------------------------------------------- +! DE VAUX EQUATION (1933), IN RANGE 0.1-0.6 +! ---------------------------------------------------------------------- +! SNCOND=0.0293*(1.+100.*DSNOW**2) +! CSNOW=0.0293*(1.+100.*DSNOW**2) + +! ---------------------------------------------------------------------- +! E. ANDERSEN FROM FLERCHINGER +! ---------------------------------------------------------------------- +! SNCOND=0.021+2.51*DSNOW**2 +! CSNOW=0.021+2.51*DSNOW**2 + +! SNCOND = UNIT * C +! double snow thermal conductivity + SNCOND = 2.0 * UNIT * C + +! ---------------------------------------------------------------------- + END SUBROUTINE CSNOW +! ---------------------------------------------------------------------- + + SUBROUTINE HRTICE (RHSTS,STC,TBOT,NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI) + +! ---------------------------------------------------------------------- +! CALCULATE THE RIGHT HAND SIDE OF THE TIME TENDENCY TERM OF THE SOIL +! THERMAL DIFFUSION EQUATION IN THE CASE OF SEA-ICE (ICE=1) OR GLACIAL +! ICE (ICE=-1). COMPUTE (PREPARE) THE MATRIX COEFFICIENTS FOR THE +! TRI-DIAGONAL MATRIX OF THE IMPLICIT TIME SCHEME. +! +! (NOTE: THIS SUBROUTINE ONLY CALLED FOR SEA-ICE OR GLACIAL ICE, BUT +! NOT FOR NON-GLACIAL LAND (ICE = 0). +! ---------------------------------------------------------------------- + IMPLICIT NONE + + + INTEGER, INTENT(IN) :: NSOIL + REAL, INTENT(IN) :: DF1,YY,ZZ1 + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI,CI + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: STC, ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTS + REAL, INTENT(IN) :: TBOT + INTEGER :: K + REAL :: DDZ,DDZ2,DENOM,DTSDZ,DTSDZ2,SSOIL,HCPCT + REAL :: DF1K,DF1N + REAL :: ZMD + REAL, PARAMETER :: ZBOT = -25.0 + +! ---------------------------------------------------------------------- +! SET A NOMINAL UNIVERSAL VALUE OF GLACIAL-ICE SPECIFIC HEAT CAPACITY, +! HCPCT = 2100.0*900.0 = 1.89000E+6 (SOURCE: BOB GRUMBINE, 2005) +! TBOT PASSED IN AS ARGUMENT, VALUE FROM GLOBAL DATA SET + ! + ! A least-squares fit for the four points provided by + ! Keith Hines for the Yen (1981) values for Antarctic + ! snow firn. + ! + HCPCT = 1.E6 * (0.8194 - 0.1309*0.5*ZSOIL(1)) + DF1K = DF1 + +! ---------------------------------------------------------------------- +! THE INPUT ARGUMENT DF1 IS A UNIVERSALLY CONSTANT VALUE OF SEA-ICE +! THERMAL DIFFUSIVITY, SET IN ROUTINE SNOPAC AS DF1 = 2.2. +! ---------------------------------------------------------------------- +! SET ICE PACK DEPTH. USE TBOT AS ICE PACK LOWER BOUNDARY TEMPERATURE +! (THAT OF UNFROZEN SEA WATER AT BOTTOM OF SEA ICE PACK). ASSUME ICE +! PACK IS OF N=NSOIL LAYERS SPANNING A UNIFORM CONSTANT ICE PACK +! THICKNESS AS DEFINED BY ZSOIL(NSOIL) IN ROUTINE SFLX. +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEFFICIENTS AI, BI, AND CI FOR THE TOP LAYER +! ---------------------------------------------------------------------- + DDZ = 1.0 / ( -0.5 * ZSOIL (2) ) + AI (1) = 0.0 + CI (1) = (DF1 * DDZ) / (ZSOIL (1) * HCPCT) + +! ---------------------------------------------------------------------- +! CALC THE VERTICAL SOIL TEMP GRADIENT BTWN THE TOP AND 2ND SOIL LAYERS. +! RECALC/ADJUST THE SOIL HEAT FLUX. USE THE GRADIENT AND FLUX TO CALC +! RHSTS FOR THE TOP SOIL LAYER. +! ---------------------------------------------------------------------- + BI (1) = - CI (1) + DF1/ (0.5 * ZSOIL (1) * ZSOIL (1) * HCPCT * & + & ZZ1) + DTSDZ = ( STC (1) - STC (2) ) / ( -0.5 * ZSOIL (2) ) + SSOIL = DF1 * ( STC (1) - YY ) / ( 0.5 * ZSOIL (1) * ZZ1 ) + +! ---------------------------------------------------------------------- +! INITIALIZE DDZ2 +! ---------------------------------------------------------------------- + RHSTS (1) = ( DF1 * DTSDZ - SSOIL ) / ( ZSOIL (1) * HCPCT ) + +! ---------------------------------------------------------------------- +! LOOP THRU THE REMAINING SOIL LAYERS, REPEATING THE ABOVE PROCESS +! ---------------------------------------------------------------------- + DDZ2 = 0.0 + DF1K = DF1 + DF1N = DF1 + DO K = 2,NSOIL + + ZMD = 0.5 * (ZSOIL(K)+ZSOIL(K-1)) + ! For the land-ice case +! kmh 09/03/2006 use Yen (1981)'s values for Antarctic snow firn +! IF ( K .eq. 2 ) HCPCT = 0.855108E6 +! IF ( K .eq. 3 ) HCPCT = 0.922906E6 +! IF ( K .eq. 4 ) HCPCT = 1.009986E6 + + ! Least squares fit to the four points supplied by Keith Hines + ! from Yen (1981) for Antarctic snow firn. Not optimal, but + ! probably better than just a constant. + HCPCT = 1.E6 * ( 0.8194 - 0.1309*ZMD ) + +! IF ( K .eq. 2 ) DF1N = 0.345356 +! IF ( K .eq. 3 ) DF1N = 0.398777 +! IF ( K .eq. 4 ) DF1N = 0.472653 + + ! Least squares fit to the three points supplied by Keith Hines + ! from Yen (1981) for Antarctic snow firn. Not optimal, but + ! probably better than just a constant. + DF1N = 0.32333 - ( 0.10073 * ZMD ) +! ---------------------------------------------------------------------- +! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THIS LAYER. +! ---------------------------------------------------------------------- + IF (K /= NSOIL) THEN + DENOM = 0.5 * ( ZSOIL (K -1) - ZSOIL (K +1) ) + +! ---------------------------------------------------------------------- +! CALC THE MATRIX COEF, CI, AFTER CALC'NG ITS PARTIAL PRODUCT. +! ---------------------------------------------------------------------- + DTSDZ2 = ( STC (K) - STC (K +1) ) / DENOM + DDZ2 = 2. / (ZSOIL (K -1) - ZSOIL (K +1)) + CI (K) = - DF1N * DDZ2 / ( (ZSOIL (K -1) - ZSOIL (K))*HCPCT) + +! ---------------------------------------------------------------------- +! CALC THE VERTICAL SOIL TEMP GRADIENT THRU THE LOWEST LAYER. +! ---------------------------------------------------------------------- + ELSE + +! ---------------------------------------------------------------------- +! SET MATRIX COEF, CI TO ZERO. +! ---------------------------------------------------------------------- + DTSDZ2 = (STC (K) - TBOT)/ (.5 * (ZSOIL (K -1) + ZSOIL (K)) & + & - ZBOT) + CI (K) = 0. +! ---------------------------------------------------------------------- +! CALC RHSTS FOR THIS LAYER AFTER CALC'NG A PARTIAL PRODUCT. +! ---------------------------------------------------------------------- + END IF + DENOM = ( ZSOIL (K) - ZSOIL (K -1) ) * HCPCT + +! ---------------------------------------------------------------------- +! CALC MATRIX COEFS, AI, AND BI FOR THIS LAYER. +! ---------------------------------------------------------------------- + RHSTS (K) = ( DF1N * DTSDZ2- DF1K * DTSDZ ) / DENOM + AI (K) = - DF1K * DDZ / ( (ZSOIL (K -1) - ZSOIL (K)) * HCPCT) + +! ---------------------------------------------------------------------- +! RESET VALUES OF DTSDZ AND DDZ FOR LOOP TO NEXT SOIL LYR. +! ---------------------------------------------------------------------- + BI (K) = - (AI (K) + CI (K)) + DF1K = DF1N + DTSDZ = DTSDZ2 + DDZ = DDZ2 + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE HRTICE +! ---------------------------------------------------------------------- + + SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI) + +! ---------------------------------------------------------------------- +! CALCULATE/UPDATE THE SOIL TEMPERATURE FIELD. +! ---------------------------------------------------------------------- + IMPLICIT NONE + INTEGER, INTENT(IN) :: NSOIL + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: STCIN + REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: STCOUT + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: RHSTS + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: AI,BI,CI + REAL, DIMENSION(1:NSOIL) :: RHSTSin + REAL, DIMENSION(1:NSOIL) :: CIin + REAL :: DT + INTEGER :: K + +! ---------------------------------------------------------------------- +! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTS (K) = RHSTS (K) * DT + AI (K) = AI (K) * DT + BI (K) = 1. + BI (K) * DT + CI (K) = CI (K) * DT + END DO +! ---------------------------------------------------------------------- +! COPY VALUES FOR INPUT VARIABLES BEFORE CALL TO ROSR12 +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + RHSTSin (K) = RHSTS (K) + END DO + DO K = 1,NSOIL + CIin (K) = CI (K) + END DO +! ---------------------------------------------------------------------- +! SOLVE THE TRI-DIAGONAL MATRIX EQUATION +! ---------------------------------------------------------------------- + CALL ROSR12 (CI,AI,BI,CIin,RHSTSin,RHSTS,NSOIL) +! ---------------------------------------------------------------------- +! CALC/UPDATE THE SOIL TEMPS USING MATRIX SOLUTION +! ---------------------------------------------------------------------- + DO K = 1,NSOIL + STCOUT (K) = STCIN (K) + CI (K) + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE HSTEP +! ---------------------------------------------------------------------- + + SUBROUTINE PENMAN (SFCTMP,SFCPRS,CH,TH2,PRCP,FDOWN,T24,SSOIL, & + & Q2,Q2SAT,ETP,RCH,RR,SNOWNG,FRZGRA, & + & DQSDT2,FLX2,EMISSI,T1,SIGMA,CPH2O,CPICE,LSUBF) + +! ---------------------------------------------------------------------- +! CALCULATE POTENTIAL EVAPORATION FOR THE CURRENT POINT. VARIOUS +! PARTIAL SUMS/PRODUCTS ARE ALSO CALCULATED AND PASSED BACK TO THE +! CALLING ROUTINE FOR LATER USE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + LOGICAL, INTENT(IN) :: SNOWNG, FRZGRA + REAL, INTENT(IN) :: CH, DQSDT2,FDOWN,PRCP,Q2,Q2SAT,SSOIL,SFCPRS, & + & SFCTMP,TH2,EMISSI,T1,RCH,T24 + REAL, INTENT(IN) :: SIGMA, CPH2O, CPICE, LSUBF + REAL, INTENT(OUT) :: ETP,FLX2,RR + + REAL :: A, DELTA, FNET,RAD,ELCP1,LVS,EPSCA + + REAL, PARAMETER :: ELCP = 2.4888E+3, LSUBC = 2.501000E+6 + REAL, PARAMETER :: LSUBS = 2.83E+6 + +! ---------------------------------------------------------------------- +! PREPARE PARTIAL QUANTITIES FOR PENMAN EQUATION. +! ---------------------------------------------------------------------- + IF ( T1 > 273.15 ) THEN + ELCP1 = ELCP + LVS = LSUBC + ELSE + ELCP1 = ELCP*LSUBS/LSUBC + LVS = LSUBS + ENDIF + DELTA = ELCP1 * DQSDT2 + A = ELCP1 * (Q2SAT - Q2) + RR = EMISSI*T24 * 6.48E-8 / (SFCPRS * CH) + 1.0 + +! ---------------------------------------------------------------------- +! ADJUST THE PARTIAL SUMS / PRODUCTS WITH THE LATENT HEAT +! EFFECTS CAUSED BY FALLING PRECIPITATION. +! ---------------------------------------------------------------------- + IF (.NOT. SNOWNG) THEN + IF (PRCP > 0.0) RR = RR + CPH2O * PRCP / RCH + ELSE + RR = RR + CPICE * PRCP / RCH + END IF + +! ---------------------------------------------------------------------- +! INCLUDE THE LATENT HEAT EFFECTS OF FREEZING RAIN CONVERTING TO ICE ON +! IMPACT IN THE CALCULATION OF FLX2 AND FNET. +! ---------------------------------------------------------------------- + IF (FRZGRA) THEN + FLX2 = - LSUBF * PRCP + ELSE + FLX2 = 0.0 + ENDIF + FNET = FDOWN - ( EMISSI * SIGMA * T24 ) - SSOIL - FLX2 + +! ---------------------------------------------------------------------- +! FINISH PENMAN EQUATION CALCULATIONS. +! ---------------------------------------------------------------------- + RAD = FNET / RCH + TH2 - SFCTMP + EPSCA = (A * RR + RAD * DELTA) / (DELTA + RR) + ETP = EPSCA * RCH / LVS + +! ---------------------------------------------------------------------- + END SUBROUTINE PENMAN +! ---------------------------------------------------------------------- + + SUBROUTINE SHFLX (STC,NSOIL,DT,YY,ZZ1,ZSOIL,TBOT,DF1) +! ---------------------------------------------------------------------- +! UPDATE THE TEMPERATURE STATE OF THE SOIL COLUMN BASED ON THE THERMAL +! DIFFUSION EQUATION AND UPDATE THE FROZEN SOIL MOISTURE CONTENT BASED +! ON THE TEMPERATURE. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: NSOIL + REAL, INTENT(IN) :: DF1,DT,TBOT,YY, ZZ1 + REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC + + REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS + INTEGER :: I + REAL, PARAMETER :: T0 = 273.15 + +! ---------------------------------------------------------------------- +! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN +! ---------------------------------------------------------------------- + + CALL HRTICE (RHSTS,STC,TBOT, NSOIL,ZSOIL,YY,ZZ1,DF1,AI,BI,CI) + + CALL HSTEP (STCF,STC,RHSTS,DT,NSOIL,AI,BI,CI) + + DO I = 1,NSOIL + STC (I) = STCF (I) + END DO +! ---------------------------------------------------------------------- + END SUBROUTINE SHFLX +! ---------------------------------------------------------------------- + + SUBROUTINE SNOPAC (ETP,ETA,PRCP,PRCPF,SNOWNG,NSOIL,DT,DF1, & + & Q2,T1,SFCTMP,T24,TH2,FDOWN,SSOIL,STC, & + & SFCPRS,RCH,RR,SNEQV,SNDENS,SNOWH,ZSOIL,TBOT, & + & SNOMLT,DEW,FLX1,FLX2,FLX3,ESNOW,EMISSI,RIBB, & + & SIGMA,CPH2O,CPICE,LSUBF) + +! ---------------------------------------------------------------------- +! CALCULATE SOIL MOISTURE AND HEAT FLUX VALUES & UPDATE SOIL MOISTURE +! CONTENT AND SOIL HEAT CONTENT VALUES FOR THE CASE WHEN A SNOW PACK IS +! PRESENT. +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER, INTENT(IN) :: NSOIL + LOGICAL, INTENT(IN) :: SNOWNG + REAL, INTENT(IN) :: DF1,DT,FDOWN,PRCP,Q2,RCH,RR,SFCPRS,SFCTMP, & + & T24,TBOT,TH2,EMISSI + REAL, INTENT(IN) :: SIGMA, CPH2O, CPICE, LSUBF + REAL, INTENT(INOUT) :: SNEQV,FLX2,PRCPF,SNOWH,SNDENS,T1,RIBB,ETP + REAL, INTENT(OUT) :: DEW,ESNOW,FLX1,FLX3,SSOIL,SNOMLT + REAL, DIMENSION(1:NSOIL),INTENT(IN) :: ZSOIL + REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC + REAL, DIMENSION(1:NSOIL) :: ET1 + INTEGER :: K + REAL :: DENOM,DSOIL,DTOT,ESDFLX,ETA, & + & ESNOW1,ESNOW2,ETA1,ETP1,ETP2, & + & ETP3,ETANRG,EX, & + & FRCSNO,FRCSOI,PRCP1,QSAT,RSNOW,SEH, & + & SNCOND,T12,T12A,T12B,T14,YY,ZZ1 + + REAL, PARAMETER :: ESDMIN = 1.E-6, LSUBC = 2.501000E+6, & + & LSUBS = 2.83E+6, TFREEZ = 273.15, & + & SNOEXP = 2.0 + +! ---------------------------------------------------------------------- +! FOR GLACIAL-ICE, SNOWCOVER FRACTION = 1.0, AND SUBLIMATION IS AT THE +! POTENTIAL RATE. +! ---------------------------------------------------------------------- +! INITIALIZE EVAP TERMS. +! ---------------------------------------------------------------------- +! conversions: +! ESNOW [KG M-2 S-1] +! ESDFLX [KG M-2 S-1] .le. ESNOW +! ESNOW1 [M S-1] +! ESNOW2 [M] +! ETP [KG M-2 S-1] +! ETP1 [M S-1] +! ETP2 [M] +! ---------------------------------------------------------------------- + SNOMLT = 0.0 + DEW = 0. + ESNOW = 0. + ESNOW1 = 0. + ESNOW2 = 0. + +! ---------------------------------------------------------------------- +! CONVERT POTENTIAL EVAP (ETP) FROM KG M-2 S-1 TO ETP1 IN M S-1 +! ---------------------------------------------------------------------- + PRCP1 = PRCPF *0.001 +! ---------------------------------------------------------------------- +! IF ETP<0 (DOWNWARD) THEN DEWFALL (=FROSTFALL IN THIS CASE). +! ---------------------------------------------------------------------- + IF (ETP <= 0.0) THEN + IF ( ( RIBB >= 0.1 ) .AND. ( FDOWN > 150.0 ) ) THEN + ETP=(MIN(ETP*(1.0-RIBB),0.)/0.980 + ETP*(0.980-1.0))/0.980 + ENDIF + ETP1 = ETP * 0.001 + DEW = -ETP1 + ESNOW2 = ETP1*DT + ETANRG = ETP*LSUBS + ELSE + ETP1 = ETP * 0.001 + ESNOW = ETP + ESNOW1 = ESNOW*0.001 + ESNOW2 = ESNOW1*DT + ETANRG = ESNOW*LSUBS + END IF + +! ---------------------------------------------------------------------- +! IF PRECIP IS FALLING, CALCULATE HEAT FLUX FROM SNOW SFC TO NEWLY +! ACCUMULATING PRECIP. NOTE THAT THIS REFLECTS THE FLUX APPROPRIATE FOR +! THE NOT-YET-UPDATED SKIN TEMPERATURE (T1). ASSUMES TEMPERATURE OF THE +! SNOWFALL STRIKING THE GROUND IS =SFCTMP (LOWEST MODEL LEVEL AIR TEMP). +! ---------------------------------------------------------------------- + FLX1 = 0.0 + IF (SNOWNG) THEN + FLX1 = CPICE * PRCP * (T1- SFCTMP) + ELSE + IF (PRCP > 0.0) FLX1 = CPH2O * PRCP * (T1- SFCTMP) + END IF +! ---------------------------------------------------------------------- +! CALCULATE AN 'EFFECTIVE SNOW-GRND SFC TEMP' (T12) BASED ON HEAT FLUXES +! BETWEEN THE SNOW PACK AND THE SOIL AND ON NET RADIATION. +! INCLUDE FLX1 (PRECIP-SNOW SFC) AND FLX2 (FREEZING RAIN LATENT HEAT) +! FLUXES. FLX1 FROM ABOVE, FLX2 BROUGHT IN VIA COMMOM BLOCK RITE. +! FLX2 REFLECTS FREEZING RAIN LATENT HEAT FLUX USING T1 CALCULATED IN +! PENMAN. +! ---------------------------------------------------------------------- + DSOIL = - (0.5 * ZSOIL (1)) + DTOT = SNOWH + DSOIL + DENOM = 1.0+ DF1 / (DTOT * RR * RCH) + T12A = ( (FDOWN - FLX1- FLX2- EMISSI * SIGMA * T24)/ RCH & + + TH2- SFCTMP - ETANRG / RCH ) / RR + T12B = DF1 * STC (1) / (DTOT * RR * RCH) + + T12 = (SFCTMP + T12A + T12B) / DENOM + IF (T12 <= TFREEZ) THEN +! ---------------------------------------------------------------------- +! SUB-FREEZING BLOCK +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS AT OR BELOW FREEZING, NO SNOW +! MELT WILL OCCUR. SET THE SKIN TEMP TO THIS EFFECTIVE TEMP. REDUCE +! (BY SUBLIMINATION ) OR INCREASE (BY FROST) THE DEPTH OF THE SNOWPACK, +! DEPENDING ON SIGN OF ETP. +! UPDATE SOIL HEAT FLUX (SSOIL) USING NEW SKIN TEMPERATURE (T1) +! SINCE NO SNOWMELT, SET ACCUMULATED SNOWMELT TO ZERO, SET 'EFFECTIVE' +! PRECIP FROM SNOWMELT TO ZERO, SET PHASE-CHANGE HEAT FLUX FROM SNOWMELT +! TO ZERO. +! ---------------------------------------------------------------------- + T1 = T12 + SSOIL = DF1 * (T1- STC (1)) / DTOT + SNEQV = MAX(0.0, SNEQV-ESNOW2) + FLX3 = 0.0 + EX = 0.0 + SNOMLT = 0.0 + ELSE +! ---------------------------------------------------------------------- +! ABOVE FREEZING BLOCK +! ---------------------------------------------------------------------- +! IF THE 'EFFECTIVE SNOW-GRND SFC TEMP' IS ABOVE FREEZING, SNOW MELT +! WILL OCCUR. CALL THE SNOW MELT RATE,EX AND AMT, SNOMLT. REVISE THE +! EFFECTIVE SNOW DEPTH. REVISE THE SKIN TEMP BECAUSE IT WOULD HAVE CHGD +! DUE TO THE LATENT HEAT RELEASED BY THE MELTING. CALC THE LATENT HEAT +! RELEASED, FLX3. SET THE EFFECTIVE PRECIP, PRCP1 TO THE SNOW MELT RATE, +! EX FOR USE IN SMFLX. ADJUSTMENT TO T1 TO ACCOUNT FOR SNOW PATCHES. +! CALCULATE QSAT VALID AT FREEZING POINT. NOTE THAT ESAT (SATURATION +! VAPOR PRESSURE) VALUE OF 6.11E+2 USED HERE IS THAT VALID AT FRZZING +! POINT. NOTE THAT ETP FROM CALL PENMAN IN SFLX IS IGNORED HERE IN +! FAVOR OF BULK ETP OVER 'OPEN WATER' AT FREEZING TEMP. +! UPDATE SOIL HEAT FLUX (S) USING NEW SKIN TEMPERATURE (T1) +! ---------------------------------------------------------------------- + T1 = TFREEZ + IF ( DTOT .GT. 2.0*DSOIL ) THEN + DTOT = 2.0*DSOIL + ENDIF + SSOIL = DF1 * (T1- STC (1)) / DTOT + IF (SNEQV-ESNOW2 <= ESDMIN) THEN + SNEQV = 0.0 + EX = 0.0 + SNOMLT = 0.0 + FLX3 = 0.0 +! ---------------------------------------------------------------------- +! SUBLIMATION LESS THAN DEPTH OF SNOWPACK +! SNOWPACK (SNEQV) REDUCED BY ESNOW2 (DEPTH OF SUBLIMATED SNOW) +! ---------------------------------------------------------------------- + ELSE + SNEQV = SNEQV-ESNOW2 + ETP3 = ETP * LSUBC + SEH = RCH * (T1- TH2) + T14 = ( T1 * T1 ) * ( T1 * T1 ) + FLX3 = FDOWN - FLX1- FLX2- EMISSI*SIGMA * T14- SSOIL - SEH - ETANRG + IF (FLX3 <= 0.0) FLX3 = 0.0 + EX = FLX3*0.001/ LSUBF + SNOMLT = EX * DT +! ---------------------------------------------------------------------- +! ESDMIN REPRESENTS A SNOWPACK DEPTH THRESHOLD VALUE BELOW WHICH WE +! CHOOSE NOT TO RETAIN ANY SNOWPACK, AND INSTEAD INCLUDE IT IN SNOWMELT. +! ---------------------------------------------------------------------- + IF (SNEQV- SNOMLT >= ESDMIN) THEN + SNEQV = SNEQV- SNOMLT + ELSE +! ---------------------------------------------------------------------- +! SNOWMELT EXCEEDS SNOW DEPTH +! ---------------------------------------------------------------------- + EX = SNEQV / DT + FLX3 = EX *1000.0* LSUBF + SNOMLT = SNEQV + + SNEQV = 0.0 + ENDIF + ENDIF + +! ---------------------------------------------------------------------- +! FOR GLACIAL ICE, THE SNOWMELT WILL BE ADDED TO SUBSURFACE +! RUNOFF/BASEFLOW LATER NEAR THE END OF SFLX (AFTER RETURN FROM CALL TO +! SUBROUTINE SNOPAC) +! ---------------------------------------------------------------------- + + ENDIF + +! ---------------------------------------------------------------------- +! BEFORE CALL SHFLX IN THIS SNOWPACK CASE, SET ZZ1 AND YY ARGUMENTS TO +! SPECIAL VALUES THAT ENSURE THAT GROUND HEAT FLUX CALCULATED IN SHFLX +! MATCHES THAT ALREADY COMPUTED FOR BELOW THE SNOWPACK, THUS THE SFC +! HEAT FLUX TO BE COMPUTED IN SHFLX WILL EFFECTIVELY BE THE FLUX AT THE +! SNOW TOP SURFACE. +! ---------------------------------------------------------------------- + ZZ1 = 1.0 + YY = STC (1) -0.5* SSOIL * ZSOIL (1)* ZZ1/ DF1 + +! ---------------------------------------------------------------------- +! SHFLX WILL CALC/UPDATE THE SOIL TEMPS. +! ---------------------------------------------------------------------- + CALL SHFLX (STC,NSOIL,DT,YY,ZZ1,ZSOIL,TBOT,DF1) + +! ---------------------------------------------------------------------- +! SNOW DEPTH AND DENSITY ADJUSTMENT BASED ON SNOW COMPACTION. YY IS +! ASSUMED TO BE THE SOIL TEMPERTURE AT THE TOP OF THE SOIL COLUMN. +! ---------------------------------------------------------------------- + IF (SNEQV .GE. 0.10) THEN + CALL SNOWPACK (SNEQV,DT,SNOWH,SNDENS,T1,YY) + ELSE + SNEQV = 0.10 + SNOWH = 0.50 +!KWM???? SNDENS = +!KWM???? SNCOND = + ENDIF +! ---------------------------------------------------------------------- + END SUBROUTINE SNOPAC +! ---------------------------------------------------------------------- + + SUBROUTINE SNOWPACK (SNEQV,DTSEC,SNOWH,SNDENS,TSNOW,TSOIL) + +! ---------------------------------------------------------------------- +! CALCULATE COMPACTION OF SNOWPACK UNDER CONDITIONS OF INCREASING SNOW +! DENSITY, AS OBTAINED FROM AN APPROXIMATE SOLUTION OF E. ANDERSON'S +! DIFFERENTIAL EQUATION (3.29), NOAA TECHNICAL REPORT NWS 19, BY VICTOR +! KOREN, 03/25/95. +! ---------------------------------------------------------------------- +! SNEQV WATER EQUIVALENT OF SNOW (M) +! DTSEC TIME STEP (SEC) +! SNOWH SNOW DEPTH (M) +! SNDENS SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY) +! TSNOW SNOW SURFACE TEMPERATURE (K) +! TSOIL SOIL SURFACE TEMPERATURE (K) + +! SUBROUTINE WILL RETURN NEW VALUES OF SNOWH AND SNDENS +! ---------------------------------------------------------------------- + IMPLICIT NONE + + INTEGER :: IPOL, J + REAL, INTENT(IN) :: SNEQV, DTSEC,TSNOW,TSOIL + REAL, INTENT(INOUT) :: SNOWH, SNDENS + REAL :: BFAC,DSX,DTHR,DW,SNOWHC,PEXP, & + TAVGC,TSNOWC,TSOILC,ESDC,ESDCX + REAL, PARAMETER :: C1 = 0.01, C2 = 21.0, G = 9.81, & + KN = 4000.0 +! ---------------------------------------------------------------------- +! CONVERSION INTO SIMULATION UNITS +! ---------------------------------------------------------------------- + SNOWHC = SNOWH *100. + ESDC = SNEQV *100. + DTHR = DTSEC /3600. + TSNOWC = TSNOW -273.15 + TSOILC = TSOIL -273.15 + +! ---------------------------------------------------------------------- +! CALCULATING OF AVERAGE TEMPERATURE OF SNOW PACK +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! CALCULATING OF SNOW DEPTH AND DENSITY AS A RESULT OF COMPACTION +! SNDENS=DS0*(EXP(BFAC*SNEQV)-1.)/(BFAC*SNEQV) +! BFAC=DTHR*C1*EXP(0.08*TAVGC-C2*DS0) +! NOTE: BFAC*SNEQV IN SNDENS EQN ABOVE HAS TO BE CAREFULLY TREATED +! NUMERICALLY BELOW: +! C1 IS THE FRACTIONAL INCREASE IN DENSITY (1/(CM*HR)) +! C2 IS A CONSTANT (CM3/G) KOJIMA ESTIMATED AS 21 CMS/G +! ---------------------------------------------------------------------- + TAVGC = 0.5* (TSNOWC + TSOILC) + IF (ESDC > 1.E-2) THEN + ESDCX = ESDC + ELSE + ESDCX = 1.E-2 + END IF + +! DSX = SNDENS*((DEXP(BFAC*ESDC)-1.)/(BFAC*ESDC)) +! ---------------------------------------------------------------------- +! THE FUNCTION OF THE FORM (e**x-1)/x IMBEDDED IN ABOVE EXPRESSION +! FOR DSX WAS CAUSING NUMERICAL DIFFICULTIES WHEN THE DENOMINATOR "x" +! (I.E. BFAC*ESDC) BECAME ZERO OR APPROACHED ZERO (DESPITE THE FACT THAT +! THE ANALYTICAL FUNCTION (e**x-1)/x HAS A WELL DEFINED LIMIT AS +! "x" APPROACHES ZERO), HENCE BELOW WE REPLACE THE (e**x-1)/x +! EXPRESSION WITH AN EQUIVALENT, NUMERICALLY WELL-BEHAVED +! POLYNOMIAL EXPANSION. + +! NUMBER OF TERMS OF POLYNOMIAL EXPANSION, AND HENCE ITS ACCURACY, +! IS GOVERNED BY ITERATION LIMIT "IPOL". +! IPOL GREATER THAN 9 ONLY MAKES A DIFFERENCE ON DOUBLE +! PRECISION (RELATIVE ERRORS GIVEN IN PERCENT %). +! IPOL=9, FOR REL.ERROR <~ 1.6 E-6 % (8 SIGNIFICANT DIGITS) +! IPOL=8, FOR REL.ERROR <~ 1.8 E-5 % (7 SIGNIFICANT DIGITS) +! IPOL=7, FOR REL.ERROR <~ 1.8 E-4 % ... +! ---------------------------------------------------------------------- + BFAC = DTHR * C1* EXP (0.08* TAVGC - C2* SNDENS) + IPOL = 4 + PEXP = 0. +! PEXP = (1. + PEXP)*BFAC*ESDC/REAL(J+1) + DO J = IPOL,1, -1 + PEXP = (1. + PEXP)* BFAC * ESDCX / REAL (J +1) + END DO + + PEXP = PEXP + 1. +! ---------------------------------------------------------------------- +! ABOVE LINE ENDS POLYNOMIAL SUBSTITUTION +! ---------------------------------------------------------------------- +! END OF KOREAN FORMULATION + +! BASE FORMULATION (COGLEY ET AL., 1990) +! CONVERT DENSITY FROM G/CM3 TO KG/M3 +! DSM=SNDENS*1000.0 + +! DSX=DSM+DTSEC*0.5*DSM*G*SNEQV/ +! & (1E7*EXP(-0.02*DSM+KN/(TAVGC+273.16)-14.643)) + +! & CONVERT DENSITY FROM KG/M3 TO G/CM3 +! DSX=DSX/1000.0 + +! END OF COGLEY ET AL. FORMULATION + +! ---------------------------------------------------------------------- +! SET UPPER/LOWER LIMIT ON SNOW DENSITY +! ---------------------------------------------------------------------- + DSX = SNDENS * (PEXP) + IF (DSX > 0.40) DSX = 0.40 + IF (DSX < 0.05) DSX = 0.05 +! ---------------------------------------------------------------------- +! UPDATE OF SNOW DEPTH AND DENSITY DEPENDING ON LIQUID WATER DURING +! SNOWMELT. ASSUMED THAT 13% OF LIQUID WATER CAN BE STORED IN SNOW PER +! DAY DURING SNOWMELT TILL SNOW DENSITY 0.40. +! ---------------------------------------------------------------------- + SNDENS = DSX + IF (TSNOWC >= 0.) THEN + DW = 0.13* DTHR /24. + SNDENS = SNDENS * (1. - DW) + DW + IF (SNDENS >= 0.40) SNDENS = 0.40 +! ---------------------------------------------------------------------- +! CALCULATE SNOW DEPTH (CM) FROM SNOW WATER EQUIVALENT AND SNOW DENSITY. +! CHANGE SNOW DEPTH UNITS TO METERS +! ---------------------------------------------------------------------- + END IF + SNOWHC = ESDC / SNDENS + SNOWH = SNOWHC * 0.01 + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOWPACK +! ---------------------------------------------------------------------- + + SUBROUTINE SNOWZ0 (Z0, Z0BRD, SNOWH) +! ---------------------------------------------------------------------- +! CALCULATE TOTAL ROUGHNESS LENGTH OVER SNOW +! Z0 ROUGHNESS LENGTH (m) +! Z0S SNOW ROUGHNESS LENGTH:=0.001 (m) +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: Z0BRD + REAL, INTENT(OUT) :: Z0 + REAL, PARAMETER :: Z0S=0.001 + REAL, INTENT(IN) :: SNOWH + REAL :: BURIAL + REAL :: Z0EFF + + BURIAL = 7.0*Z0BRD - SNOWH + IF(BURIAL.LE.0.0007) THEN + Z0EFF = Z0S + ELSE + Z0EFF = BURIAL/7.0 + ENDIF + + Z0 = Z0EFF + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOWZ0 +! ---------------------------------------------------------------------- + + SUBROUTINE SNOW_NEW (TEMP,NEWSN,SNOWH,SNDENS) + +! ---------------------------------------------------------------------- +! CALCULATE SNOW DEPTH AND DENSITY TO ACCOUNT FOR THE NEW SNOWFALL. +! UPDATED VALUES OF SNOW DEPTH AND DENSITY ARE RETURNED. + +! TEMP AIR TEMPERATURE (K) +! NEWSN NEW SNOWFALL (M) +! SNOWH SNOW DEPTH (M) +! SNDENS SNOW DENSITY (G/CM3=DIMENSIONLESS FRACTION OF H2O DENSITY) +! ---------------------------------------------------------------------- + IMPLICIT NONE + REAL, INTENT(IN) :: NEWSN, TEMP + REAL, INTENT(INOUT) :: SNDENS, SNOWH + REAL :: DSNEW, HNEWC, SNOWHC,NEWSNC,TEMPC + +! ---------------------------------------------------------------------- +! CALCULATING NEW SNOWFALL DENSITY DEPENDING ON TEMPERATURE +! EQUATION FROM GOTTLIB L. 'A GENERAL RUNOFF MODEL FOR SNOWCOVERED +! AND GLACIERIZED BASIN', 6TH NORDIC HYDROLOGICAL CONFERENCE, +! VEMADOLEN, SWEDEN, 1980, 172-177PP. +!----------------------------------------------------------------------- + TEMPC = TEMP - 273.15 + IF ( TEMPC <= -15. ) THEN + DSNEW = 0.05 + ELSE + DSNEW = 0.05 + 0.0017 * ( TEMPC + 15. ) ** 1.5 + ENDIF + +! ---------------------------------------------------------------------- +! CONVERSION INTO SIMULATION UNITS +! ---------------------------------------------------------------------- + SNOWHC = SNOWH * 100. + NEWSNC = NEWSN * 100. + +! ---------------------------------------------------------------------- +! ADJUSTMENT OF SNOW DENSITY DEPENDING ON NEW SNOWFALL +! ---------------------------------------------------------------------- + HNEWC = NEWSNC / DSNEW + IF ( SNOWHC + HNEWC < 1.0E-3 ) THEN + SNDENS = MAX ( DSNEW , SNDENS ) + ELSE + SNDENS = ( SNOWHC * SNDENS + HNEWC * DSNEW ) / ( SNOWHC + HNEWC ) + ENDIF + SNOWHC = SNOWHC + HNEWC + SNOWH = SNOWHC * 0.01 + +! ---------------------------------------------------------------------- + END SUBROUTINE SNOW_NEW +! ---------------------------------------------------------------------- + +END MODULE module_sf_noahlsm_glacial_only diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 75afaa6ff..2ec722b4a 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -31,7 +31,20 @@ subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + + if (ivegsrc > 2) then + errmsg = 'The NOAH LSM expects that the ivegsrc physics '// + & 'namelist parameter is 0, 1, or 2. Exiting...' + errflg = 1 + return + end if + if (isot > 1) then + errmsg = 'The NOAH LSM expects that the isot physics '// + & 'namelist parameter is 0, or 1. Exiting...' + errflg = 1 + return + end if + !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 3b4b8a118..dcef59fd0 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -36,6 +36,17 @@ subroutine lsm_ruc_init (me, isot, ivegsrc, nlunit, & errmsg = '' errflg = 0 + if (ivegsrc /= 1) then + errmsg = 'The RUC LSM expects that the ivegsrc physics namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot > 1) then + errmsg = 'The RUC LSM expects that the isot physics namelist parameter is 0, or 1. Exiting...' + errflg = 1 + return + end if + !--- initialize soil vegetation call set_soilveg_ruc(me, isot, ivegsrc, nlunit) diff --git a/physics/sfc_noah_wrfv4.F90 b/physics/sfc_noah_wrfv4.F90 new file mode 100644 index 000000000..c435b2d38 --- /dev/null +++ b/physics/sfc_noah_wrfv4.F90 @@ -0,0 +1,261 @@ +!> \file sfc_noah_wrfv4.F90 +!! This file contains the Noah land surface scheme driver for the version of the scheme found in WRF v4.0. + +!> This module contains the CCPP-compliant Noah land surface scheme driver for +!! the version found in WRF v4.0. + module sfc_noah_wrfv4 + + implicit none + + private + + public :: sfc_noah_wrfv4_init, sfc_noah_wrfv4_run, sfc_noah_wrfv4_finalize + + contains + +!> \ingroup NOAH_LSM_WRFv4 +!! \section arg_table_sfc_noah_wrfv4_init Argument Table +!! \htmlinclude sfc_noah_wrfv4_init.html +!! + subroutine sfc_noah_wrfv4_init(lsm, lsm_noah_wrfv4, nsoil, ua_phys, fasdas, restart, errmsg, errflg) + + use machine, only : kind_phys + + implicit none + + integer, intent(in) :: lsm, lsm_noah_wrfv4, nsoil, fasdas + logical, intent(in) :: ua_phys, restart + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lsm/=lsm_noah_wrfv4) then + write(errmsg,'(*(a))') "Logic error: namelist choice of LSM is different from NOAH WRFv4" + errflg = 1 + return + end if + + if (nsoil < 2) then + write(errmsg,'(*(a))') "The NOAH WRFv4 scheme expects at least 2 soil layers." + errflg = 1 + return + end if + + if (ua_phys) then + write(errmsg,'(*(a))') "The NOAH WRFv4 scheme has not been tested with ua_phys = T" + errflg = 1 + return + end if + + + if (fasdas > 0) then + write(errmsg,'(*(a))') "The NOAH WRFv4 scheme has not been tested with fasdas > 0" + errflg = 1 + return + end if + + if (restart) then + !GJF: for restart functionality, the host model will need to write/read snotime (time_since_last_snowfall (s)) + write(errmsg,'(*(a))') "The NOAH WRFv4 scheme has not been configured for restarts." + errflg = 1 + return + end if + + !GJF: check for rdlai != F? + !GJF: check for usemonalb != T? + + end subroutine sfc_noah_wrfv4_init + + +!! \section arg_table_sfc_noah_wrfv4_finalize Argument Table +!! \htmlinclude sfc_noah_wrfv4_finalize.html +!! + subroutine sfc_noah_wrfv4_finalize(errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine sfc_noah_wrfv4_finalize + + +!> \defgroup NOAH_LSM_WRFv4 Noah LSM Model from WRF v4.0 +!! \section arg_table_sfc_noah_wrfv4_run Argument Table +!! \htmlinclude sfc_noah_wrfv4_run.html +!! +!> \section general_noah_wrfv4_drv NOAH LSM WRFv4 General Algorithm +!> @{ + subroutine sfc_noah_wrfv4_run (im, isice, flag_lsm, flag_lsm_glacier, srflag, isurban, rdlai, & + ua_phys, usemonalb, aoasis, fasdas, dt, zlvl, & + nsoil, sthick, lwdn, soldn, solnet, sfcprs, prcp, sfctmp, q1k, & + th1, qs1, dqsdt2, vegtyp, soiltyp, slopetyp, shdfac, shmin, & + shmax, albbrd, snoalb, tbot, z0brd, z0k, emissi, embrd, cmc, t1,& + stc, smc, swc, snowhk, sneqv, chk, cp, rd, sigma, cph2o, cpice, & + lsubf, sheat, eta, ec, edir, ett, esnow, etp, ssoil, & + flx1, flx2, flx3, sncovr, runoff1, runoff2, soilm, qsurf, ribb, & + smcwlt, smcref, smcmax, opt_thcnd, snotime, errmsg, errflg) + + use machine , only : kind_phys + use module_sf_noahlsm, only: sflx, lutype, sltype + use module_sf_noahlsm_glacial_only, only: sflx_glacial + + implicit none + + integer, intent(in) :: im, isice, isurban, nsoil, opt_thcnd, fasdas + logical, intent(in) :: rdlai, ua_phys, usemonalb + !GJF: usemonalb = True if the surface diffused shortwave albedo is EITHER read from input OR + ! provided by a previous scheme (like radiation: as is done in GFS_rrtmgp_sw_pre) + real(kind=kind_phys), intent(in) :: aoasis + + real(kind=kind_phys), intent(in) :: dt, cp, rd, sigma, cph2o, cpice, lsubf + + integer, dimension(im), intent(in) :: vegtyp, soiltyp, slopetyp + logical, dimension(im), intent(in) :: flag_lsm, flag_lsm_glacier + real(kind=kind_phys), dimension(im), intent(in) :: srflag, zlvl, lwdn, soldn, solnet, & + sfcprs, prcp, sfctmp, q1k, th1, qs1, & + dqsdt2, shmin, shmax, snoalb, tbot + real(kind=kind_phys), dimension(nsoil), intent(in) :: sthick + + real(kind=kind_phys), dimension(im), intent(inout) :: shdfac, albbrd, z0brd, z0k, emissi, & + cmc, t1, snowhk, sneqv, chk, flx1, & + flx2, flx3, ribb, snotime + real(kind=kind_phys), dimension(im,nsoil), intent(inout) :: stc, smc, swc + + !variables that are intent(out) in module_sf_noahlsm, but are inout here due to being set within an IF statement + real(kind=kind_phys), dimension(im), intent(inout) :: embrd, sheat, eta, ec, & + edir, ett, esnow, etp, ssoil, sncovr, & + runoff1, runoff2, soilm, qsurf, smcwlt, & + smcref, smcmax + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !GJF: There is some confusion regarding specific humidities vs mixing ratios in NOAH LSM. + ! Looking at module_sf_noahlsm.F, sometimes the comments say mixing ratio and sometimes + ! specific humidity. The WRF code (module_sf_noahdrv.F) specifically converts from mixing + ! ratio to specific humidity in preparation for calling SFLX, so I am assuming that + ! all inputs/outputs into SFLX should be specific humidities, despite some comments in + ! module_sf_noahdrv.F describing arguments saying "mixing ratios". This applies to many + ! arguments into SFLX (q1k, qs1, dqsdt2, eta, qsurf, etc.). + +! local Variables + integer :: i, k + logical, parameter :: local = .false. !(not actually used in SFLX) described in module_sf_noahlsm as: + ! Flag for local-site simulation (where there is no maps for albedo, veg fraction, and roughness + ! true: all LSM parameters (inluding albedo, veg fraction and roughness length) will be defined by three tables + + real(kind=kind_phys) :: dummy + + !GJF: The following variables are part of the interface to SFLX but not required as diagnostic + ! output or otherwise outside of this subroutine (at least as part of a GFS-based suite). + ! If any of these variables are needed by other schemes or diagnostics, one needs to add it to + ! the host model and CCPP metadata. Alternatively, none of these variables NEED to be allocated + ! and one could also just pass in dummy arguments. + ! + ! The variables descriptions are from module_sf_noahlsm.F: + ! + ! albedok (output from SFLX): surface albedo including snow effect (unitless fraction) + ! =snow-free albedo (alb) when sneqv=0, or + ! =fct(msnoalb,alb,vegtyp,shdfac,shdmin) when sneqv>0 + ! eta_kinematic (output from SFLX), eta is what is passed out instead of eta_kinematic + ! fdown (output from SFLX) : Radiation forcing at the surface (W m-2) = SOLDN*(1-alb)+LWDN + ! et (output from SFLX): plant transpiration from a particular root (soil) layer (W m-2) + ! drip (output from SFLX): through-fall of precip and/or dew in excess of canopy water-holding capacity (m) + ! dew (output from SFLX): dewfall (or frostfall for t<273.15) (m) + ! beta (output from SFLX): ratio of actual/potential evap (dimensionless) + ! snomlt (output from SFLX): snow melt (m) (water equivalent) + ! runoff3 (output from SFLX): numerical trunctation in excess of porosity (smcmax) for a given soil layer at the end of a time step (m s-1). + ! rc (output from SFLX): canopy resistance (s m-1) + ! pc (output from SFLX): plant coefficient (unitless fraction, 0-1) where pc*etp = actual transp + ! rsmin (output from SFLX): minimum canopy resistance (s m-1) + ! xlai (output from SFLX): leaf area index (dimensionless) + ! rcs (output from SFLX): incoming solar rc factor (dimensionless) + ! rct (output from SFLX): air temperature rc factor (dimensionless) + ! rcq (output from SFLX): atmos vapor pressure deficit rc factor (dimensionless) + ! rcsoil (output from SFLX): soil moisture rc factor (dimensionless) + ! soilw (output from SFLX): available soil moisture in root zone (unitless fraction between smcwlt and smcmax) + ! smav (output from SFLX): soil moisture availability for each layer, as a fraction between smcwlt and smcmax. + ! smcdry (output from SFLX): dry soil moisture threshold where direct evap frm top layer ends (volumetric) + ! smcmax (output from SFLX): porosity, i.e. saturated value of soil moisture (volumetric) + ! nroot (output from SFLX): number of root layers, a function of veg type, determined in subroutine redprm. + + integer :: nroot + real(kind=kind_phys) :: albedok, eta_kinematic, fdown, drip, dew, beta, snomlt, & + runoff3, rc, pc, rsmin, xlai, rcs, rct, rcq, & + rcsoil, soilw, smcdry + real (kind=kind_phys), dimension(nsoil) :: et, smav + real(kind=kind_phys) :: sfcheadrt, infxsrt, etpnd1 !don't appear to be used unless WRF_HYDRO preprocessor directive is defined and no documentation + real(kind=kind_phys) :: xsda_qfx, hfx_phy, qfx_phy, xqnorm, hcpct_fasdas !only used if fasdas = 1 + + !variables associated with UA_PHYS (not used for now) + real(kind=kind_phys) :: flx4, fvb, fbur, fgsn + + errmsg = '' + errflg = 0 + + do i=1, im + if (flag_lsm(i)) then + !GJF: Why do LSMs want the dynamics time step instead of the physics time step? + call sflx (i, 1, srflag(i), & + isurban, dt, zlvl(i), nsoil, sthick, & !c + local, & !L + lutype, sltype, & !CL + lwdn(i), soldn(i), solnet(i), sfcprs(i), prcp(i), & !F + sfctmp(i), q1k(i), dummy, dummy, dummy, dummy, & !F + th1(i), qs1(i), dqsdt2(i), & !I + vegtyp(i), soiltyp(i), slopetyp(i), shdfac(i), & !I + shmin(i), shmax(i), & !I + albbrd(i), snoalb(i), tbot(i), z0brd(i), z0k(i), & !S + emissi(i), embrd(i), & !S + cmc(i), t1(i), stc(i,:), smc(i,:), swc(i,:), & !H + snowhk(i), sneqv(i), albedok, chk(i), dummy, & !H + cp, rd, sigma, cph2o, cpice, lsubf, & + eta(i), sheat(i), eta_kinematic, fdown, & !O + ec(i), edir(i), et, ett(i), esnow(i), drip, dew, & !O + beta, etp(i), ssoil(i), flx1(i), flx2(i), flx3(i),& !O + flx4, fvb, fbur, fgsn, ua_phys, & !UA + snomlt, sncovr(i), runoff1(i), runoff2(i),runoff3,& !O + rc, pc, rsmin, xlai, rcs, rct, rcq, rcsoil, & !O + soilw, soilm(i), qsurf(i), smav, & !D + rdlai, usemonalb, snotime(i), ribb(i), & + smcwlt(i), smcdry, smcref(i), smcmax(i), nroot, & + sfcheadrt, infxsrt, etpnd1, opt_thcnd, aoasis, & + xsda_qfx, hfx_phy, qfx_phy, xqnorm, fasdas, & !fasdas + hcpct_fasdas, & !fasdas + errflg, errmsg) + if (errflg > 0) return + else if (flag_lsm_glacier(i)) then + !set values that sflx updates, but sflx_glacial does not + soilm(i) = 0.0 + runoff2(i) = 0.0 + swc(i,:) = 1.0 + smc(i,:) = 1.0 + + call sflx_glacial (i, 1, isice, srflag(i), dt, zlvl(i), & + nsoil, sthick, lwdn(i), solnet(i), sfcprs(i), & + prcp(i), sfctmp(i), q1k(i), th1(i), qs1(i), & + dqsdt2(i), albbrd(i), snoalb(i), tbot(i), & + z0brd(i), z0k(i), emissi(i), embrd(i), t1(i), & + stc(i,:), snowhk(i), sneqv(i), albedok, chk(i), & + cp, rd, sigma, cph2o, cpice, lsubf, & + eta(i), sheat(i), eta_kinematic, fdown, esnow(i), & + dew, etp(i), ssoil(i), flx1(i), flx2(i), flx3(i), & + snomlt, sncovr(i), runoff1(i), qsurf(i), & + snotime(i), ribb(i), errflg, errmsg) + if (errflg > 0) return + end if + end do + + end subroutine sfc_noah_wrfv4_run +!> @} + +end module sfc_noah_wrfv4 diff --git a/physics/sfc_noah_wrfv4.meta b/physics/sfc_noah_wrfv4.meta new file mode 100644 index 000000000..781a21d3b --- /dev/null +++ b/physics/sfc_noah_wrfv4.meta @@ -0,0 +1,764 @@ +[ccpp-arg-table] + name = sfc_noah_wrfv4_init + type = scheme +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noah_wrfv4] + standard_name = flag_for_noah_wrfv4_land_surface_scheme + long_name = flag for NOAH WRFv4 land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ua_phys] + standard_name = flag_for_noah_lsm_ua_extension + long_name = flag for using University of Arizona(?) extension for NOAH LSM (see module_sf_noahlsm.F) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fasdas] + standard_name = flag_flux_adjusting_surface_data_assimilation_system + long_name = flag to use the flux adjusting surface data assimilation system for NOAH LSM WRFv4 (see module_sf_noahlsm.F) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_wrfv4_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_wrfv4_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[isice] + standard_name = ice_vegetation_category + long_name = index of the permanent snow/ice category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = in + optional = F +[flag_lsm] + standard_name = flag_for_calling_land_surface_model + long_name = flag for calling land surface model + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_lsm_glacier] + standard_name = flag_for_calling_land_surface_model_glacier + long_name = flag for calling land surface model over glacier + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[srflag] + standard_name = flag_for_precipitation_type + long_name = flag for snow or rain precipitation + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[isurban] + standard_name = urban_vegetation_category + long_name = index of the urban vegetation category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = in + optional = F +[rdlai] + standard_name = flag_for_reading_leaf_area_index_from_input + long_name = flag for reading leaf area index from initial conditions + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ua_phys] + standard_name = flag_for_noah_lsm_ua_extension + long_name = flag for using University of Arizona(?) extension for NOAH LSM (see module_sf_noahlsm.F) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[usemonalb] + standard_name = flag_for_reading_surface_diffused_shortwave_albedo_from_input + long_name = flag for reading surface diffused shortwave albedo for NOAH LSM WRFv4 (see module_sf_noahlsm.F) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[aoasis] + standard_name = potential_evaporation_multiplicative_factor + long_name = potential evaporation multiplicative factor for NOAH LSM WRFv4 (see module_sf_noahlsm.F) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fasdas] + standard_name = flag_flux_adjusting_surface_data_assimilation_system + long_name = flag to use the flux adjusting surface data assimilation system for NOAH LSM WRFv4 (see module_sf_noahlsm.F) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zlvl] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[sthick] + standard_name = soil_layer_thickness + long_name = soil layer thickness + units = m + dimensions = (soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lwdn] + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land + long_name = total sky surface downward longwave flux absorbed by the ground over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[soldn] + standard_name = surface_downwelling_shortwave_flux + long_name = total sky surface downward shortwave flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[solnet] + standard_name = surface_net_downwelling_shortwave_flux + long_name = total sky surface net shortwave flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfcprs] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prcp] + standard_name = total_precipitation_rate_on_dynamics_timestep_over_land + long_name = total precipitation rate in each time step over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfctmp] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1k] + standard_name = bounded_specific_humidity_at_lowest_model_layer_over_land + long_name = specific humidity at lowest model layer over land bounded between a nonzero epsilon and saturation + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[th1] + standard_name = potential_temperature_at_lowest_model_layer + long_name = potential_temperature_at_lowest_model_layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[qs1] + standard_name = saturation_specific_humidity_at_lowest_model_layer + long_name = saturation specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[dqsdt2] + standard_name = saturation_specific_humidity_slope + long_name = saturation specific humidity slope at lowest model layer + units = K-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[vegtyp] + standard_name = vegetation_type_classification + long_name = vegetation type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[soiltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[slopetyp] + standard_name = surface_slope_classification + long_name = surface slope type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[shdfac] + standard_name = bounded_vegetation_area_fraction + long_name = areal fractional cover of green vegetation bounded on the bottom + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[shmin] + standard_name = minimum_vegetation_area_fraction + long_name = min fractional coverage of green vegetation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[shmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albbrd] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused shortwave albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tbot] + standard_name = deep_soil_temperature + long_name = bottom soil temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[z0brd] + standard_name = baseline_surface_roughness_length + long_name = baseline surface roughness length for momentum in meter + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[z0k] + standard_name = surface_roughness_length_over_land_interstitial + long_name = surface roughness length over land (temporary use as interstitial) + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[emissi] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[embrd] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cmc] + standard_name = canopy_water_amount_in_m + long_name = canopy water amount in m + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[t1] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[swc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = volume fraction of unfrozen soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowhk] + standard_name = actual_snow_depth + long_name = actual snow depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sneqv] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[chk] + standard_name = surface_conductance_for_heat_and_moisture_in_air_over_land + long_name = surface conductance for heat & moisture over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = stefan_boltzmann_constant + long_name = Steffan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cph2o] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cpice] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsubf] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sheat] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[eta] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ec] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[edir] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ett] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[esnow] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[etp] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ssoil] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[flx1] + standard_name = latent_heat_flux_from_precipitating_snow + long_name = latent heat flux due to precipitating snow + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[flx2] + standard_name = latent_heat_flux_from_freezing_rain + long_name = latent heat flux due to freezing rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[flx3] + standard_name = latent_heat_flux_due_to_snowmelt + long_name = latent heat flux due to snowmelt phase change + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff1] + standard_name = surface_runoff_flux_in_m_sm1 + long_name = surface runoff flux in m s-1 + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff2] + standard_name = subsurface_runoff_flux_in_m_sm1 + long_name = subsurface runoff flux in m s-1 + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[soilm] + standard_name = soil_moisture_content_in_m + long_name = soil moisture in meters + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[qsurf] + standard_name = surface_specific_humidity_over_land + long_name = surface air saturation specific humidity over land + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ribb] + standard_name = bulk_richardson_number_at_lowest_model_level_over_land + long_name = bulk Richardson number at the surface over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwlt] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = soil water fraction at wilting point + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smcref] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smcmax] + standard_name = soil_porosity + long_name = volumetric soil porosity + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[opt_thcnd] + standard_name = flag_for_thermal_conductivity_option + long_name = choice for thermal conductivity option (see module_sf_noahlsm) + units = index + dimensions = () + type = integer + intent = in + optional = F +[snotime] + standard_name = time_since_last_snowfall + long_name = elapsed time since last snowfall + units = s + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_noah_wrfv4_interstitial.F90 b/physics/sfc_noah_wrfv4_interstitial.F90 new file mode 100644 index 000000000..b30f8a131 --- /dev/null +++ b/physics/sfc_noah_wrfv4_interstitial.F90 @@ -0,0 +1,758 @@ +!> \file sfc_noah_wrfv4_interstitial.F90 +!! This file contains data preparation for the WRFv4 version of Noah LSM as part of a GFS-based suite. + +!> This module contains the CCPP-compliant data preparation for the WRFv4 version of Noah LSM. + module sfc_noah_wrfv4_pre + + implicit none + + public :: sfc_noah_wrfv4_pre_init, sfc_noah_wrfv4_pre_run, sfc_noah_wrfv4_pre_finalize + + private + + logical :: is_initialized = .false. + + contains + +!> \ingroup NOAH_LSM_WRFv4 +!! \section arg_table_sfc_noah_wrfv4_pre_init Argument Table +!! \htmlinclude sfc_noah_wrfv4_pre_init.html +!! + subroutine sfc_noah_wrfv4_pre_init(lsm, lsm_noah_wrfv4, veg_data_choice, & + soil_data_choice, isurban, isice, iswater, errmsg, errflg) + + use machine, only : kind_phys + + implicit none + + integer, intent(in) :: lsm, lsm_noah_wrfv4, & + veg_data_choice, soil_data_choice + + integer, intent(inout) :: isurban, isice, iswater + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + + character(len=256) :: mminlu, mminsl + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + if (lsm/=lsm_noah_wrfv4) then + write(errmsg,'(*(a))') "Logic error: namelist choice of LSM is different from NOAH WRFv4" + errflg = 1 + return + end if + + select case (veg_data_choice) + case (0) + mminlu = 'USGS' + isurban = 1 + isice = 24 + iswater = 16 + case (1) + mminlu = 'MODIFIED_IGBP_MODIS_NOAH' + isurban = 13 + isice = 15 + iswater = 17 + case (3) + mminlu = 'NLCD40' + isurban = 13 + isice = 15 !or 22? + iswater = 17 !or 21? + case (4) + mminlu = 'USGS-RUC' + isurban = 1 + isice = 24 + iswater = 16 + case (5) + mminlu = 'MODI-RUC' + isurban = 13 + isice = 15 + iswater = 17 + case default + errmsg = 'The value of the ivegsrc physics namelist parameter is incompatible with this version of NOAH LSM' + errflg = 1 + return + end select + + select case (soil_data_choice) + case (1) + mminsl = 'STAS' + case (2) + mminsl = 'STAS-RUC' + case default + errmsg = 'The value of the isot physics namelist parameter is incompatible with this version of NOAH LSM' + errflg = 1 + return + end select + + call soil_veg_gen_parm(trim(mminlu), trim(mminsl), errmsg, errflg) + + is_initialized = .true. + + end subroutine sfc_noah_wrfv4_pre_init + + +!! \section arg_table_sfc_noah_wrfv4_pre_finalize Argument Table +!! \htmlinclude sfc_noah_wrfv4_pre_finalize.html +!! + subroutine sfc_noah_wrfv4_pre_finalize(errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine sfc_noah_wrfv4_pre_finalize + + +!> \ingroup NOAH_LSM_WRFv4 Noah LSM from WRFv4 pre-scheme data preparation +!! \section arg_table_sfc_noah_wrfv4_pre_run Argument Table +!! \htmlinclude sfc_noah_wrfv4_pre_run.html +!! +!> \section general_noah_wrfv4_pre NOAH LSM WRFv4 pre-scheme data preparation General Algorithm +!> @{ + subroutine sfc_noah_wrfv4_pre_run (im, nsoil, ialb, isice, land, & + flag_guess, flag_iter, restart, first_time_step, flag_lsm, & + flag_lsm_glacier, dt, rhowater, rd, rvrdm1, eps, epsm1, sfcprs, tprcp, & + sfctmp, q1, prslki, wind, snwdph, cm, ch, weasd, tsfc, vtype, smc, & + stc, slc, snoalb, prcp, q2k, rho1, qs1, th1, dqsdt2, canopy, cmc, & + snowhk, chk, cmm, chh, weasd_save, snwdph_save, tsfc_save, canopy_save,& + smc_save, stc_save, slc_save, ep, evap, hflx, gflux, drain, evbs, evcw,& + trans, sbsno, snowc, snohf, sthick, errmsg, errflg) + + use machine , only : kind_phys + use funcphys, only : fpvs + use module_sf_noahlsm, only: maxalb + + implicit none + + !GJF: Data preparation and output preparation from SFLX follows the GFS physics code (sfc_drv.F) + ! rather than the WRF code (module_sf_noahdrv.F) in order to "fit in" with other GFS physics-based + ! suites. Another version of this scheme (and the associated post) could potentially be + ! created from the WRF version. No attempt was made to test sensitivities to either approach. + ! Note that the version of NOAH LSM expected here is "generic" - there are no urban, fasdas, or + ! or University of Arizona(?) additions. + + integer, intent(in) :: im, nsoil, ialb, isice + logical, intent(in) :: restart, first_time_step + real(kind=kind_phys), intent(in) :: dt, rhowater, rd, rvrdm1, eps, epsm1 + + logical, dimension(im), intent(in) :: flag_guess, flag_iter, land + real(kind=kind_phys), dimension(im), intent(in) :: sfcprs, tprcp, sfctmp, q1, prslki, wind, cm, ch, snwdph + real(kind=kind_phys), dimension(im), intent(in) :: weasd, tsfc, vtype + real(kind=kind_phys), dimension(im,nsoil), intent(in) :: smc, stc, slc + + logical, dimension(im), intent(inout) :: flag_lsm, flag_lsm_glacier + real(kind=kind_phys), dimension(im), intent(inout) :: snoalb, prcp, q2k, rho1, qs1, th1, dqsdt2, canopy, cmc, snowhk, chk, cmm, chh + real(kind=kind_phys), dimension(im), intent(inout) :: weasd_save, snwdph_save, tsfc_save, canopy_save + real(kind=kind_phys), dimension(im,nsoil), intent(inout) :: smc_save, stc_save, slc_save + real(kind=kind_phys), dimension(im), intent(inout) :: ep, evap, hflx, gflux, drain, evbs, evcw, trans, sbsno, snowc, snohf + real(kind=kind_phys), dimension(nsoil), intent(inout) :: sthick + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! local Variables + integer :: i, k + real(kind=kind_phys) :: sneqv + + REAL, PARAMETER :: A2=17.67,A3=273.15,A4=29.65, & + A23M4=A2*(A3-A4) + real(kind=kind_phys), parameter, dimension(4) :: zsoil = (/ -0.1,-0.4,-1.0,-2.0/) !what if nsoil /= 4? + +!> - Initialize CCPP error handling variables + + errmsg = '' + errflg = 0 + + !from module_sf_noahdrv.F/lsminit + if (.not. restart .and. first_time_step .and. ialb == 0) then + do i = 1, im + snoalb(i) = maxalb(int(0.5 + vtype(i)))*0.01 + end do + end if + + do i=1, im + if (land(i) .and. flag_guess(i)) then + weasd_save(i) = weasd(i) + snwdph_save(i) = snwdph(i) + tsfc_save(i) = tsfc(i) + canopy_save(i) = canopy(i) + + do k=1,nsoil + smc_save(i,k) = smc(i,k) + stc_save(i,k) = stc(i,k) + slc_save(i,k) = slc(i,k) + end do + end if + end do + + sthick(1) = - zsoil(1) + do k = 2, nsoil + sthick(k) = zsoil(k-1) - zsoil(k) + enddo + + flag_lsm(:) = .false. + flag_lsm_glacier(:) = .false. + do i=1, im + if (flag_iter(i) .and. land(i)) then + if (vtype(i) == isice) then + flag_lsm_glacier(i) = .true. + else + flag_lsm(i) = .true. + end if + !GJF: module_sf_noahdrv.F from WRF has hardcoded slopetyp = 1; why? replicate here? + !GJF: shdfac is zeroed out for particular combinations of vegetation table source and vegetation types; replicate here? + + ep(i) = 0.0 + evap (i) = 0.0 + hflx (i) = 0.0 + gflux(i) = 0.0 + drain(i) = 0.0 + + evbs (i) = 0.0 + evcw (i) = 0.0 + trans(i) = 0.0 + sbsno(i) = 0.0 + snowc(i) = 0.0 + snohf(i) = 0.0 + + !GJF: could potentially pass in pre-calculated rates instead of calculating here + prcp(i) = rhowater * tprcp(i) / dt + + !GJF: The GFS version of NOAH prepares the specific humidity in sfc_drv.f as follows: + q2k(i) = max(q1(i), 1.e-8) + rho1(i) = sfcprs(i) / (rd*sfctmp(i)*(1.0+rvrdm1*q2k(i))) + + qs1(i) = fpvs( sfctmp(i) ) + qs1(i) = max(eps*qs1(i) / (sfcprs(i)+epsm1*qs1(i)), 1.e-8) + q2k(i) = min(qs1(i), q2k(i)) + + !GJF: could potentially pass in pre-calcualted potential temperature if other schemes also need it (to avoid redundant calculation) + th1(i) = sfctmp(i) * prslki(i) + + !GJF: module_sf_noahdrv.F from WRF modifies dqsdt2 if the surface has snow. + dqsdt2(i)=qs1(i)*a23m4/(sfctmp(i)-a4)**2 + + !GJF: convert canopy moisture from kg m-2 to m + canopy(i) = max(canopy(i), 0.0) !check for positive values in sfc_drv.f + cmc(i) = canopy(i)/rhowater + + !GJF: snow depth passed in to NOAH is conditionally modified differently in GFS and WRF: + sneqv = weasd(i) * 0.001 + snowhk(i) = snwdph(i) * 0.001 + if ( (sneqv /= 0.0 .and. snowhk(i) == 0.) .or. (snowhk(i) <= sneqv) ) then + snowhk(i) = 5.*sneqv + end if + !GJF: GFS version: + ! if (sneqv(i) /= 0.0 .and. snwdph(i) == 0.0) then + ! snowhk(i) = 10.0 * sneqv(i) + ! endif + + !GJF: calculate conductance from surface exchange coefficient + chk(i) = ch(i) * wind(i) + + chh(i) = chk(i) * rho1(i) + cmm(i) = cm(i) * wind(i) + + +!GJF: If the perturbations of vegetation fraction is desired, one could uncomment this code +! and add appropriate arguments to make this work. This is from the GFS version of NOAH LSM +! in sfc_drv.f. + +!> - Call surface_perturbation::ppfbet() to perturb vegetation fraction that goes into gsflx(). +! perturb vegetation fraction that goes into sflx, use the same +! perturbation strategy as for albedo (percentile matching) +!! Following Gehne et al. (2018) \cite gehne_et_al_2018, a perturbation of vegetation +!! fraction is added to account for the uncertainty. A percentile matching technique +!! is applied to guarantee the perturbed vegetation fraction is bounded between 0 and +!! 1. The standard deviation of the perturbations is 0.25 for vegetation fraction of +!! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper +!! or lower bound. + ! vegfp = vegfpert(i) ! sfc-perts, mgehne + ! if (pertvegf(1)>0.0) then + ! ! compute beta distribution parameters for vegetation fraction + ! mv = shdfac + ! sv = pertvegf(1)*mv*(1.-mv) + ! alphav = mv*mv*(1.0-mv)/(sv*sv)-mv + ! betav = alphav*(1.0-mv)/mv + ! ! compute beta distribution value corresponding + ! ! to the given percentile albPpert to use as new albedo + ! call ppfbet(vegfp,alphav,betav,iflag,vegftmp) + ! shdfac = vegftmp + ! endif +! *** sfc-perts, mgehne + endif + end do + + + end subroutine sfc_noah_wrfv4_pre_run + + subroutine soil_veg_gen_parm( mminlu, mminsl, errmsg, errflg) + !this routine is mostly taken from module_sf_noahdrv.F in WRF + use module_sf_noahlsm, only: shdtbl, nrotbl, rstbl, rgltbl, hstbl, snuptbl, & ! begin land use / vegetation variables + maxalb, laimintbl, laimaxtbl, z0mintbl, z0maxtbl, & + albedomintbl, albedomaxtbl, ztopvtbl,zbotvtbl, & + emissmintbl, emissmaxtbl, topt_data, cmcmax_data, & + cfactr_data, rsmax_data, bare, natural, & + low_density_residential, high_density_residential, & + high_intensity_industrial, lucats, lutype, & !end land use / vegetation variables + bb,drysmc,f11, & ! begin soil variables + maxsmc, refsmc,satpsi,satdk,satdw, wltsmc,qtz,& + slcats, sltype, & ! end soil variables + slope_data, sbeta_data,fxexp_data,csoil_data,salp_data,refdk_data, & ! begin NOAH "general" variables + refkdt_data,frzk_data,zbot_data, smlow_data,smhigh_data, & + czil_data, lvcoef_data, slpcats ! end NOAH "general" variables + implicit none + + character(len=*), intent(in) :: mminlu, mminsl + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg + + integer :: lumatch, iindex, lc, num_slope, iunit_noah + integer :: ierr + integer , parameter :: open_ok = 0 + logical :: opened + + character*128 :: mess , message + character*256 :: a_string + integer , parameter :: loop_max = 10 + integer :: loop_count, i + +!-----SPECIFY VEGETATION RELATED CHARACTERISTICS : +! ALBBCK: SFC albedo (in percentage) +! Z0: Roughness length (m) +! SHDFAC: Green vegetation fraction (in percentage) +! Note: The ALBEDO, Z0, and SHDFAC values read from the following table +! ALBEDO, amd Z0 are specified in LAND-USE TABLE; and SHDFAC is +! the monthly green vegetation data +! CMXTBL: MAX CNPY Capacity (m) +! NROTBL: Rooting depth (layer) +! RSMIN: Mimimum stomatal resistance (s m-1) +! RSMAX: Max. stomatal resistance (s m-1) +! RGL: Parameters used in radiation stress function +! HS: Parameter used in vapor pressure deficit functio +! TOPT: Optimum transpiration air temperature. (K) +! CMCMAX: Maximum canopy water capacity +! CFACTR: Parameter used in the canopy inteception calculati +! SNUP: Threshold snow depth (in water equivalent m) that +! implies 100% snow cover +! LAI: Leaf area index (dimensionless) +! MAXALB: Upper bound on maximum albedo over deep snow +! +!-----READ IN VEGETAION PROPERTIES FROM VEGPARM.TBL +! + iunit_noah = -1 + do i = 20,99 + inquire ( i , opened = opened ) + if ( .not. opened ) then + iunit_noah = i + exit + endif + enddo + + if ( iunit_noah < 0 ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: '// & + 'can not find unused fortran unit to read.' + return + endif + + open(iunit_noah, file='VEGPARM.TBL',form='formatted',status='old',iostat=ierr) + if(ierr .ne. open_ok ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: failure opening VEGPARM.TBL' + return + end if + + lumatch=0 + + loop_count = 0 + read (iunit_noah,fmt='(a)',end=2002) a_string + find_lutype : do while (lumatch == 0) + read (iunit_noah,*,end=2002)lutype + read (iunit_noah,*)lucats,iindex + if(lutype.eq.mminlu)then + !write( mess , * ) 'landuse type = ' // trim ( lutype ) // ' found', lucats,' categories' + !call wrf_message( mess ) + lumatch=1 + else + loop_count = loop_count+1 + !call wrf_message ( "skipping over lutype = " // trim ( lutype ) ) + find_vegetation_parameter_flag : do + read (iunit_noah,fmt='(a)', end=2002) a_string + if ( a_string(1:21) .eq. 'Vegetation Parameters' ) then + exit find_vegetation_parameter_flag + else if ( loop_count .ge. loop_max ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: too many loops in VEGPARM.TBL' + return + endif + enddo find_vegetation_parameter_flag + endif + enddo find_lutype + +! prevent possible array overwrite, Bill Bovermann, IBM, May 6, 2008 + if ( size(shdtbl) < lucats .or. & + size(nrotbl) < lucats .or. & + size(rstbl) < lucats .or. & + size(rgltbl) < lucats .or. & + size(hstbl) < lucats .or. & + size(snuptbl) < lucats .or. & + size(maxalb) < lucats .or. & + size(laimintbl) < lucats .or. & + size(laimaxtbl) < lucats .or. & + size(z0mintbl) < lucats .or. & + size(z0maxtbl) < lucats .or. & + size(albedomintbl) < lucats .or. & + size(albedomaxtbl) < lucats .or. & + size(ztopvtbl) < lucats .or. & + size(zbotvtbl) < lucats .or. & + size(emissmintbl ) < lucats .or. & + size(emissmaxtbl ) < lucats ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: table sizes too small for value of lucats' + return + endif + + if(lutype.eq.mminlu)then + do lc=1,lucats + read (iunit_noah,*)iindex,shdtbl(lc), & + nrotbl(lc),rstbl(lc),rgltbl(lc),hstbl(lc), & + snuptbl(lc),maxalb(lc), laimintbl(lc), & + laimaxtbl(lc),emissmintbl(lc), & + emissmaxtbl(lc), albedomintbl(lc), & + albedomaxtbl(lc), z0mintbl(lc), z0maxtbl(lc),& + ztopvtbl(lc), zbotvtbl(lc) + enddo + + read (iunit_noah,*) + read (iunit_noah,*)topt_data + read (iunit_noah,*) + read (iunit_noah,*)cmcmax_data + read (iunit_noah,*) + read (iunit_noah,*)cfactr_data + read (iunit_noah,*) + read (iunit_noah,*)rsmax_data + read (iunit_noah,*) + read (iunit_noah,*)bare + read (iunit_noah,*) + read (iunit_noah,*)natural + read (iunit_noah,*) + read (iunit_noah,*) + read (iunit_noah,fmt='(a)') a_string + if ( a_string(1:21) .eq. 'Vegetation Parameters' ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: expected low and high density residential, and high density industrial information in VEGPARM.TBL' + return + endif + read (iunit_noah,*)low_density_residential + read (iunit_noah,*) + read (iunit_noah,*)high_density_residential + read (iunit_noah,*) + read (iunit_noah,*)high_intensity_industrial + endif + +2002 continue + + close (iunit_noah) + if (lumatch == 0) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: land use dataset '//mminlu//' not found in VEGPARM.TBL.' + return + endif + + + !CALL wrf_dm_bcast_string ( LUTYPE , 4 ) + !CALL wrf_dm_bcast_integer ( LUCATS , 1 ) + !CALL wrf_dm_bcast_integer ( IINDEX , 1 ) + !CALL wrf_dm_bcast_integer ( LUMATCH , 1 ) + !CALL wrf_dm_bcast_real ( SHDTBL , NLUS ) + !CALL wrf_dm_bcast_real ( NROTBL , NLUS ) + !CALL wrf_dm_bcast_real ( RSTBL , NLUS ) + !CALL wrf_dm_bcast_real ( RGLTBL , NLUS ) + !CALL wrf_dm_bcast_real ( HSTBL , NLUS ) + !CALL wrf_dm_bcast_real ( SNUPTBL , NLUS ) + !CALL wrf_dm_bcast_real ( LAIMINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( LAIMAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( Z0MINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( Z0MAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( EMISSMINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( EMISSMAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ALBEDOMINTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ALBEDOMAXTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ZTOPVTBL , NLUS ) + !CALL wrf_dm_bcast_real ( ZBOTVTBL , NLUS ) + !CALL wrf_dm_bcast_real ( MAXALB , NLUS ) + !CALL wrf_dm_bcast_real ( TOPT_DATA , 1 ) + !CALL wrf_dm_bcast_real ( CMCMAX_DATA , 1 ) + !CALL wrf_dm_bcast_real ( CFACTR_DATA , 1 ) + !CALL wrf_dm_bcast_real ( RSMAX_DATA , 1 ) + !CALL wrf_dm_bcast_integer ( BARE , 1 ) + !CALL wrf_dm_bcast_integer ( NATURAL , 1 ) + !CALL wrf_dm_bcast_integer ( LOW_DENSITY_RESIDENTIAL , 1 ) + !CALL wrf_dm_bcast_integer ( HIGH_DENSITY_RESIDENTIAL , 1 ) + !CALL wrf_dm_bcast_integer ( HIGH_INTENSITY_INDUSTRIAL , 1 ) + +! +!-----READ IN SOIL PROPERTIES FROM SOILPARM.TBL +! + + open(iunit_noah, file='SOILPARM.TBL',form='formatted',status='old',iostat=ierr) + if(ierr .ne. open_ok ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: failure opening SOILPARM.TBL' + return + end if + + !write(mess,*) 'input soil texture classification = ', trim ( mminsl ) + !call wrf_message( mess ) + + lumatch=0 + + read (iunit_noah,*) + read (iunit_noah,2000,end=2003)sltype +2000 format (a4) + read (iunit_noah,*)slcats,iindex + if(sltype.eq.mminsl)then + !write( mess , * ) 'soil texture classification = ', trim ( sltype ) , ' found', & + ! slcats,' categories' + !call wrf_message ( mess ) + lumatch=1 + endif +! prevent possible array overwrite, bill bovermann, ibm, may 6, 2008 + if ( size(bb ) < slcats .or. & + size(drysmc) < slcats .or. & + size(f11 ) < slcats .or. & + size(maxsmc) < slcats .or. & + size(refsmc) < slcats .or. & + size(satpsi) < slcats .or. & + size(satdk ) < slcats .or. & + size(satdw ) < slcats .or. & + size(wltsmc) < slcats .or. & + size(qtz ) < slcats ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: table sizes too small for value of slcats' + return + endif + if(sltype.eq.mminsl)then + do lc=1,slcats + read (iunit_noah,*) iindex,bb(lc),drysmc(lc),f11(lc),maxsmc(lc),& + refsmc(lc),satpsi(lc),satdk(lc), satdw(lc), & + wltsmc(lc), qtz(lc) + enddo + endif + +2003 continue + + close (iunit_noah) + + + ! CALL wrf_dm_bcast_integer ( LUMATCH , 1 ) + ! CALL wrf_dm_bcast_string ( SLTYPE , 4 ) + ! CALL wrf_dm_bcast_string ( MMINSL , 4 ) ! since this is reset above, see oct2 ^ + ! CALL wrf_dm_bcast_integer ( SLCATS , 1 ) + ! CALL wrf_dm_bcast_integer ( IINDEX , 1 ) + ! CALL wrf_dm_bcast_real ( BB , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( DRYSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( F11 , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( MAXSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( REFSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( SATPSI , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( SATDK , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( SATDW , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( WLTSMC , NSLTYPE ) + ! CALL wrf_dm_bcast_real ( QTZ , NSLTYPE ) + + if(lumatch.eq.0)then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: soil texture dataset '//mminsl//' not found in SOILPARM.TBL.' + return + endif + +! +!-----READ IN GENERAL PARAMETERS FROM GENPARM.TBL +! + + open(iunit_noah, file='GENPARM.TBL',form='formatted',status='old',iostat=ierr) + if(ierr .ne. open_ok ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: failure opening GENPARM.TBL' + return + end if + + read (iunit_noah,*) + read (iunit_noah,*) + read (iunit_noah,*) num_slope + + slpcats=num_slope +! prevent possible array overwrite, bill bovermann, ibm, may 6, 2008 + if ( size(slope_data) < num_slope ) then + errflg = 1 + errmsg = 'sfc_noah_wrfv4_interstitial: set_soil_veg_parm: num_slope too large for slope_data array' + return + endif + + do lc=1,slpcats + read (iunit_noah,*)slope_data(lc) + enddo + + read (iunit_noah,*) + read (iunit_noah,*)sbeta_data + read (iunit_noah,*) + read (iunit_noah,*)fxexp_data + read (iunit_noah,*) + read (iunit_noah,*)csoil_data + read (iunit_noah,*) + read (iunit_noah,*)salp_data + read (iunit_noah,*) + read (iunit_noah,*)refdk_data + read (iunit_noah,*) + read (iunit_noah,*)refkdt_data + read (iunit_noah,*) + read (iunit_noah,*)frzk_data + read (iunit_noah,*) + read (iunit_noah,*)zbot_data + read (iunit_noah,*) + read (iunit_noah,*)czil_data + read (iunit_noah,*) + read (iunit_noah,*)smlow_data + read (iunit_noah,*) + read (iunit_noah,*)smhigh_data + read (iunit_noah,*) + read (iunit_noah,*)lvcoef_data + close (iunit_noah) + + + ! call wrf_dm_bcast_integer ( num_slope , 1 ) + ! call wrf_dm_bcast_integer ( slpcats , 1 ) + ! call wrf_dm_bcast_real ( slope_data , nslope ) + ! call wrf_dm_bcast_real ( sbeta_data , 1 ) + ! call wrf_dm_bcast_real ( fxexp_data , 1 ) + ! call wrf_dm_bcast_real ( csoil_data , 1 ) + ! call wrf_dm_bcast_real ( salp_data , 1 ) + ! call wrf_dm_bcast_real ( refdk_data , 1 ) + ! call wrf_dm_bcast_real ( refkdt_data , 1 ) + ! call wrf_dm_bcast_real ( frzk_data , 1 ) + ! call wrf_dm_bcast_real ( zbot_data , 1 ) + ! call wrf_dm_bcast_real ( czil_data , 1 ) + ! call wrf_dm_bcast_real ( smlow_data , 1 ) + ! call wrf_dm_bcast_real ( smhigh_data , 1 ) + ! call wrf_dm_bcast_real ( lvcoef_data , 1 ) + + end subroutine soil_veg_gen_parm +!----------------------------- +!> @} + + end module sfc_noah_wrfv4_pre + + module sfc_noah_wrfv4_post + + implicit none + + private + + public :: sfc_noah_wrfv4_post_init, sfc_noah_wrfv4_post_run, sfc_noah_wrfv4_post_finalize + + contains + + subroutine sfc_noah_wrfv4_post_init () + end subroutine sfc_noah_wrfv4_post_init + + subroutine sfc_noah_wrfv4_post_finalize () + end subroutine sfc_noah_wrfv4_post_finalize + +!! \section arg_table_sfc_noah_wrfv4_post_run Argument Table +!! \htmlinclude sfc_noah_wrfv4_post_run.html +!! + subroutine sfc_noah_wrfv4_post_run (im, nsoil, land, flag_guess, flag_lsm, & + rhowater, cp, hvap, cmc, rho1, sheat, eta, flx1, flx2, flx3, sncovr, runoff1,& + runoff2, soilm, snowhk, weasd_save, snwdph_save, tsfc_save, tsurf, & + canopy_save, smc_save, stc_save, slc_save, smcmax, canopy, shflx, & + lhflx, snohf, snowc, runoff, drain, stm, weasd, snwdph, tsfc, smc, stc,& + slc, wet1, errmsg, errflg) + + use machine, only : kind_phys + + implicit none + + integer, intent(in) :: im, nsoil + logical, dimension(im), intent(in) :: land, flag_guess, flag_lsm + real(kind=kind_phys), intent(in) :: rhowater, cp, hvap + real(kind=kind_phys), dimension(im), intent(in) :: cmc, rho1, sheat, eta, & + flx1, flx2, flx3, sncovr, runoff1, runoff2, soilm, snowhk + real(kind=kind_phys), dimension(im), intent(in) :: weasd_save, snwdph_save, tsfc_save, tsurf, canopy_save, smcmax + real(kind=kind_phys), dimension(im,nsoil), intent(in) :: smc_save, stc_save, slc_save + + real(kind=kind_phys), dimension(im), intent(inout) :: canopy, shflx, lhflx, & + snohf, snowc, runoff, drain, stm, wet1 + real(kind=kind_phys), dimension(im), intent(inout) :: weasd, snwdph, tsfc + real(kind=kind_phys), dimension(im, nsoil), intent(inout) :: smc, stc, slc + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !local variables + integer :: i, k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1, im + if (flag_lsm(i)) then + canopy(i) = cmc(i)*rhowater + snwdph(i) = 1000.0*snowhk(i) + + shflx(i) = sheat(i) / (cp*rho1(i)) + lhflx(i) = eta(i) / (hvap*rho1(i)) + + !aggregating several outputs into one like GFS sfc_drv.F + snohf(i) = flx1(i) + flx2(i) + flx3(i) + + snowc(i) = sncovr(i) !GJF: redundant? + + !convert from m s-1 to kg m-2 s-1 by multiplying by rhowater + runoff(i) = runoff1(i) * rhowater + drain(i) = runoff2(i) * rhowater + + stm(i) = soilm(i) * rhowater + + wet1(i) = smc(i,1) / smcmax(i) !Sarah Lu added 09/09/2010 (for GOCART) + end if + end do + + do i=1, im + if (land(i)) then + if (flag_guess(i)) then + weasd(i) = weasd_save(i) + snwdph(i) = snwdph_save(i) + tsfc(i) = tsfc_save(i) + canopy(i) = canopy_save(i) + + do k=1,nsoil + smc(i,k) = smc_save(i,k) + stc(i,k) = stc_save(i,k) + slc(i,k) = slc_save(i,k) + end do + + else + tsfc(i) = tsurf(i) + end if + end if + end do + + end subroutine sfc_noah_wrfv4_post_run + + end module sfc_noah_wrfv4_post diff --git a/physics/sfc_noah_wrfv4_interstitial.meta b/physics/sfc_noah_wrfv4_interstitial.meta new file mode 100644 index 000000000..e993780fd --- /dev/null +++ b/physics/sfc_noah_wrfv4_interstitial.meta @@ -0,0 +1,1098 @@ +[ccpp-arg-table] + name = sfc_noah_wrfv4_pre_init + type = scheme +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noah_wrfv4] + standard_name = flag_for_noah_wrfv4_land_surface_scheme + long_name = flag for NOAH WRFv4 land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[veg_data_choice] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[soil_data_choice] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[isurban] + standard_name = urban_vegetation_category + long_name = index of the urban vegetation category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = inout + optional = F +[isice] + standard_name = ice_vegetation_category + long_name = index of the permanent snow/ice category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = inout + optional = F +[iswater] + standard_name = water_vegetation_category + long_name = index of the water body vegetation category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_wrfv4_pre_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_wrfv4_pre_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isice] + standard_name = ice_vegetation_category + long_name = index of the permanent snow/ice category in the chosen vegetation dataset + units = index + dimensions = () + type = integer + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F +[first_time_step] + standard_name = flag_for_first_time_step + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_lsm] + standard_name = flag_for_calling_land_surface_model + long_name = flag for calling land surface model + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout + optional = F +[flag_lsm_glacier] + standard_name = flag_for_calling_land_surface_model_glacier + long_name = flag for calling land surface model over glacier + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout + optional = F +[dt] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rhowater] + standard_name = liquid_water_density + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sfcprs] + standard_name = air_pressure_at_lowest_model_layer + long_name = Model layer 1 mean pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tprcp] + standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land + long_name = total precipitation amount in each time step over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfctmp] + standard_name = air_temperature_at_lowest_model_layer + long_name = 1st model layer air temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = 1st model layer specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[prcp] + standard_name = total_precipitation_rate_on_dynamics_timestep_over_land + long_name = total precipitation rate in each time step over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[q2k] + standard_name = bounded_specific_humidity_at_lowest_model_layer_over_land + long_name = specific humidity at lowest model layer over land bounded between a nonzero epsilon and saturation + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[rho1] + standard_name = air_density_at_lowest_model_layer + long_name = air density at lowest model layer + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[qs1] + standard_name = saturation_specific_humidity_at_lowest_model_layer + long_name = saturation specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[th1] + standard_name = potential_temperature_at_lowest_model_layer + long_name = potential_temperature_at_lowest_model_layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[dqsdt2] + standard_name = saturation_specific_humidity_slope + long_name = saturation specific humidity slope at lowest model layer + units = K-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cmc] + standard_name = canopy_water_amount_in_m + long_name = canopy water amount in m + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snowhk] + standard_name = actual_snow_depth + long_name = actual snow depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[chk] + standard_name = surface_conductance_for_heat_and_moisture_in_air_over_land + long_name = surface conductance for heat & moisture over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd_save] + standard_name = water_equivalent_accumulated_snow_depth_over_land_save + long_name = water equiv of acc snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph_save] + standard_name = surface_snow_thickness_water_equivalent_over_land_save + long_name = water equivalent snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_save] + standard_name = surface_skin_temperature_over_land_interstitial_save + long_name = surface skin temperature over land before entering a physics scheme (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy_save] + standard_name = canopy_water_amount_save + long_name = canopy water amount before entering a physics scheme + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smc_save] + standard_name = volume_fraction_of_soil_moisture_save + long_name = total soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc_save] + standard_name = soil_temperature_save + long_name = soil temperature before entering a physics scheme + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc_save] + standard_name = volume_fraction_of_unfrozen_soil_moisture_save + long_name = liquid soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ep] + standard_name = surface_upward_potential_latent_heat_flux_over_land + long_name = surface upward potential latent heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux] + standard_name = upward_heat_flux_in_soil_over_land + long_name = soil heat flux over land + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[evbs] + standard_name = soil_upward_latent_heat_flux + long_name = soil upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[evcw] + standard_name = canopy_upward_latent_heat_flux + long_name = canopy upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[trans] + standard_name = transpiration_flux + long_name = total plant transpiration rate + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sthick] + standard_name = soil_layer_thickness + long_name = soil layer thickness + units = m + dimensions = (soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = sfc_noah_wrfv4_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsoil] + standard_name = soil_vertical_dimension + long_name = soil vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[flag_lsm] + standard_name = flag_for_calling_land_surface_model + long_name = flag for calling land surface model + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in + optional = F +[rhowater] + standard_name = liquid_water_density + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cmc] + standard_name = canopy_water_amount_in_m + long_name = canopy water amount in m + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[rho1] + standard_name = air_density_at_lowest_model_layer + long_name = air density at lowest model layer + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sheat] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[eta] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[flx1] + standard_name = latent_heat_flux_from_precipitating_snow + long_name = latent heat flux due to precipitating snow + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[flx2] + standard_name = latent_heat_flux_from_freezing_rain + long_name = latent heat flux due to freezing rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[flx3] + standard_name = latent_heat_flux_due_to_snowmelt + long_name = latent heat flux due to snowmelt phase change + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[runoff1] + standard_name = surface_runoff_flux_in_m_sm1 + long_name = surface runoff flux in m s-1 + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[runoff2] + standard_name = subsurface_runoff_flux_in_m_sm1 + long_name = subsurface runoff flux in m s-1 + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[soilm] + standard_name = soil_moisture_content_in_m + long_name = soil moisture in meters + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snowhk] + standard_name = actual_snow_depth + long_name = actual snow depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[weasd_save] + standard_name = water_equivalent_accumulated_snow_depth_over_land_save + long_name = water equiv of acc snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snwdph_save] + standard_name = surface_snow_thickness_water_equivalent_over_land_save + long_name = water equivalent snow depth over land before entering a physics scheme + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc_save] + standard_name = surface_skin_temperature_over_land_interstitial_save + long_name = surface skin temperature over land before entering a physics scheme (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_land + long_name = surface skin temperature after iteration over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[canopy_save] + standard_name = canopy_water_amount_save + long_name = canopy water amount before entering a physics scheme + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[smc_save] + standard_name = volume_fraction_of_soil_moisture_save + long_name = total soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stc_save] + standard_name = soil_temperature_save + long_name = soil temperature before entering a physics scheme + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slc_save] + standard_name = volume_fraction_of_unfrozen_soil_moisture_save + long_name = liquid soil moisture before entering a physics scheme + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[smcmax] + standard_name = soil_porosity + long_name = volumetric soil porosity + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy moisture content + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[shflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_land + long_name = kinematic surface upward sensible heat flux over land + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[lhflx] + standard_name = kinematic_surface_upward_latent_heat_flux_over_land + long_name = kinematic surface upward latent heat flux over land + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snohf] + standard_name = snow_freezing_rain_upward_latent_heat_flux + long_name = latent heat flux due to snow and frz rain + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snowc] + standard_name = surface_snow_area_fraction + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[runoff] + standard_name = surface_runoff_flux + long_name = surface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stm] + standard_name = soil_moisture_content + long_name = soil moisture + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_land + long_name = water equiv of acc snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc] + standard_name = surface_skin_temperature_over_land_interstitial + long_name = surface skin temperature over land (temporary use as interstitial) + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = volumetric fraction of soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wet1] + standard_name = normalized_soil_wetness + long_name = normalized soil wetness + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index 5ddd5aefc..934d4797c 100644 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -39,6 +39,19 @@ subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, errmsg, & errmsg = '' errflg = 0 + if (ivegsrc /= 1) then + errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// + & 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot /= 1) then + errmsg = 'The NOAHMP LSM expects that the isot physics '// + & 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit) From d9c5e06bddb2ad529f169b34248a6054a46abf26 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 15 May 2020 14:46:12 -0600 Subject: [PATCH 028/274] Update GFS_rrtmgp_pre.F90 with progcld changes, update GFS_rrtmgp_setup.meta with standard name changes --- physics/GFS_rrtmgp_pre.F90 | 44 ++++++++++++++++++++++++++++++++--- physics/GFS_rrtmgp_setup.meta | 16 ++++++------- 2 files changed, 49 insertions(+), 11 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 1344f269c..0835f9e9b 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -37,7 +37,8 @@ module GFS_rrtmgp_pre progcld1, & ! Zhao/Moorthi's prognostic cloud scheme progcld3, & ! Zhao/Moorthi's prognostic cloud+pdfcld progcld4, & ! GFDL cloud scheme - progcld5, & ! Thompson / WSM6 cloud micrphysics scheme + progcld5, & ! Ferrier Aligo microphysics scheme + progcld6, & ! Thompson cloud microphysics scheme progclduni ! Unified cloud-scheme use surface_perturbation, only: & cdfnor ! Routine to compute CDF (used to compute percentiles) @@ -740,10 +741,47 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) de_lgth) ! OUT - clouds decorrelation length (km) endif - ! *) Thompson / WSM6 cloud micrphysics scheme - elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then + ! *) Ferrier-Aligo cloud microphysics scheme + elseif(Model%imp_physics == 15) then call progcld5 ( & ! IN + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + tracer, & ! IN - Cloud condensate amount in layer by type () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + Model%ntrac-1, & ! IN - Number of tracers + Model%ntcw-1, & ! IN - Tracer index for cloud condensate (or liquid water) + Model%ntiw-1, & ! IN - Tracer index for ice + Model%ntrw-1, & ! IN - Tracer index for rain + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + Model%icloud, & ! IN - cloud effect to the optical depth and cloud fraction in radiation + Model%uni_cld, & ! IN - True for cloud fraction from shoc + Model%lmfshal, & ! IN - True for mass flux shallow convection + Model%lmfdeep2, & ! IN - True for mass flux deep convection + cldcov(:,1:Model%levs), & ! IN - Layer cloud fraction (used if uni_cld=.true.) + Tbd%phy_f3d(:,:,1), & ! IN - Liquid-water effective radius (microns) + Tbd%phy_f3d(:,:,2), & ! IN - Ice-water effective radius (microns) + Tbd%phy_f3d(:,:,3), & ! IN - LSnow-water effective radius (microns) + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + ! *) Thompson cloud microphysics scheme + elseif(Model%imp_physics == 8) then + + call progcld6 ( & ! IN p_lay/100., & ! IN - Pressure at model layer centers (mb) p_lev/100., & ! IN - Pressure at model interfaces (mb) t_lay, & ! IN - Temperature at layer centers (K) diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index e40ad865a..e419c7252 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -99,32 +99,32 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation - long_name = sw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation + long_name = control flag for cloud overlapping method for SW units = flag dimensions = () type = integer intent = in optional = F [iovr_lw] - standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation - long_name = lw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation + long_name = control flag for cloud overlapping method for LW units = flag dimensions = () type = integer intent = in optional = F [isubc_sw] - standard_name = flag_for_sw_clouds_without_sub_grid_approximation - long_name = flag for sw clouds without sub-grid approximation + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation units = flag dimensions = () type = integer intent = in optional = F [isubc_lw] - standard_name = flag_for_lw_clouds_without_sub_grid_approximation - long_name = flag for lw clouds without sub-grid approximation + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation units = flag dimensions = () type = integer From b850fe7c98d9c195f62fd0887907685c120549c3 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 18 May 2020 21:26:32 -0600 Subject: [PATCH 029/274] add limits to fh, fh2 --- physics/gfdl_sfc_layer.F90 | 124 ++++++++++++++++++++++++++----------- 1 file changed, 87 insertions(+), 37 deletions(-) diff --git a/physics/gfdl_sfc_layer.F90 b/physics/gfdl_sfc_layer.F90 index edd3f0c30..1b29c166c 100644 --- a/physics/gfdl_sfc_layer.F90 +++ b/physics/gfdl_sfc_layer.F90 @@ -154,6 +154,8 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & integer :: i, its, ite, ims, ime + logical :: ch_bound_excursion + !GJF: the vonKarman constant should come in through the CCPP and be defined by the host model real (kind=kind_phys), parameter :: karman = 0.4 real (kind=kind_phys), parameter :: log01=log(0.01), log05=log(0.05), & @@ -180,7 +182,8 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & xxfh2, tzot real(kind=kind_phys), dimension(1:30) :: maxsmc, drysmc real(kind=kind_phys) :: smcmax, smcdry, zhalf, cd10, & - esat, fm_lnd_old, fh_lnd_old, tem1, tem2, czilc, cdlimit + esat, fm_lnd_old, fh_lnd_old, tem1, tem2, czilc, cd_low_limit, & + cd_high_limit, ch_low_limit, ch_high_limit !#### This block will become unnecessary when maxsmc and drysmc come through the CCPP #### if (lsm == lsm_noah) then @@ -273,8 +276,13 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & zkmax(i) = z1(i) z1_cm(i) = 100.0*z1(i) - !GJF: this drag coefficient lower limit was suggested by Chunxi Zhang via his module_sf_sfclayrev.f90 - cdlimit = 1.0e-5/zkmax(i) + !GJF: these drag coefficient limits were suggested by Chunxi Zhang via his module_sf_sfclayrev.f90 + cd_low_limit = 1.0e-5/zkmax(i) + cd_high_limit = 0.1 + !GJF: use the lower of 0.1 from Chunxi Zhang or 0.05/wspd from WRF's module_sf_gfdl.F + ! (this will always be the latter if wspd has a minimum of 1.0 m s-1 from above) + ch_low_limit = cd_low_limit + ch_high_limit = min(0.1,0.05/wspd(i)) !slwdc... GFDL downward net flux in units of cal/(cm**2/min) !also divide by 10**4 to convert from /m**2 to /cm**2 @@ -396,23 +404,37 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling + cdm_lnd(i) = max(cdm_lnd(i), cd_low_limit) + cdm_lnd(i) = min(cdm_lnd(i), cd_high_limit) fm_lnd(i) = karman/sqrt(cdm_lnd(i)) + + !1) try fh_lnd from MFLUX2 fh_lnd(i) = karman*xxfh(i) - !GJF: Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih - !psim_lnd(i)=gz1oz0(i)-fm_lnd(i) - !psih_lnd(i)=gz1oz0(i)-fh_lnd(i) + !2) calc ch_lnd from fm_lnd and fh_lnd + ch_lnd(i) = karman*karman/(fm_lnd(i) * fh_lnd(i)) + !3) check if ch_lnd is out of bounds (if so, recalculate fh_lnd from bounded value) + ch_bound_excursion = .false. + if (ch_lnd(i) < ch_low_limit) then + ch_bound_excursion = .true. + ch_lnd(i) = ch_low_limit + else if (ch_lnd(i) > ch_high_limit) then + ch_bound_excursion = .true. + ch_lnd(i) = ch_high_limit + end if + + if (ch_bound_excursion) then + fh_lnd(i) = karman*karman/(fm_lnd(i)*ch_lnd(i)) + end if + + !4) try fh2_lnd, limit to be less than or equal to constant*fh_lnd? fh2_lnd(i) = karman*xxfh2(i) - ch_lnd(i) = karman*karman/(fm_lnd(i) * fh_lnd(i)) + fh2_lnd(i) = min(fh2_lnd(i), fh_lnd(i)) !fh2_lnd > fh_lnd leads to bad values in sfc_diag.f - !GJF: these bounds on drag coefficients are from Chunxi Zhang's module_sf_sfclayrev.f90 - cdm_lnd(i) = max(cdm_lnd(i), cdlimit) - cdm_lnd(i) = min(cdm_lnd(i), 0.1) - ch_lnd(i) = max(ch_lnd(i), cdlimit) - ch_lnd(i) = min(ch_lnd(i), 0.1) - !GJF: this bound is from WRF's module_sf_gfdl.F (I'm not sure if both are needed or which is more restrictive.) - ch_lnd(i) = min(ch_lnd(i), 0.05/wspd(i)) + !GJF: Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih + !psim_lnd(i)=gz1oz0(i)-fm_lnd(i) + !psih_lnd(i)=gz1oz0(i)-fh_lnd(i) !GJF: from WRF's module_sf_gfdl.F ustar_lnd(i) = 0.01*sqrt(cdm_lnd(i)* & @@ -532,23 +554,37 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling + cdm_ice(i) = max(cdm_ice(i), cd_low_limit) + cdm_ice(i) = min(cdm_ice(i), cd_high_limit) fm_ice(i) = karman/sqrt(cdm_ice(i)) + + !1) try fh_ice from MFLUX2 fh_ice(i) = karman*xxfh(i) - !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih - !psim_ice(i)=gz1oz0(i)-fm_ice(i) - !psih_ice(i)=gz1oz0(i)-fh_ice(i) + !2) calc ch_ice from fm_ice and fh_ice + ch_ice(i) = karman*karman/(fm_ice(i) * fh_ice(i)) + + !3) check if ch_ice is out of bounds (if so, recalculate fh_ice from bounded value) + ch_bound_excursion = .false. + if (ch_ice(i) < ch_low_limit) then + ch_bound_excursion = .true. + ch_ice(i) = ch_low_limit + else if (ch_ice(i) > ch_high_limit) then + ch_bound_excursion = .true. + ch_ice(i) = ch_high_limit + end if + if (ch_bound_excursion) then + fh_ice(i) = karman*karman/(fm_ice(i)*ch_ice(i)) + end if + + !4) try fh2_ice, limit to be less than or equal to constant*fh_ice? fh2_ice(i) = karman*xxfh2(i) - ch_ice(i) = karman*karman/(fm_ice(i) * fh_ice(i)) + fh2_ice(i) = min(fh2_ice(i), fh_ice(i)) !fh2_ice > fh_ice leads to bad values in sfc_diag.f - !GJF: these bounds on drag coefficients are from Chunxi Zhang's module_sf_sfclayrev.f90 - cdm_ice(i) = max(cdm_ice(i), cdlimit) - cdm_ice(i) = min(cdm_ice(i), 0.1) - ch_ice(i) = max(ch_ice(i), cdlimit) - ch_ice(i) = min(ch_ice(i), 0.1) - !GJF: this bound is from WRF's module_sf_gfdl.F (I'm not sure if both are needed or which is more restrictive.) - ch_ice(i) = min(ch_ice(i), 0.05/wspd(i)) + !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih + !psim_ice(i)=gz1oz0(i)-fm_ice(i) + !psih_ice(i)=gz1oz0(i)-fh_ice(i) ustar_ice(i) = 0.01*sqrt(cdm_ice(i)* & (upc(i)*upc(i) + vpc(i)*vpc(i))) @@ -627,24 +663,38 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & !gz1oz0(i) = alog(zkmax(i)/znt_ocn(i)) !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling - + + cdm_ocn(i) = max(cdm_ocn(i), cd_low_limit) + cdm_ocn(i) = min(cdm_ocn(i), cd_high_limit) fm_ocn(i) = karman/sqrt(cdm_ocn(i)) + + !1) try fh_ocn from MFLUX2 fh_ocn(i) = karman*xxfh(i) - !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih - !psim_ocn(i)=gz1oz0(i)-fm_ocn(i) - !psih_ocn(i)=gz1oz0(i)-fh_ocn(i) + !2) calc ch_ocn from fm_ocn and fh_ocn + ch_ocn(i) = karman*karman/(fm_ocn(i) * fh_ocn(i)) + + !3) check if ch_lnd is out of bounds (if so, recalculate fh_lnd from bounded value) + ch_bound_excursion = .false. + if (ch_ocn(i) < ch_low_limit) then + ch_bound_excursion = .true. + ch_ocn(i) = ch_low_limit + else if (ch_ocn(i) > ch_high_limit) then + ch_bound_excursion = .true. + ch_ocn(i) = ch_high_limit + end if + + if (ch_bound_excursion) then + fh_ocn(i) = karman*karman/(fm_ocn(i)*ch_ocn(i)) + end if + !4) try fh2_ocn, limit to be less than or equal to constant*fh_ocn? fh2_ocn(i) = karman*xxfh2(i) - ch_ocn(i) = karman*karman/(fm_ocn(i) * fh_ocn(i)) + fh2_ocn(i) = min(fh2_ocn(i), fh_ocn(i)) !fh2_ocn > fh_ocn leads to bad values in sfc_diag.F - !GJF: these bounds on drag coefficients are from Chunxi Zhang's module_sf_sfclayrev.f90 - cdm_ocn(i) = max(cdm_ocn(i), cdlimit) - cdm_ocn(i) = min(cdm_ocn(i), 0.1) - ch_ocn(i) = max(ch_ocn(i), cdlimit) - ch_ocn(i) = min(ch_ocn(i), 0.1) - !GJF: this bound is from WRF's module_sf_gfdl.F (I'm not sure if both are needed or which is more restrictive.) - ch_ocn(i) = min(ch_ocn(i), 0.05/wspd(i)) + !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih + !psim_ocn(i)=gz1oz0(i)-fm_ocn(i) + !psih_ocn(i)=gz1oz0(i)-fh_ocn(i) ustar_ocn(i) = 0.01*sqrt(cdm_ocn(i)* & (upc(i)*upc(i) + vpc(i)*vpc(i))) From 6d3ce4f8ec86d90a25747f6fbc150caa96427e6e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 19 May 2020 16:06:19 -0600 Subject: [PATCH 030/274] use precalculated wind speed with convective gustiness component in gfdl_sfc_layer instead of recalculating --- physics/gfdl_sfc_layer.F90 | 35 +++++++++++++---------------------- physics/gfdl_sfc_layer.meta | 9 +++++++++ 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/physics/gfdl_sfc_layer.F90 b/physics/gfdl_sfc_layer.F90 index 1b29c166c..3f4426613 100644 --- a/physics/gfdl_sfc_layer.F90 +++ b/physics/gfdl_sfc_layer.F90 @@ -103,13 +103,13 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & lsm_noah, lsm_noahmp, lsm_ruc, lsm_noah_wrfv4, icoef_sf, cplwav, & cplwav2atm, lcurr_sf, pert_Cd, ntsflg, sfenth, z1, shdmax, ivegsrc, & vegtype, sigmaf, dt, wet, dry, icy, isltyp, rd, grav, ep1, ep2, smois, & - psfc, prsl1, q1, t1, u1, v1, u10, v10, gsw, glw, tsurf_ocn, tsurf_lnd, & - tsurf_ice, tskin_ocn, tskin_lnd, tskin_ice, ustar_ocn, ustar_lnd, & - ustar_ice, znt_ocn, znt_lnd, znt_ice, cdm_ocn, cdm_lnd, cdm_ice, & - stress_ocn, stress_lnd, stress_ice, rib_ocn, rib_lnd, rib_ice, fm_ocn, & - fm_lnd, fm_ice, fh_ocn, fh_lnd, fh_ice, fh2_ocn, fh2_lnd, fh2_ice, & - ch_ocn, ch_lnd, ch_ice, fm10_ocn, fm10_lnd, fm10_ice, qss_ocn, qss_lnd, & - qss_ice, errmsg, errflg) + psfc, prsl1, q1, t1, u1, v1, wspd, u10, v10, gsw, glw, tsurf_ocn, & + tsurf_lnd, tsurf_ice, tskin_ocn, tskin_lnd, tskin_ice, ustar_ocn, & + ustar_lnd, ustar_ice, znt_ocn, znt_lnd, znt_ice, cdm_ocn, cdm_lnd, & + cdm_ice, stress_ocn, stress_lnd, stress_ice, rib_ocn, rib_lnd, rib_ice, & + fm_ocn, fm_lnd, fm_ice, fh_ocn, fh_lnd, fh_ice, fh2_ocn, fh2_lnd, & + fh2_ice, ch_ocn, ch_lnd, ch_ice, fm10_ocn, fm10_lnd, fm10_ice, qss_ocn, & + qss_lnd, qss_ice, errmsg, errflg) use funcphys, only: fpvs @@ -136,8 +136,8 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & real(kind=kind_phys), intent(in) :: rd,grav,ep1,ep2 real(kind=kind_phys), dimension(im,nsoil), intent(in) :: smois real(kind=kind_phys), dimension(im), intent(in) :: psfc, prsl1, & - q1, t1, u1, v1, u10, v10, gsw, glw, z1, shdmax, sigmaf, xlat, xlon, & - tsurf_ocn, tsurf_lnd, tsurf_ice + q1, t1, u1, v1, wspd, u10, v10, gsw, glw, z1, shdmax, sigmaf, xlat, & + xlon, tsurf_ocn, tsurf_lnd, tsurf_ice real(kind=kind_phys), intent(inout), dimension(im) :: tskin_ocn, & tskin_lnd, tskin_ice, ustar_ocn, ustar_lnd, ustar_ice, & @@ -167,7 +167,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & real(kind=kind_phys) :: ens_Cdamp real(kind=kind_phys), dimension(im) :: wetc, pspc, pkmax, tstrc, upc, & - vpc, mznt, slwdc, wspd, wind10, qfx, qgh, zkmax, z1_cm, z0max, ztmax + vpc, mznt, slwdc, wind10, qfx, qgh, zkmax, z1_cm, z0max, ztmax real(kind=kind_phys), dimension(im) :: u10_lnd, u10_ocn, u10_ice, & v10_lnd, v10_ocn, v10_ice @@ -254,13 +254,6 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & upc(i) = u1(i)*100. ! convert from m s-1 to cm s-1 vpc(i) = v1(i)*100. ! convert from m s-1 to cm s-1 - !GJF: wind speed at the lowest model layer is calculated in a scheme prior to this (if this scheme - ! is part of a GFS-based suite), but it is recalculated here because this one DOES NOT include - ! a convective wind enhancement component (convective gustiness factor) to follow the original - ! GFDL surface layer scheme; this may not be necessary - wspd(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) - wspd(i) = amax1(wspd(i),1.0) !wspd is in m s-1 - !Wang: use previous u10 v10 to compute wind10, input to MFLUX2 to compute z0 (for first time step, u10 and v10 may be zero) wind10(i)=sqrt(u10(i)*u10(i)+v10(i)*v10(i)) !m s-1 @@ -373,8 +366,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & !GJF: from WRF's module_sf_gfdl.F if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then - !GJF: why not use wspd(i) to save compute? - wind10(i)=sqrt(u1(i)*u1(i)+v1(i)*v1(i))*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) !m s-1 + wind10(i)=wspd(i)*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) !m s-1 end if wind10(i)=wind10(i)*100.0 !convert from m/s to cm/s @@ -523,8 +515,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & !GJF: from WRF's module_sf_gfdl.F if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then - !GJF: why not use wspd(i) to save compute? - wind10(i)=sqrt(u1(i)*u1(i)+v1(i)*v1(i))*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) + wind10(i)=wspd(i)*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) end if wind10(i)=wind10(i)*100.0 !! m/s to cm/s @@ -628,7 +619,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & !GJF: from WRF's module_sf_gfdl.F if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then - wind10(i)=sqrt(u1(i)*u1(i)+v1(i)*v1(i))*alog(10.0/(0.01*znt_ocn(i)))/alog(z1(i)/(0.01*znt_ocn(i))) + wind10(i)=wspd(i)*alog(10.0/(0.01*znt_ocn(i)))/alog(z1(i)/(0.01*znt_ocn(i))) end if wind10(i)=wind10(i)*100.0 !! m/s to cm/s diff --git a/physics/gfdl_sfc_layer.meta b/physics/gfdl_sfc_layer.meta index 738216d1a..5a245cd69 100644 --- a/physics/gfdl_sfc_layer.meta +++ b/physics/gfdl_sfc_layer.meta @@ -401,6 +401,15 @@ kind = kind_phys intent = in optional = F +[wspd] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [u10] standard_name = x_wind_at_10m long_name = 10 meter u wind speed From b8629ee129fd81f7ed515c5faf85533cb1e88af3 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 19 May 2020 21:25:54 -0600 Subject: [PATCH 031/274] add logic to maintain ratio between fh and fh2 to attempt to reign in spuriously large 2m T,q diagnostics --- physics/gfdl_sfc_layer.F90 | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/physics/gfdl_sfc_layer.F90 b/physics/gfdl_sfc_layer.F90 index 3f4426613..6bd969ac3 100644 --- a/physics/gfdl_sfc_layer.F90 +++ b/physics/gfdl_sfc_layer.F90 @@ -183,7 +183,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & real(kind=kind_phys), dimension(1:30) :: maxsmc, drysmc real(kind=kind_phys) :: smcmax, smcdry, zhalf, cd10, & esat, fm_lnd_old, fh_lnd_old, tem1, tem2, czilc, cd_low_limit, & - cd_high_limit, ch_low_limit, ch_high_limit + cd_high_limit, ch_low_limit, ch_high_limit, fh2_fh_ratio !#### This block will become unnecessary when maxsmc and drysmc come through the CCPP #### if (lsm == lsm_noah) then @@ -416,14 +416,14 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ch_lnd(i) = ch_high_limit end if + fh2_lnd(i) = karman*xxfh2(i) + if (ch_bound_excursion) then + fh2_fh_ratio = min(xxfh2(i)/xxfh(i), 1.0) fh_lnd(i) = karman*karman/(fm_lnd(i)*ch_lnd(i)) + fh2_lnd(i) = fh2_fh_ratio*fh_lnd(i) end if - !4) try fh2_lnd, limit to be less than or equal to constant*fh_lnd? - fh2_lnd(i) = karman*xxfh2(i) - fh2_lnd(i) = min(fh2_lnd(i), fh_lnd(i)) !fh2_lnd > fh_lnd leads to bad values in sfc_diag.f - !GJF: Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih !psim_lnd(i)=gz1oz0(i)-fm_lnd(i) !psih_lnd(i)=gz1oz0(i)-fh_lnd(i) @@ -565,14 +565,14 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ch_ice(i) = ch_high_limit end if + fh2_ice(i) = karman*xxfh2(i) + if (ch_bound_excursion) then + fh2_fh_ratio = min(xxfh2(i)/xxfh(i), 1.0) fh_ice(i) = karman*karman/(fm_ice(i)*ch_ice(i)) + fh2_ice(i) = fh2_fh_ratio*fh_ice(i) end if - !4) try fh2_ice, limit to be less than or equal to constant*fh_ice? - fh2_ice(i) = karman*xxfh2(i) - fh2_ice(i) = min(fh2_ice(i), fh_ice(i)) !fh2_ice > fh_ice leads to bad values in sfc_diag.f - !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih !psim_ice(i)=gz1oz0(i)-fm_ice(i) !psih_ice(i)=gz1oz0(i)-fh_ice(i) @@ -675,14 +675,14 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ch_ocn(i) = ch_high_limit end if + fh2_ocn(i) = karman*xxfh2(i) + if (ch_bound_excursion) then + fh2_fh_ratio = min(xxfh2(i)/xxfh(i), 1.0) fh_ocn(i) = karman*karman/(fm_ocn(i)*ch_ocn(i)) + fh2_ocn(i) = fh2_fh_ratio*fh_ocn(i) end if - !4) try fh2_ocn, limit to be less than or equal to constant*fh_ocn? - fh2_ocn(i) = karman*xxfh2(i) - fh2_ocn(i) = min(fh2_ocn(i), fh_ocn(i)) !fh2_ocn > fh_ocn leads to bad values in sfc_diag.F - !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih !psim_ocn(i)=gz1oz0(i)-fm_ocn(i) !psih_ocn(i)=gz1oz0(i)-fh_ocn(i) From 0298cebeeaf6f2d1cd88b8ae087a910a288a99d0 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 27 May 2020 12:22:32 -0600 Subject: [PATCH 032/274] add time-averaged calculation of skin temperature and soil temperature in HWRF Noah LSM to try to reduce spurious values of t2m and q2m --- physics/module_sf_noahlsm.F90 | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/physics/module_sf_noahlsm.F90 b/physics/module_sf_noahlsm.F90 index 9336abf65..13d8e9813 100644 --- a/physics/module_sf_noahlsm.F90 +++ b/physics/module_sf_noahlsm.F90 @@ -2631,6 +2631,7 @@ SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & INTEGER, INTENT(IN) :: OPT_THCND INTEGER, INTENT(IN) :: NSOIL, VEGTYP, ISURBAN, SOILTYP INTEGER :: I + LOGICAL, PARAMETER :: TIME_AVERAGE_T_UPDATE = .TRUE. REAL, INTENT(IN) :: BEXP,CSOIL,DF1,DT,F1,PSISAT,QUARTZ, & SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1 @@ -2641,7 +2642,10 @@ SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS REAL, PARAMETER :: T0 = 273.15 - + REAL :: OLDT1 + REAL, DIMENSION(1:NSOIL) :: OLDSTC + REAL, PARAMETER :: CTFIL1 = 0.5 + REAL, PARAMETER :: CTFIL2 = 1.0 - CTFIL1 ! ! FASDAS ! @@ -2652,7 +2656,14 @@ SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & ! ---------------------------------------------------------------------- ! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN ! ---------------------------------------------------------------------- - + + IF (TIME_AVERAGE_T_UPDATE) THEN + OLDT1 = T1 + DO I = 1, NSOIL + OLDSTC(I) = STC(I) + ENDDO + ENDIF + ! Land case CALL HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1,TBOT, & @@ -2677,6 +2688,15 @@ SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & ! CALCULATE SURFACE SOIL HEAT FLUX ! ---------------------------------------------------------------------- T1 = (YY + (ZZ1- 1.0) * STC (1)) / ZZ1 + + !GJF: Following the GFS version of Noah, time average the updating of skin temperature and soil temperature + IF (TIME_AVERAGE_T_UPDATE) THEN + T1 = CTFIL1*T1 + CTFIL2*OLDT1 + DO I = 1, NSOIL + STC(I) = CTFIL1*STC(I) + CTFIL2*OLDSTC(I) + ENDDO + ENDIF + SSOIL = DF1 * (STC (1) - T1) / (0.5 * ZSOIL (1)) ! ---------------------------------------------------------------------- From 4a2ea3f7a5f972ebebe987fdaa03c69e6f080551 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 21 Aug 2020 17:37:56 -0600 Subject: [PATCH 033/274] swap aero_in for iaerclm in GFS_phys_time_vary.scm --- physics/GFS_phys_time_vary.scm.F90 | 4 ++-- physics/GFS_phys_time_vary.scm.meta | 6 +++--- physics/rrtmgp_lw_pre.F90 | 6 ------ 3 files changed, 5 insertions(+), 11 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index d353a7d08..53ca82651 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -33,7 +33,7 @@ module GFS_phys_time_vary !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! - subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, aero_in, & + subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, iaerclm, & iccn, iflip, idate, nblks, blksz, nx, ny, xlat_d, xlon_d, levh2o_int, & levozp_int, ozpl, h2opl, aer_nm, jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, & jindx2_h, ddy_h, jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, & @@ -48,7 +48,7 @@ subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, aero_in, & integer, intent(in) :: im, ntoz, me, master, iflip, nblks, nx, ny, levh2o_int, levozp_int integer, dimension(4), intent(in) :: idate integer, dimension(nblks), intent(in) :: blksz - logical, intent(in) :: h2o_phys, aero_in, iccn + logical, intent(in) :: h2o_phys, iaerclm, iccn real(kind=kind_phys), dimension(im), intent(in) :: xlat_d, xlon_d real(kind=kind_phys), dimension(:,:,:), intent(in) :: ozpl real(kind=kind_phys), dimension(:,:,:), intent(in) :: h2opl diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 30b8bce46..1e2dc2d0a 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -33,9 +33,9 @@ type = logical intent = in optional = F -[aero_in] - standard_name = flag_for_aerosol_input_MG - long_name = flag for using aerosols in Morrison-Gettelman MP +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation units = flag dimensions = () type = logical diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 1148c6705..7ad8bd30d 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -2,12 +2,6 @@ module rrtmgp_lw_pre use physparam use machine, only: & kind_phys ! Working type - use GFS_typedefs, only: & - GFS_control_type, & ! - GFS_sfcprop_type, & ! Surface fields - GFS_grid_type, & ! Grid and interpolation related data - GFS_statein_type, & ! - GFS_radtend_type ! Radiation tendencies needed in physics use module_radiation_surface, only: & setemis ! Routine to compute surface-emissivity use mo_gas_optics_rrtmgp, only: & From b76bb2cc797116be54561dcce3fe27d662cdb7db Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 21 Aug 2020 18:23:55 -0600 Subject: [PATCH 034/274] revert some changes in meta files accidentally merged in --- physics/GFS_phys_time_vary.scm.meta | 18 +++++++++--------- physics/rrtmg_lw_post.meta | 4 ++-- physics/rrtmg_lw_pre.meta | 4 ++-- physics/rrtmg_sw_post.meta | 4 ++-- 4 files changed, 15 insertions(+), 15 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 1e2dc2d0a..86b91e8c3 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -44,9 +44,9 @@ [iccn] standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics long_name = flag for IN and CCN forcing for morrison gettelman microphysics - units = flag + units = none dimensions = () - type = logical + type = integer intent = in optional = F [iflip] @@ -66,7 +66,7 @@ intent = in optional = F [nblks] - standard_name = number_of_blocks + standard_name = ccpp_block_count long_name = for explicit data blocking: number of blocks units = count dimensions = () @@ -74,10 +74,10 @@ intent = in optional = F [blksz] - standard_name = horizontal_block_size + standard_name = ccpp_block_sizes long_name = for explicit data blocking: block sizes of all blocks units = count - dimensions = (number_of_blocks) + dimensions = (ccpp_block_count) type = integer intent = in optional = F @@ -106,18 +106,18 @@ intent = in optional = F [xlat_d] - standard_name = latitude_degree + standard_name = latitude_in_degree long_name = latitude in degrees - units = degree + units = degree_north dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F [xlon_d] - standard_name = longitude_degree + standard_name = longitude_in_degree long_name = longitude in degrees - units = degree + units = degree_east dimensions = (horizontal_dimension) type = real kind = kind_phys diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 5108e8eb2..447e3a066 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -107,7 +107,7 @@ intent = inout optional = F [htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -116,7 +116,7 @@ intent = inout optional = F [lwhc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky lw heating rates units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index 481850494..d4054cc0b 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -25,7 +25,7 @@ [xlat] standard_name = latitude long_name = latitude - units = radians + units = radian dimensions = (horizontal_dimension) type = real kind = kind_phys @@ -34,7 +34,7 @@ [xlon] standard_name = longitude long_name = longitude - units = radians + units = radian dimensions = (horizontal_dimension) type = real kind = kind_phys diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 00687e055..ba1739e44 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -247,7 +247,7 @@ intent = inout optional = F [htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -256,7 +256,7 @@ intent = inout optional = F [swhc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky sw heating rates units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) From eea20edd2db63ba93a32648ad88d524188f86353 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 25 Aug 2020 10:48:35 -0600 Subject: [PATCH 035/274] remove DDTs from GFS_phys_time_vary_init (SCM), GFS_rad_time_vary (SCM), GFS_rrtmg_post --- physics/GFS_phys_time_vary.scm.F90 | 8 +- physics/GFS_rad_time_vary.scm.F90 | 69 +++++---- physics/GFS_rad_time_vary.scm.meta | 234 +++++++++++++++++++++++++++-- physics/GFS_rrtmg_post.F90 | 152 +++++++++---------- physics/GFS_rrtmg_post.meta | 185 ++++++++++++++++++----- physics/gscond.meta | 24 +-- 6 files changed, 496 insertions(+), 176 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 53ca82651..f2a913982 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -45,10 +45,10 @@ subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, iaerclm, & implicit none ! Interface variables - integer, intent(in) :: im, ntoz, me, master, iflip, nblks, nx, ny, levh2o_int, levozp_int + integer, intent(in) :: im, ntoz, me, master, iflip, nblks, nx, ny, levh2o_int, levozp_int, iccn integer, dimension(4), intent(in) :: idate integer, dimension(nblks), intent(in) :: blksz - logical, intent(in) :: h2o_phys, iaerclm, iccn + logical, intent(in) :: h2o_phys, iaerclm real(kind=kind_phys), dimension(im), intent(in) :: xlat_d, xlon_d real(kind=kind_phys), dimension(:,:,:), intent(in) :: ozpl real(kind=kind_phys), dimension(:,:,:), intent(in) :: h2opl @@ -135,7 +135,7 @@ subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, iaerclm, & ntrcaer = size(aer_nm, dim=3) endif - if (iccn) then + if (iccn == 1) then call read_cidata (me, master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 @@ -172,7 +172,7 @@ subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, iaerclm, & me, master) endif !--- read in and initialize IN and CCN - if (iccn) then + if (iccn == 1) then call setindxci (blksz(nb), xlat_d, jindx1_ci, & jindx2_ci, ddy_ci, xlon_d, & iindx1_ci, iindx2_ci, ddx_ci) diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 13ae5e14b..738065cfc 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -21,29 +21,46 @@ end subroutine GFS_rad_time_vary_init !> \section arg_table_GFS_rad_time_vary_run Argument Table !! \htmlinclude GFS_rad_time_vary_run.html !! - subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) + subroutine GFS_rad_time_vary_run (cnx, cny, lsswr, lslwr, isubc_sw, & + isubc_lw, sec, nblks, blksz, isc, jsc, imp_physics, & + imp_physics_zhao_carr, kdt, tgrs, qgrs_wv, prsi, imap, jmap, & + icsdsw, icsdlw, t_minus_two_delt, qv_minus_two_delt, & + t_minus_delt, qv_minus_delt, ps_minus_two_delt, ps_minus_delt, & + errmsg, errflg) use physparam, only: ipsd0, ipsdlim, iaerflg use mersenne_twister, only: random_setseed, random_index, random_stat use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_tbd_type use radcons, only: qmin, con_100 implicit none - type(GFS_control_type), intent(inout) :: Model - type(GFS_statein_type), intent(in) :: Statein - type(GFS_tbd_type), intent(inout) :: Tbd + integer, intent(in) :: cnx, cny, isubc_sw, isubc_lw, & + nblks, isc, jsc, imp_physics,& + imp_physics_zhao_carr, kdt + logical, intent(in) :: lsswr, lslwr + real(kind=kind_phys), intent(in) :: sec + + integer, dimension(nblks), intent(in) :: blksz + integer, dimension(:), intent(in) :: imap, jmap + + integer, dimension(:), intent(inout) :: icsdsw, icsdlw + + real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, qgrs_wv + real(kind=kind_phys), dimension(:,:), intent(in) :: prsi + + real(kind=kind_phys), dimension(:,:), intent(inout) :: t_minus_two_delt, & + qv_minus_two_delt, t_minus_delt, qv_minus_delt + real(kind=kind_phys), dimension(:), intent(inout) :: ps_minus_two_delt,& + ps_minus_delt + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg !--- local variables type (random_stat) :: stat - integer :: ix, nb, j, i, nblks, ipseed - integer :: numrdm(Model%cnx*Model%cny*2) + integer :: ix, nb, j, i, ipseed + integer :: numrdm(cnx*cny*2) ! Initialize CCPP error handling variables errmsg = '' @@ -51,34 +68,34 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) nb = 1 - if (Model%lsswr .or. Model%lslwr) then + if (lsswr .or. lslwr) then !--- call to GFS_radupdate_run is now in GFS_rrtmg_setup_run !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) - if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then - ipseed = mod(nint(con_100*sqrt(Model%sec)), ipsdlim) + 1 + ipsd0 + if ((isubc_lw==2) .or. (isubc_sw==2)) then + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 call random_setseed (ipseed, stat) call random_index (ipsdlim, numrdm, stat) !--- set the random seeds for each column in a reproducible way - do ix=1,Model%blksz(nb) - j = Tbd%jmap(ix) - i = Tbd%imap(ix) + do ix=1,blksz(nb) + j = jmap(ix) + i = imap(ix) !--- for testing purposes, replace numrdm with '100' - Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) - Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) + icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) + icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) enddo endif ! isubc_lw and isubc_sw - if (Model%imp_physics == 99) then - if (Model%kdt == 1) then - Tbd%phy_f3d(:,:,1) = Statein%tgrs - Tbd%phy_f3d(:,:,2) = max(qmin,Statein%qgrs(:,:,1)) - Tbd%phy_f3d(:,:,3) = Statein%tgrs - Tbd%phy_f3d(:,:,4) = max(qmin,Statein%qgrs(:,:,1)) - Tbd%phy_f2d(:,1) = Statein%prsi(:,1) - Tbd%phy_f2d(:,2) = Statein%prsi(:,1) + if (imp_physics == imp_physics_zhao_carr) then + if (kdt == 1) then + t_minus_two_delt(:,:) = tgrs + qv_minus_two_delt(:,:) = max(qmin,qgrs_wv(:,:)) + t_minus_delt(:,:) = tgrs + qv_minus_delt(:,:) = max(qmin,qgrs_wv(:,:)) + ps_minus_two_delt(:) = prsi(:,1) + ps_minus_delt(:) = prsi(:,1) endif endif diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index 7e87f1f8a..b5de5ed12 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -6,28 +6,230 @@ [ccpp-arg-table] name = GFS_rad_time_vary_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count dimensions = () - type = GFS_control_type - intent = inout + type = integer + intent = in + optional = F +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[isubc_sw] + standard_name = flag_for_sw_clouds_without_sub_grid_approximation + long_name = flag for sw clouds without sub-grid approximation + units = flag dimensions = () - type = GFS_statein_type + type = integer + intent = in + optional = F +[isubc_lw] + standard_name = flag_for_lw_clouds_without_sub_grid_approximation + long_name = flag for lw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS data not yet assigned to a defined container - units = DDT +[sec] + standard_name = seconds_elapsed_since_model_initialization + long_name = seconds elapsed since model initialization + units = s dimensions = () - type = GFS_tbd_type + type = real + kind = kind_phys + intent = in + optional = F +[nblks] + standard_name = ccpp_block_count + long_name = for explicit data blocking: number of blocks + units = count + dimensions = () + type = integer + intent = in + optional = F +[blksz] + standard_name = ccpp_block_sizes + long_name = for explicit data blocking: block sizes of all blocks + units = count + dimensions = (ccpp_block_count) + type = integer + intent = in + optional = F +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qgrs_wv] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[icsdsw] + standard_name = seed_random_numbers_sw + long_name = random seeds for sub-column cloud generators sw + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[icsdlw] + standard_name = seed_random_numbers_lw + long_name = random seeds for sub-column cloud generators lw + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[t_minus_two_delt] + standard_name = air_temperature_two_timesteps_back + long_name = air temperature two timesteps back + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_minus_two_delt] + standard_name = water_vapor_specific_humidity_two_timesteps_back + long_name = water vapor specific humidity two timesteps back + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t_minus_delt] + standard_name = air_temperature_at_previous_timestep + long_name = air temperature at previous timestep + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_minus_delt] + standard_name = water_vapor_specific_humidity_at_previous_timestep + long_name = water vapor specific humidity at previous timestep + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ps_minus_two_delt] + standard_name = surface_air_pressure_two_timesteps_back + long_name = surface air pressure two timesteps back + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ps_minus_delt] + standard_name = surface_air_pressure_at_previous_timestep + long_name = surface air pressure at previous timestep + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys intent = inout optional = F [errmsg] diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index 7f80ca4c3..aacf9aaf5 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -13,43 +13,41 @@ end subroutine GFS_rrtmg_post_init !> \section arg_table_GFS_rrtmg_post_run Argument Table !! \htmlinclude GFS_rrtmg_post_run.html !! - subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & - Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & + subroutine GFS_rrtmg_post_run (lsswr, lslwr, lssav, fhlwr, fhswr, prsi, tgrs, sfcflw, sfcfsw, topflw, topfsw, coszen, coszdg, fluxr, & + scmpsw, nspc1, nfxr, im, km, kmp1, lm, ltp, kt, kb, kd, raddt, aerodp, & cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday, & errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, & - GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_radtend_type, & - GFS_diag_type - use module_radiation_aerosols, only: NSPC1 - use module_radsw_parameters, only: cmpfsw_type + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type use module_radlw_parameters, only: topflw_type, sfcflw_type - use module_radsw_parameters, only: topfsw_type, sfcfsw_type implicit none ! Interface variables - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - type(GFS_statein_type), intent(in) :: Statein - type(GFS_coupling_type), intent(inout) :: Coupling - type(GFS_radtend_type), intent(in) :: Radtend - type(GFS_diag_type), intent(inout) :: Diag - type(cmpfsw_type), dimension(size(Grid%xlon,1)), intent(in) :: scmpsw - - integer, intent(in) :: im, lm, ltp, kt, kb, kd, nday - real(kind=kind_phys), intent(in) :: raddt - - real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(in) :: aerodp - real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(in) :: cldsa - integer, dimension(size(Grid%xlon,1),3), intent(in) :: mbota, mtopa - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: clouds1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: cldtausw - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: cldtaulw + type(sfcflw_type), dimension(im), intent(in) :: sfcflw + type(sfcfsw_type), dimension(im), intent(in) :: sfcfsw + type(cmpfsw_type), dimension(im), intent(in) :: scmpsw + type(topflw_type), dimension(im), intent(in) :: topflw + type(topfsw_type), dimension(im), intent(in) :: topfsw + + integer, intent(in) :: nspc1, nfxr, im, km, kmp1, lm, ltp, kt, kb, kd, nday + real(kind=kind_phys), intent(in) :: raddt, fhlwr, fhswr + logical, intent(in) :: lsswr, lslwr, lssav + + real(kind=kind_phys), dimension(im), intent(in) :: coszen, coszdg + + real(kind=kind_phys), dimension(im,kmp1), intent(in) :: prsi + real(kind=kind_phys), dimension(im,km), intent(in) :: tgrs + + real(kind=kind_phys), dimension(im,NSPC1), intent(in) :: aerodp + real(kind=kind_phys), dimension(im,5), intent(in) :: cldsa + integer, dimension(im,3), intent(in) :: mbota, mtopa + real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: clouds1 + real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtausw + real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtaulw + + real(kind=kind_phys), dimension(im,nfxr), intent(inout) :: fluxr character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -62,7 +60,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & errmsg = '' errflg = 0 - if (.not. (Model%lsswr .or. Model%lslwr)) return + if (.not. (lsswr .or. lslwr)) return !> - For time averaged output quantities (including total-sky and !! clear-sky SW and LW fluxes at TOA and surface; conventional @@ -72,77 +70,77 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & ! --- ... collect the fluxr data for wrtsfc - if (Model%lssav) then - if (Model%lsswr) then + if (lssav) then + if (lsswr) then do i=1,im -! Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm -! Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm -! Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm -! Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm -! Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm -! Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm - Diag%fluxr(i,34) = aerodp(i,1) ! total aod at 550nm - Diag%fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm - Diag%fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm - Diag%fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm - Diag%fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm - Diag%fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm +! fluxr(i,34) = fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm +! fluxr(i,35) = fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm +! fluxr(i,36) = fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm +! fluxr(i,37) = fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm +! fluxr(i,38) = fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm +! fluxr(i,39) = fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm + fluxr(i,34) = aerodp(i,1) ! total aod at 550nm + fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm + fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm + fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm + fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm + fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm enddo endif ! --- save lw toa and sfc fluxes - if (Model%lslwr) then + if (lslwr) then do i=1,im ! --- lw total-sky fluxes - Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * Diag%topflw(i)%upfxc ! total sky top lw up - Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * Radtend%sfcflw(i)%dnfxc ! total sky sfc lw dn - Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * Radtend%sfcflw(i)%upfxc ! total sky sfc lw up + fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * topflw(i)%upfxc ! total sky top lw up + fluxr(i,19) = fluxr(i,19) + fhlwr * sfcflw(i)%dnfxc ! total sky sfc lw dn + fluxr(i,20) = fluxr(i,20) + fhlwr * sfcflw(i)%upfxc ! total sky sfc lw up ! --- lw clear-sky fluxes - Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * Diag%topflw(i)%upfx0 ! clear sky top lw up - Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * Radtend%sfcflw(i)%dnfx0 ! clear sky sfc lw dn - Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * Radtend%sfcflw(i)%upfx0 ! clear sky sfc lw up + fluxr(i,28) = fluxr(i,28) + fhlwr * topflw(i)%upfx0 ! clear sky top lw up + fluxr(i,30) = fluxr(i,30) + fhlwr * sfcflw(i)%dnfx0 ! clear sky sfc lw dn + fluxr(i,33) = fluxr(i,33) + fhlwr * sfcflw(i)%upfx0 ! clear sky sfc lw up enddo endif ! --- save sw toa and sfc fluxes with proper diurnal sw wgt. coszen=mean cosz over daylight ! part of sw calling interval, while coszdg= mean cosz over entire interval - if (Model%lsswr) then + if (lsswr) then do i = 1, IM - if (Radtend%coszen(i) > 0.) then + if (coszen(i) > 0.) then ! --- sw total-sky fluxes ! ------------------- - tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) - Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up - Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d ! total sky sfc sw up - Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn + tem0d = fhswr * coszdg(i) / coszen(i) + fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up + fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d ! total sky sfc sw up + fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn ! --- sw uv-b fluxes ! -------------- - Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn + fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn + fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn ! --- sw toa incoming fluxes ! ---------------------- - Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn + fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn ! --- sw sfc flux components ! ---------------------- - Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn - Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn - Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn - Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn + fluxr(i,24) = fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn + fluxr(i,25) = fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn + fluxr(i,26) = fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn + fluxr(i,27) = fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn ! --- sw clear-sky fluxes ! ------------------- - Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d ! clear sky top sw up - Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d ! clear sky sfc sw up - Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d ! clear sky sfc sw dn + fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d ! clear sky top sw up + fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d ! clear sky sfc sw up + fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d ! clear sky sfc sw dn endif enddo endif ! --- save total and boundary layer clouds - if (Model%lsswr .or. Model%lslwr) then + if (lsswr .or. lslwr) then do i=1,im - Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) - Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) + fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) + fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) enddo ! --- save cld frac,toplyr,botlyr and top temp, note that the order @@ -154,15 +152,15 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & tem0d = raddt * cldsa(i,j) itop = mtopa(i,j) - kd ibtc = mbota(i,j) - kd - Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d - Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop+kt) - Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc+kb) - Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d + fluxr(i,11-j) = fluxr(i,11-j) + tem0d * prsi(i,itop+kt) + fluxr(i,14-j) = fluxr(i,14-j) + tem0d * prsi(i,ibtc+kb) + fluxr(i,17-j) = fluxr(i,17-j) + tem0d * tgrs(i,itop) enddo enddo ! Anning adds optical depth and emissivity output - if (Model%lsswr .and. (nday > 0)) then + if (lsswr .and. (nday > 0)) then do j = 1, 3 do i = 1, IM tem0d = raddt * cldsa(i,j) @@ -172,12 +170,12 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & do k=ibtc,itop tem1 = tem1 + cldtausw(i,k) ! approx .55 um channel enddo - Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 + fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1 enddo enddo endif - if (Model%lslwr) then + if (lslwr) then do j = 1, 3 do i = 1, IM tem0d = raddt * cldsa(i,j) @@ -187,7 +185,7 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & do k=ibtc,itop tem2 = tem2 + cldtaulw(i,k) ! approx 10. um channel enddo - Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) enddo enddo endif diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index 61e89098d..e996236ab 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -6,62 +6,149 @@ [ccpp-arg-table] name = GFS_rrtmg_post_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_control_type + type = logical intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag dimensions = () - type = GFS_grid_type + type = logical intent = in optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = Fortran DDT containing FV3-GFS diagnotics data - units = DDT +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag dimensions = () - type = GFS_diag_type - intent = inout + type = logical + intent = in optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = Fortran DDT containing FV3-GFS radiation tendencies - units = DDT +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s dimensions = () - type = GFS_radtend_type + type = real + kind = kind_phys intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore - units = DDT +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s dimensions = () - type = GFS_statein_type + type = real + kind = kind_phys intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components - units = DDT - dimensions = () - type = GFS_coupling_type +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcflw] + standard_name = lw_fluxes_sfc + long_name = lw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_loop_extent) + type = sfcflw_type + intent = in + optional = F +[sfcfsw] + standard_name = sw_fluxes_sfc + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_loop_extent) + type = sfcfsw_type + intent = in + optional = F +[topflw] + standard_name = lw_fluxes_top_atmosphere + long_name = lw radiation fluxes at top + units = W m-2 + dimensions = (horizontal_loop_extent) + type = topflw_type + intent = in + optional = F +[topfsw] + standard_name = sw_fluxes_top_atmosphere + long_name = sw radiation fluxes at toa + units = W m-2 + dimensions = (horizontal_loop_extent) + type = topfsw_type + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[fluxr] + standard_name = cumulative_radiation_diagnostic + long_name = time-accumulated 2D radiation-related diagnostic fields + units = various + dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) + type = real + kind = kind_phys intent = inout optional = F [scmpsw] standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = in optional = F +[nspc1] + standard_name = number_of_species_for_aerosol_optical_depth + long_name = number of species for output aerosol optical depth plus total + units = count + dimensions = () + type = integer + intent = in + optional = F +[nfxr] + standard_name = number_of_radiation_diagnostic_variables + long_name = number of variables stored in the fluxr array + units = count + dimensions = () + type = integer + intent = in + optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -70,6 +157,22 @@ type = integer intent = in optional = F +[km] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[kmp1] + standard_name = vertical_dimension_plus_one + long_name = number of vertical levels plus one + units = count + dimensions = () + type = integer + intent = in + optional = F [lm] standard_name = number_of_vertical_layers_for_radiation_calculations long_name = number of vertical layers for radiation calculation @@ -123,7 +226,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = in @@ -132,7 +235,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = in @@ -141,7 +244,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -149,7 +252,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -157,7 +260,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -166,7 +269,7 @@ standard_name = cloud_optical_depth_layers_at_10mu_band long_name = approx 10mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -175,7 +278,7 @@ standard_name = cloud_optical_depth_layers_at_0p55mu_band long_name = approx .55mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -209,4 +312,4 @@ ######################################################################## [ccpp-arg-table] name = GFS_rrtmg_post_finalize - type = scheme + type = scheme \ No newline at end of file diff --git a/physics/gscond.meta b/physics/gscond.meta index 57156358f..d8c27c878 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -99,8 +99,8 @@ intent = inout optional = F [tp] - standard_name = air_temperature_two_time_steps_back - long_name = air temperature two time steps back + standard_name = air_temperature_two_timesteps_back + long_name = air temperature two timesteps back units = K dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -108,8 +108,8 @@ intent = inout optional = F [qp] - standard_name = water_vapor_specific_humidity_two_time_steps_back - long_name = water vapor specific humidity two time steps back + standard_name = water_vapor_specific_humidity_two_timesteps_back + long_name = water vapor specific humidity two timesteps back units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -117,8 +117,8 @@ intent = inout optional = F [psp] - standard_name = surface_air_pressure_two_time_steps_back - long_name = surface air pressure two time steps back + standard_name = surface_air_pressure_two_timesteps_back + long_name = surface air pressure two timesteps back units = Pa dimensions = (horizontal_dimension) type = real @@ -126,8 +126,8 @@ intent = inout optional = F [tp1] - standard_name = air_temperature_at_previous_time_step - long_name = air temperature at previous time step + standard_name = air_temperature_at_previous_timestep + long_name = air temperature at previous timestep units = K dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -135,8 +135,8 @@ intent = inout optional = F [qp1] - standard_name = water_vapor_specific_humidity_at_previous_time_step - long_name = water vapor specific humidity at previous time step + standard_name = water_vapor_specific_humidity_at_previous_timestep + long_name = water vapor specific humidity at previous timestep units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -144,8 +144,8 @@ intent = inout optional = F [psp1] - standard_name = surface_air_pressure_at_previous_time_step - long_name = surface air surface pressure at previous time step + standard_name = surface_air_pressure_at_previous_timestep + long_name = surface air surface pressure at previous timestep units = Pa dimensions = (horizontal_dimension) type = real From b1e393d980cc8da76bd4b1dde14aae8c9b5ad900 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 26 Aug 2020 09:26:40 -0600 Subject: [PATCH 036/274] cleanup GFS_phys_time_vary.scm --- physics/GFS_phys_time_vary.scm.F90 | 208 ++++---- physics/GFS_phys_time_vary.scm.meta | 777 ++++++++++++++++++++++------ physics/GFS_time_vary_pre.fv3.meta | 2 +- physics/GFS_time_vary_pre.scm.meta | 2 +- 4 files changed, 739 insertions(+), 250 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index f2a913982..2bb04ebb6 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -33,30 +33,36 @@ module GFS_phys_time_vary !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! - subroutine GFS_phys_time_vary_init (im, ntoz, me, master, h2o_phys, iaerclm, & - iccn, iflip, idate, nblks, blksz, nx, ny, xlat_d, xlon_d, levh2o_int, & - levozp_int, ozpl, h2opl, aer_nm, jindx1_o3, jindx2_o3, ddy_o3, jindx1_h, & - jindx2_h, ddy_h, jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, & - ddx_aer, jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, & - oz_pres_int, h2o_pres_int, imap, jmap, errmsg, errflg) + subroutine GFS_phys_time_vary_init (im, nx, ny, me, master, nblks, ntoz, iflip, & + iccn, levh2o_int, levozp_int, idate, blksz, h2o_phys, iaerclm, xlat_d, xlon_d,& + ozpl, h2opl, aer_nm, imap, jmap, jindx1_o3, jindx2_o3, jindx1_h, jindx2_h, & + jindx1_aer, jindx2_aer, iindx1_aer, iindx2_aer, jindx1_ci, jindx2_ci, & + iindx1_ci, iindx2_ci, ddy_o3, ddy_h, ddy_aer, ddx_aer, ddy_ci, ddx_ci, & + oz_pres_int, h2o_pres_int, errmsg, errflg) use machine, only: kind_phys implicit none ! Interface variables - integer, intent(in) :: im, ntoz, me, master, iflip, nblks, nx, ny, levh2o_int, levozp_int, iccn - integer, dimension(4), intent(in) :: idate - integer, dimension(nblks), intent(in) :: blksz - logical, intent(in) :: h2o_phys, iaerclm - real(kind=kind_phys), dimension(im), intent(in) :: xlat_d, xlon_d - real(kind=kind_phys), dimension(:,:,:), intent(in) :: ozpl - real(kind=kind_phys), dimension(:,:,:), intent(in) :: h2opl - real(kind=kind_phys), dimension(:,:,:), intent(in) :: aer_nm - - integer, dimension(im), intent(inout) :: imap, jmap - integer, dimension(:), intent(inout) :: jindx1_o3, jindx2_o3, jindx1_h, jindx2_h, jindx1_aer, jindx2_aer, iindx1_aer, iindx2_aer, jindx1_ci, jindx2_ci, iindx1_ci, iindx2_ci - real(kind=kind_phys), dimension(:), intent(inout) :: ddy_o3, ddy_h, ddy_aer, ddx_aer, ddy_ci, ddx_ci + integer, intent(in) :: im, nx, ny, me, master, & + nblks, ntoz, iflip, iccn,& + levh2o_int, levozp_int + integer, dimension(4), intent(in) :: idate + integer, dimension(nblks), intent(in) :: blksz + logical, intent(in) :: h2o_phys, iaerclm + real(kind=kind_phys), dimension(im), intent(in) :: xlat_d, xlon_d + real(kind=kind_phys), dimension(:,:,:), intent(in) :: ozpl, h2opl, aer_nm + + integer, dimension(im), intent(inout) :: imap, jmap + integer, dimension(:), intent(inout) :: jindx1_o3, jindx2_o3, & + jindx1_h, jindx2_h, & + jindx1_aer, jindx2_aer, & + iindx1_aer, iindx2_aer, & + jindx1_ci, jindx2_ci, & + iindx1_ci, iindx2_ci + real(kind=kind_phys), dimension(:), intent(inout) :: ddy_o3, ddy_h, ddy_aer, & + ddx_aer, ddy_ci, ddx_ci real(kind=kind_phys), dimension(levozp_int), intent(inout) :: oz_pres_int real(kind=kind_phys), dimension(levh2o_int), intent(inout) :: h2o_pres_int @@ -241,25 +247,53 @@ end subroutine GFS_phys_time_vary_finalize !> \section arg_table_GFS_phys_time_vary_run Argument Table !! \htmlinclude GFS_phys_time_vary_run.html !! - subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Diag, first_time_step, errmsg, errflg) + subroutine GFS_phys_time_vary_run (levs, cnx, cny, isc, jsc, me, master, & + ntoz, iccn, nrcm, nsswr, nszero, kdt, imfdeepcnv, seed0, first_time_step,& + lsswr, cal_pre, random_clds, h2o_phys, iaerclm, fhswr, fhlwr, fhour, & + fhzero, dtp, idate, jindx1_o3, jindx2_o3, jindx1_h, jindx2_h, jindx1_aer,& + jindx2_aer, iindx1_aer, iindx2_aer, jindx1_ci, jindx2_ci, iindx1_ci, & + iindx2_ci, blksz, imap, jmap, ddy_o3, ddy_h, ddy_aer, ddx_aer, ddy_ci, & + ddx_ci, slmsk, vtype, weasd, prsl, Model, clstp, sncovr, rann, in_nm, & + ccn_nm, ozpl, h2opl, aer_nm, Diag, errmsg, errflg) use mersenne_twister, only: random_setseed, random_number use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_Tbd_type, GFS_sfcprop_type, & - GFS_cldprop_type, GFS_diag_type, & - GFS_statein_type - + use GFS_typedefs, only: GFS_control_type, GFS_diag_type + implicit none - type(GFS_grid_type), intent(in) :: Grid - type(GFS_statein_type), intent(in) :: Statein - type(GFS_control_type), intent(inout) :: Model - type(GFS_tbd_type), intent(inout) :: Tbd - type(GFS_sfcprop_type), intent(inout) :: Sfcprop - type(GFS_cldprop_type), intent(inout) :: Cldprop + integer, intent(in) :: levs, cnx, cny, isc, jsc, & + me, master, ntoz, iccn, & + nrcm, nsswr, nszero, kdt, & + imfdeepcnv, seed0 + logical, intent(in) :: first_time_step, lsswr, & + cal_pre, random_clds, & + h2o_phys, iaerclm + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, fhour, & + fhzero, dtp + + integer, dimension(4), intent(in) :: idate + integer, dimension(:), intent(in) :: jindx1_o3, jindx2_o3, & + jindx1_h, jindx2_h, & + jindx1_aer, jindx2_aer, & + iindx1_aer, iindx2_aer, & + jindx1_ci, jindx2_ci, & + iindx1_ci, iindx2_ci, & + blksz, imap, jmap + real(kind=kind_phys), dimension(:), intent(in) :: ddy_o3, ddy_h, ddy_aer, & + ddx_aer, ddy_ci, ddx_ci, & + slmsk, vtype, weasd + real(kind=kind_phys), dimension(:,:), intent(in) :: prsl + + type(GFS_control_type), intent(in) :: Model + + real(kind=kind_phys), intent(inout) :: clstp + real(kind=kind_phys), dimension(:), intent(inout) :: sncovr + real(kind=kind_phys), dimension(:,:), intent(inout) :: rann, in_nm, ccn_nm + real(kind=kind_phys), dimension(:,:,:), intent(inout) :: ozpl, h2opl, aer_nm + type(GFS_diag_type), intent(inout) :: Diag - logical, intent(in) :: first_time_step + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -270,8 +304,8 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, integer :: i, j, k, iseed, iskip, ix, nb, kdt_rad, vegtyp real(kind=kind_phys) :: sec_zero, rsnow real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) + real(kind=kind_phys) :: rannie(cny) + real(kind=kind_phys) :: rndval(cnx*cny*nrcm) ! Initialize CCPP error handling variables errmsg = '' @@ -288,98 +322,98 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, !--- switch for saving convective clouds - cnvc90.f !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then + if ((mod(kdt,nsswr) == 0) .and. (lsswr)) then !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then + clstp = 1100 + min(fhswr/con_hr,fhour,con_99) + elseif (mod(kdt,nsswr) == 0) then !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then + clstp = 0100 + min(fhswr/con_hr,fhour,con_99) + elseif (lsswr) then !--- initialize,accumulate - Model%clstp = 1100 + clstp = 1100 else !--- accumulate - Model%clstp = 0100 + clstp = 0100 endif !--- random number needed for RAS and old SAS and when cal_pre=.true. - if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 + if ( (imfdeepcnv <= 0 .or. cal_pre) .and. random_clds ) then + iseed = mod(con_100*sqrt(fhour*con_hr),1.0d9) + seed0 call random_setseed(iseed) call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm + do i = 1,cnx*nrcm iseed = iseed + nint(wrk(1)*1000.0) * i call random_setseed(iseed) call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) + rndval(1+(i-1)*cny:i*cny) = rannie(1:cny) enddo - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny - do ix=1,Model%blksz(nb) - j = Tbd%jmap(ix) - i = Tbd%imap(ix) - Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) + do k = 1,nrcm + iskip = (k-1)*cnx*cny + do ix=1,blksz(nb) + j = jmap(ix) + i = imap(ix) + rann(ix,k) = rndval(i+isc-1 + (j+jsc-2)*cnx + iskip) enddo enddo endif ! imfdeepcnv, cal_re, random_clds !--- o3 interpolation - if (Model%ntoz > 0) then - call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_o3, Grid%jindx2_o3, Tbd%ozpl, Grid%ddy_o3) + if (ntoz > 0) then + call ozinterpol (me, blksz(nb), idate, fhour, & + jindx1_o3, jindx2_o3, ozpl, ddy_o3) endif !--- h2o interpolation - if (Model%h2o_phys) then - call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h) + if (h2o_phys) then + call h2ointerpol (me, blksz(nb), idate, fhour, & + jindx1_h, jindx2_h, h2opl, ddy_h) endif !--- aerosol interpolation - if (Model%iaerclm) then - call aerinterpol (Model%me, Model%master, Model%blksz(nb), & - Model%idate, Model%fhour, & - Grid%jindx1_aer, Grid%jindx2_aer, & - Grid%ddy_aer,Grid%iindx1_aer, & - Grid%iindx2_aer,Grid%ddx_aer, & - Model%levs,Statein%prsl, & - Tbd%aer_nm) + if (iaerclm) then + call aerinterpol (me, master, blksz(nb), & + idate, fhour, & + jindx1_aer, jindx2_aer, & + ddy_aer,iindx1_aer, & + iindx2_aer,ddx_aer, & + levs,prsl, & + aer_nm) endif !--- ICCN interpolation - if (Model%iccn == 1) then - call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_ci, Grid%jindx2_ci, & - Grid%ddy_ci,Grid%iindx1_ci, & - Grid%iindx2_ci,Grid%ddx_ci, & - Model%levs,Statein%prsl, & - Tbd%in_nm, Tbd%ccn_nm) + if (iccn == 1) then + call ciinterpol (me, blksz(nb), idate, fhour, & + jindx1_ci, jindx2_ci, & + ddy_ci,iindx1_ci, & + iindx2_ci,ddx_ci, & + levs,prsl, & + in_nm, ccn_nm) endif !--- original FV3 code, not needed for SCM; also not compatible with the way ! the time vary steps are run (over each block) --> cannot use !--- repopulate specific time-varying sfc properties for AMIP/forecast runs !if (Model%nscyc > 0) then - ! if (mod(Model%kdt,Model%nscyc) == 1) THEN + ! if (mod(kdt,Model%nscyc) == 1) THEN ! call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) ! endif !endif !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 1) then + sec_zero = nint(fhzero*con_hr) + if (sec_zero >= nint(max(fhswr,fhlwr))) then + if (mod(kdt,nszero) == 1) then call Diag%rad_zero (Model) call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif else - if (mod(Model%kdt,Model%nszero) == 1) then + if (mod(kdt,nszero) == 1) then call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 1) then + kdt_rad = nint(min(fhswr,fhlwr)/dtp) + if (mod(kdt, kdt_rad) == 1) then call Diag%rad_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif @@ -388,19 +422,19 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, #if 0 !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) if (first_time_step) then - if (nint(Sfcprop%sncovr(1)) == -9999) then + if (nint(sncovr(1)) == -9999) then !--- compute sncovr from existing variables !--- code taken directly from read_fix.f - do ix = 1, Model%blksz(nb) - Sfcprop%sncovr(ix) = 0.0 - if (Sfcprop%slmsk(ix) > 0.001) then - vegtyp = Sfcprop%vtype(ix) + do ix = 1, blksz(nb) + sncovr(ix) = 0.0 + if (slmsk(ix) > 0.001) then + vegtyp = vtype(ix) if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) - if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then - Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + rsnow = 0.001*weasd(ix)/snupx(vegtyp) + if (0.001*weasd(ix) < snupx(vegtyp)) then + sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) else - Sfcprop%sncovr(ix) = 1.0 + sncovr(ix) = 1.0 endif endif enddo diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 86b91e8c3..fd450c336 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1,10 +1,26 @@ [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme -[ntoz] - standard_name = index_for_ozone - long_name = tracer index for ozone mixing ratio - units = index +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nx] + standard_name = number_of_points_in_x_direction_for_this_MPI_rank + long_name = number of points in x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[ny] + standard_name = number_of_points_in_y_direction_for_this_MPI_rank + long_name = number of points in y direction for this MPI rank + units = count dimensions = () type = integer intent = in @@ -25,20 +41,28 @@ type = integer intent = in optional = F -[h2o_phys] - standard_name = flag_for_stratospheric_water_vapor_physics - long_name = flag for stratospheric water vapor physics - units = flag +[nblks] + standard_name = ccpp_block_count + long_name = for explicit data blocking: number of blocks + units = count dimensions = () - type = logical + type = integer intent = in optional = F -[iaerclm] - standard_name = flag_for_aerosol_input_MG_radiation - long_name = flag for using aerosols in Morrison-Gettelman MP_radiation +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = iflip - is not the same as flipv units = flag dimensions = () - type = logical + type = integer intent = in optional = F [iccn] @@ -49,10 +73,18 @@ type = integer intent = in optional = F -[iflip] - standard_name = flag_for_vertical_index_direction_control - long_name = iflip - is not the same as flipv - units = flag +[levh2o_int] + standard_name = vertical_dimension_of_h2o_forcing_data + long_name = number of vertical layers in h2o forcing data + units = count + dimensions = () + type = integer + intent = in + optional = F +[levozp_int] + standard_name = vertical_dimension_of_ozone_forcing_data + long_name = number of vertical layers in ozone forcing data + units = count dimensions = () type = integer intent = in @@ -65,14 +97,6 @@ type = integer intent = in optional = F -[nblks] - standard_name = ccpp_block_count - long_name = for explicit data blocking: number of blocks - units = count - dimensions = () - type = integer - intent = in - optional = F [blksz] standard_name = ccpp_block_sizes long_name = for explicit data blocking: block sizes of all blocks @@ -81,28 +105,20 @@ type = integer intent = in optional = F -[nx] - standard_name = number_of_points_in_x_direction_for_this_MPI_rank - long_name = number of points in x direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in - optional = F -[ny] - standard_name = number_of_points_in_y_direction_for_this_MPI_rank - long_name = number of points in y direction for this MPI rank - units = count +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag dimensions = () - type = integer + type = logical intent = in optional = F -[im] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation + units = flag dimensions = () - type = integer + type = logical intent = in optional = F [xlat_d] @@ -123,22 +139,6 @@ kind = kind_phys intent = in optional = F -[levh2o_int] - standard_name = vertical_dimension_of_h2o_forcing_data - long_name = number of vertical layers in h2o forcing data - units = count - dimensions = () - type = integer - intent = in - optional = F -[levozp_int] - standard_name = vertical_dimension_of_ozone_forcing_data - long_name = number of vertical layers in ozone forcing data - units = count - dimensions = () - type = integer - intent = in - optional = F [ozpl] standard_name = ozone_forcing long_name = ozone forcing data @@ -166,6 +166,22 @@ kind = kind_phys intent = in optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F [jindx1_o3] standard_name = lower_ozone_interpolation_index long_name = interpolation low index for ozone @@ -182,15 +198,6 @@ type = integer intent = inout optional = F -[ddy_o3] - standard_name = ozone_interpolation_weight - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [jindx1_h] standard_name = lower_water_vapor_interpolation_index long_name = interpolation low index for stratospheric water vapor @@ -207,15 +214,6 @@ type = integer intent = inout optional = F -[ddy_h] - standard_name = water_vapor_interpolation_weight - long_name = interpolation high index for stratospheric water vapor - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [jindx1_aer] standard_name = lower_aerosol_y_interpolation_index long_name = interpolation low index for prescribed aerosols in the y direction @@ -232,15 +230,6 @@ type = integer intent = inout optional = F -[ddy_aer] - standard_name = aerosol_y_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the y direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [iindx1_aer] standard_name = lower_aerosol_x_interpolation_index long_name = interpolation low index for prescribed aerosols in the x direction @@ -257,15 +246,6 @@ type = integer intent = inout optional = F -[ddx_aer] - standard_name = aerosol_x_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the x direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [jindx1_ci] standard_name = lower_cloud_nuclei_y_interpolation_index long_name = interpolation low index for ice and cloud condensation nuclei in the y direction @@ -282,15 +262,6 @@ type = integer intent = inout optional = F -[ddy_ci] - standard_name = cloud_nuclei_y_interpolation_weight - long_name = interpolation high index for ice and cloud condensation nuclei in the y direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [iindx1_ci] standard_name = lower_cloud_nuclei_x_interpolation_index long_name = interpolation low index for ice and cloud condensation nuclei in the x direction @@ -307,6 +278,51 @@ type = integer intent = inout optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [ddx_ci] standard_name = cloud_nuclei_x_interpolation_weight long_name = interpolation high index for ice and cloud condensation nuclei in the x direction @@ -334,22 +350,6 @@ kind = kind_phys intent = inout optional = F -[imap] - standard_name = map_of_block_column_number_to_global_i_index - long_name = map of local index ix to global index i for this block - units = none - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jmap] - standard_name = map_of_block_column_number_to_global_j_index - long_name = map of local index ix to global index j for this block - units = none - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -394,61 +394,125 @@ [ccpp-arg-table] name = GFS_phys_time_vary_run type = scheme -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count dimensions = () - type = GFS_statein_type + type = integer intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count dimensions = () - type = GFS_control_type - intent = inout + type = integer + intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS miscellaneous data - units = DDT +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count dimensions = () - type = GFS_tbd_type - intent = inout + type = integer + intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = Fortran DDT containing FV3-GFS surface fields - units = DDT +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank + units = count dimensions = () - type = GFS_sfcprop_type - intent = inout + type = integer + intent = in optional = F -[Cldprop] - standard_name = GFS_cldprop_type_instance - long_name = Fortran DDT containing FV3-GFS cloud fields - units = DDT +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_cldprop_type - intent = inout + type = integer + intent = in optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = Fortran DDT containing FV3-GFS fields targeted for diagnostic output - units = DDT +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index dimensions = () - type = GFS_diag_type - intent = inout + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none + dimensions = () + type = integer + intent = in + optional = F +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsswr] + standard_name = number_of_timesteps_between_shortwave_radiation_calls + long_name = number of timesteps between shortwave radiation calls + units = + dimensions = () + type = integer + intent = in + optional = F +[nszero] + standard_name = number_of_timesteps_between_diagnostic_clearing + long_name = number of timesteps between calls to clear diagnostic variables + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[seed0] + standard_name = seed_random_numbers_RAS + long_name = random number seed for the RAS scheme + units = none + dimensions = () + type = integer + intent = in optional = F [first_time_step] standard_name = flag_for_first_time_step @@ -458,6 +522,397 @@ type = logical intent = in optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cal_pre] + standard_name = flag_for_precipitation_type_algorithm + long_name = flag controls precip type algorithm + units = flag + dimensions = () + type = logical + intent = in + optional = F +[random_clds] + standard_name = flag_for_random_clouds_for_RAS + long_name = flag for using random clouds with the RAS scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhzero] + standard_name = frequency_for_diagnostic_clearing + long_name = frequency for clearing diagnostic fields + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[blksz] + standard_name = ccpp_block_sizes + long_name = for explicit data blocking: block sizes of all blocks + units = count + dimensions = (ccpp_block_count) + type = integer + intent = in + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[clstp] + standard_name = convective_cloud_switch + long_name = index used by cnvc90 (for convective clouds) + units = none + dimensions = () + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rann] + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) + type = real + kind = kind_phys + intent = inout + optional = F +[in_nm] + standard_name = in_number_concentration + long_name = IN number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ccn_nm] + standard_name = ccn_number_concentration + long_name = CCN number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = inout + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = Fortran DDT containing FV3-GFS fields targeted for diagnostic output + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -474,4 +929,4 @@ dimensions = () type = integer intent = out - optional = F + optional = F \ No newline at end of file diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta index 04f7f1529..8341b3992 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -153,7 +153,7 @@ [nscyc] standard_name = number_of_timesteps_between_surface_cycling_calls long_name = number of timesteps between surface cycling calls - units = + units = count dimensions = () type = integer intent = in diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta index 3dc91952e..d3474e457 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/GFS_time_vary_pre.scm.meta @@ -137,7 +137,7 @@ [nscyc] standard_name = number_of_timesteps_between_surface_cycling_calls long_name = number of timesteps between surface cycling calls - units = + units = count dimensions = () type = integer intent = in From cd06bbd3877b382cd1703a44a6c98a31fcfb1aed Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 26 Aug 2020 10:18:53 -0600 Subject: [PATCH 037/274] clean up GFS_rrtmg_post --- physics/GFS_rrtmg_post.F90 | 37 +++-- physics/GFS_rrtmg_post.meta | 298 ++++++++++++++++++------------------ 2 files changed, 169 insertions(+), 166 deletions(-) diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index aacf9aaf5..6bd329921 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -13,32 +13,29 @@ end subroutine GFS_rrtmg_post_init !> \section arg_table_GFS_rrtmg_post_run Argument Table !! \htmlinclude GFS_rrtmg_post_run.html !! - subroutine GFS_rrtmg_post_run (lsswr, lslwr, lssav, fhlwr, fhswr, prsi, tgrs, sfcflw, sfcfsw, topflw, topfsw, coszen, coszdg, fluxr, & - scmpsw, nspc1, nfxr, im, km, kmp1, lm, ltp, kt, kb, kd, raddt, aerodp, & - cldsa, mtopa, mbota, clouds1, cldtaulw, cldtausw, nday, & - errmsg, errflg) + subroutine GFS_rrtmg_post_run (im, km, kmp1, lm, ltp, kt, kb, kd, nspc1, & + nfxr, nday, lsswr, lslwr, lssav, fhlwr, fhswr, raddt, coszen, & + coszdg, prsi, tgrs, aerodp, cldsa, mtopa, mbota, clouds1, & + cldtaulw, cldtausw, sfcflw, sfcfsw, topflw, topfsw, scmpsw, & + fluxr, errmsg, errflg) use machine, only: kind_phys - use module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & + cmpfsw_type use module_radlw_parameters, only: topflw_type, sfcflw_type implicit none ! Interface variables - type(sfcflw_type), dimension(im), intent(in) :: sfcflw - type(sfcfsw_type), dimension(im), intent(in) :: sfcfsw - type(cmpfsw_type), dimension(im), intent(in) :: scmpsw - type(topflw_type), dimension(im), intent(in) :: topflw - type(topfsw_type), dimension(im), intent(in) :: topfsw - - integer, intent(in) :: nspc1, nfxr, im, km, kmp1, lm, ltp, kt, kb, kd, nday - real(kind=kind_phys), intent(in) :: raddt, fhlwr, fhswr + integer, intent(in) :: im, km, kmp1, lm, ltp, kt, kb, kd, & + nspc1, nfxr, nday logical, intent(in) :: lsswr, lslwr, lssav + real(kind=kind_phys), intent(in) :: raddt, fhlwr, fhswr + + real(kind=kind_phys), dimension(im), intent(in) :: coszen, coszdg - real(kind=kind_phys), dimension(im), intent(in) :: coszen, coszdg - - real(kind=kind_phys), dimension(im,kmp1), intent(in) :: prsi - real(kind=kind_phys), dimension(im,km), intent(in) :: tgrs + real(kind=kind_phys), dimension(im,kmp1), intent(in) :: prsi + real(kind=kind_phys), dimension(im,km), intent(in) :: tgrs real(kind=kind_phys), dimension(im,NSPC1), intent(in) :: aerodp real(kind=kind_phys), dimension(im,5), intent(in) :: cldsa @@ -47,6 +44,12 @@ subroutine GFS_rrtmg_post_run (lsswr, lslwr, lssav, fhlwr, fhswr, prsi, tgrs, sf real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtausw real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: cldtaulw + type(sfcflw_type), dimension(im), intent(in) :: sfcflw + type(sfcfsw_type), dimension(im), intent(in) :: sfcfsw + type(cmpfsw_type), dimension(im), intent(in) :: scmpsw + type(topflw_type), dimension(im), intent(in) :: topflw + type(topfsw_type), dimension(im), intent(in) :: topfsw + real(kind=kind_phys), dimension(im,nfxr), intent(inout) :: fluxr character(len=*), intent(out) :: errmsg diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index e996236ab..a90791796 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -6,149 +6,6 @@ [ccpp-arg-table] name = GFS_rrtmg_post_run type = scheme -[lsswr] - standard_name = flag_to_calc_sw - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[lslwr] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[lssav] - standard_name = flag_diagnostics - long_name = logical flag for storing diagnostics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[fhlwr] - standard_name = frequency_for_longwave_radiation - long_name = frequency for longwave radiation - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[fhswr] - standard_name = frequency_for_shortwave_radiation - long_name = frequency for shortwave radiation - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[prsi] - standard_name = air_pressure_at_interface - long_name = air pressure at model layer interfaces - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[sfcflw] - standard_name = lw_fluxes_sfc - long_name = lw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcflw_type - intent = in - optional = F -[sfcfsw] - standard_name = sw_fluxes_sfc - long_name = sw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_loop_extent) - type = sfcfsw_type - intent = in - optional = F -[topflw] - standard_name = lw_fluxes_top_atmosphere - long_name = lw radiation fluxes at top - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topflw_type - intent = in - optional = F -[topfsw] - standard_name = sw_fluxes_top_atmosphere - long_name = sw radiation fluxes at toa - units = W m-2 - dimensions = (horizontal_loop_extent) - type = topfsw_type - intent = in - optional = F -[coszen] - standard_name = cosine_of_zenith_angle - long_name = mean cos of zenith angle over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[coszdg] - standard_name = daytime_mean_cosz_over_rad_call_period - long_name = daytime mean cosz over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fluxr] - standard_name = cumulative_radiation_diagnostic - long_name = time-accumulated 2D radiation-related diagnostic fields - units = various - dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) - type = real - kind = kind_phys - intent = inout - optional = F -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_loop_extent) - type = cmpfsw_type - intent = in - optional = F -[nspc1] - standard_name = number_of_species_for_aerosol_optical_depth - long_name = number of species for output aerosol optical depth plus total - units = count - dimensions = () - type = integer - intent = in - optional = F -[nfxr] - standard_name = number_of_radiation_diagnostic_variables - long_name = number of variables stored in the fluxr array - units = count - dimensions = () - type = integer - intent = in - optional = F [im] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -213,6 +70,72 @@ type = integer intent = in optional = F +[nspc1] + standard_name = number_of_species_for_aerosol_optical_depth + long_name = number of species for output aerosol optical depth plus total + units = count + dimensions = () + type = integer + intent = in + optional = F +[nfxr] + standard_name = number_of_radiation_diagnostic_variables + long_name = number of variables stored in the fluxr array + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step @@ -222,6 +145,42 @@ kind = kind_phys intent = in optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [aerodp] standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species @@ -283,14 +242,55 @@ kind = kind_phys intent = in optional = F -[nday] - standard_name = daytime_points_dimension - long_name = daytime points dimension - units = count - dimensions = () - type = integer +[sfcflw] + standard_name = lw_fluxes_sfc + long_name = lw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_loop_extent) + type = sfcflw_type + intent = in + optional = F +[sfcfsw] + standard_name = sw_fluxes_sfc + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_loop_extent) + type = sfcfsw_type intent = in optional = F +[topflw] + standard_name = lw_fluxes_top_atmosphere + long_name = lw radiation fluxes at top + units = W m-2 + dimensions = (horizontal_loop_extent) + type = topflw_type + intent = in + optional = F +[topfsw] + standard_name = sw_fluxes_top_atmosphere + long_name = sw radiation fluxes at toa + units = W m-2 + dimensions = (horizontal_loop_extent) + type = topfsw_type + intent = in + optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_loop_extent) + type = cmpfsw_type + intent = in + optional = F +[fluxr] + standard_name = cumulative_radiation_diagnostic + long_name = time-accumulated 2D radiation-related diagnostic fields + units = various + dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From f7e6770d2a20317beb0f86ccb247a71a91704b58 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 26 Aug 2020 10:30:23 -0600 Subject: [PATCH 038/274] clean upu rrtmg_lw_post --- physics/rrtmg_lw_post.F90 | 8 +++++--- physics/rrtmg_lw_post.meta | 18 +++++++++--------- 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/physics/rrtmg_lw_post.F90 b/physics/rrtmg_lw_post.F90 index 50d735f75..9a482e53e 100644 --- a/physics/rrtmg_lw_post.F90 +++ b/physics/rrtmg_lw_post.F90 @@ -17,7 +17,7 @@ end subroutine rrtmg_lw_post_init !! #endif subroutine rrtmg_lw_post_run (im, levs, ltp, lm, kd, lslwr, lwhtr, & - tsfa, htlwc, htlw0, sfcflw, tsflw, htrlw, lwhc, sfcdlw, & + tsfa, htlwc, htlw0, sfcflw, tsflw, sfcdlw, htrlw, lwhc, & errmsg, errflg) use machine, only: kind_phys @@ -25,12 +25,14 @@ subroutine rrtmg_lw_post_run (im, levs, ltp, lm, kd, lslwr, lwhtr, & implicit none - integer, intent(in) :: im, ltp, LM, kd, levs + integer, intent(in) :: im, levs, ltp, lm, kd logical, intent(in) :: lslwr, lwhtr + real(kind=kind_phys), dimension(im), intent(in) :: tsfa real(kind=kind_phys), dimension(im, LM+LTP), intent(in) :: htlwc real(kind=kind_phys), dimension(im, LM+LTP), intent(in) :: htlw0 - real(kind=kind_phys), dimension(im), intent(in) :: tsfa + type(sfcflw_type), dimension(im), intent(in) :: sfcflw + real(kind=kind_phys), dimension(im), intent(inout) :: tsflw, sfcdlw real(kind=kind_phys), dimension(im, levs), intent(inout) :: htrlw, lwhc character(len=*), intent(out) :: errmsg diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 447e3a066..9fdef489f 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -106,6 +106,15 @@ kind = kind_phys intent = inout optional = F +[sfcdlw] + standard_name = surface_downwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc downward lw flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [htrlw] standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate @@ -124,15 +133,6 @@ kind = kind_phys intent = inout optional = F -[sfcdlw] - standard_name = surface_downwelling_longwave_flux_on_radiation_time_step - long_name = total sky sfc downward lw flux - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 5fe8234cae90457f68f4f06ae5248602db32e187 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 26 Aug 2020 10:47:54 -0600 Subject: [PATCH 039/274] cleanup rrtmg_[sw,lw]_[pre,post] --- physics/rrtmg_lw_pre.F90 | 2 +- physics/rrtmg_sw_post.F90 | 27 ++++++++----- physics/rrtmg_sw_post.meta | 80 +++++++++++++++++++------------------- physics/rrtmg_sw_pre.F90 | 17 ++++---- 4 files changed, 68 insertions(+), 58 deletions(-) diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index c14053a10..b8f1d52e1 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -25,7 +25,7 @@ subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& integer, intent(in) :: im logical, intent(in) :: lslwr real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, slmsk, & - snowd, sncovr, zorl, hprime, tsfa, tsfg + snowd, sncovr, zorl, hprime, tsfg, tsfa real(kind=kind_phys), dimension(im), intent(out) :: semis character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/rrtmg_sw_post.F90 b/physics/rrtmg_sw_post.F90 index d234e7ef6..546395f02 100644 --- a/physics/rrtmg_sw_post.F90 +++ b/physics/rrtmg_sw_post.F90 @@ -16,10 +16,10 @@ end subroutine rrtmg_sw_post_init !! #endif subroutine rrtmg_sw_post_run (im, levr, levs, ltp, nday, lm, kd, lsswr, & - swhtr, htswc, htsw0, sfcalb1, sfcalb2, sfcalb3, sfcalb4, & - scmpsw, sfcfsw, topfsw, nirbmdi, nirdfdi, visbmdi, visdfdi, & - nirbmui, nirdfui, visbmui, visdfui, sfcdsw, sfcnsw, htrsw, & - swhc, errmsg, errflg) + swhtr, sfcalb1, sfcalb2, sfcalb3, sfcalb4, htswc, htsw0, & + nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui,& + visdfui, sfcdsw, sfcnsw, htrsw, swhc, scmpsw, sfcfsw, topfsw, & + errmsg, errflg) use machine, only: kind_phys use module_radsw_parameters, only: topfsw_type, sfcfsw_type, & @@ -27,17 +27,24 @@ subroutine rrtmg_sw_post_run (im, levr, levs, ltp, nday, lm, kd, lsswr, & implicit none - integer, intent(in) :: im, lm, kd, nday, levr, levs, ltp + integer, intent(in) :: im, levr, levs, & + ltp, nday, lm, kd logical, intent(in) :: lsswr, swhtr + real(kind=kind_phys), dimension(im), intent(in) :: sfcalb1, sfcalb2, & + sfcalb3, sfcalb4 real(kind=kind_phys), dimension(im, levr+LTP), intent(in) :: htswc, htsw0 - real(kind=kind_phys), dimension(im), intent(in) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 + + real(kind=kind_phys), dimension(im), intent(inout) :: nirbmdi, nirdfdi, & + visbmdi, visdfdi, & + nirbmui, nirdfui, & + visbmui, visdfui, & + sfcdsw, sfcnsw + real(kind=kind_phys), dimension(im,levs), intent(inout) :: htrsw, swhc + type(cmpfsw_type), dimension(im), intent(inout) :: scmpsw type(sfcfsw_type), dimension(im), intent(inout) :: sfcfsw type(topfsw_type), dimension(im), intent(inout) :: topfsw - real(kind=kind_phys), dimension(im), intent(inout) :: nirbmdi, nirdfdi, visbmdi, & - visdfdi, nirbmui, nirdfui, & - visbmui, visdfui, sfcdsw, sfcnsw - real(kind=kind_phys), dimension(im,levs), intent(inout) :: htrsw, swhc + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index ba1739e44..093a4e290 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -78,24 +78,6 @@ type = logical intent = in optional = F -[htswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels - long_name = total sky heating rate due to shortwave radiation - units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = in - optional = F -[htsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels - long_name = clear sky heating rates due to shortwave radiation - units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = in - optional = F [sfcalb1] standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam @@ -132,29 +114,23 @@ kind = kind_phys intent = in optional = F -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_dimension) - type = cmpfsw_type - intent = inout - optional = F -[sfcfsw] - standard_name = sw_fluxes_sfc - long_name = sw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_dimension) - type = sfcfsw_type - intent = inout +[htswc] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels + long_name = total sky heating rate due to shortwave radiation + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in optional = F -[topfsw] - standard_name = sw_fluxes_top_atmosphere - long_name = sw radiation fluxes at toa - units = W m-2 - dimensions = (horizontal_dimension) - type = topfsw_type - intent = inout +[htsw0] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels + long_name = clear sky heating rates due to shortwave radiation + units = K s-1 + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + type = real + kind = kind_phys + intent = in optional = F [nirbmdi] standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step @@ -264,6 +240,30 @@ kind = kind_phys intent = inout optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = inout + optional = F +[sfcfsw] + standard_name = sw_fluxes_sfc + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcfsw_type + intent = inout + optional = F +[topfsw] + standard_name = sw_fluxes_top_atmosphere + long_name = sw radiation fluxes at toa + units = W m-2 + dimensions = (horizontal_dimension) + type = topfsw_type + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 09e00019a..6cbeddf53 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -28,17 +28,20 @@ subroutine rrtmg_sw_pre_run (im, lsswr, pertalb, tsfg, tsfa, coszen, & integer, intent(in) :: im logical, intent(in) :: lsswr real(kind=kind_phys), dimension(5), intent(in) :: pertalb - real(kind=kind_phys), dimension(im), intent(in) :: tsfa, tsfg, coszen + real(kind=kind_phys), dimension(im), intent(in) :: tsfg, tsfa, coszen real(kind=kind_phys), dimension(im), intent(in) :: alb1d - real(kind=kind_phys), dimension(im), intent(in) :: slmsk, snowd, & - sncovr, snoalb, zorl, & - hprime, alvsf, alnsf, & - alvwf, alnwf, facsf, & - facwf, fice, tisfc + real(kind=kind_phys), dimension(im), intent(in) :: slmsk, snowd, & + sncovr, snoalb, & + zorl, hprime, & + alvsf, alnsf, & + alvwf, alnwf, & + facsf, facwf, & + fice, tisfc real(kind=kind_phys), dimension(im), intent(inout) :: sfalb integer, intent(out) :: nday integer, dimension(im), intent(out) :: idxday - real(kind=kind_phys), dimension(im), intent(out) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 + real(kind=kind_phys), dimension(im), intent(out) :: sfcalb1, sfcalb2, & + sfcalb3, sfcalb4 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables From 7349ae593b1be6e5293b4bb961da46fda6ede699 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 26 Aug 2020 21:52:08 -0600 Subject: [PATCH 040/274] remove GFS DDTs and physcons from GFS_rrtmg_pre --- physics/GFS_rrtmg_pre.F90 | 519 ++++++++++--------- physics/GFS_rrtmg_pre.meta | 1009 +++++++++++++++++++++++++++--------- 2 files changed, 1040 insertions(+), 488 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 6dc14497a..9b2faaf02 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -18,41 +18,30 @@ end subroutine GFS_rrtmg_pre_init !! ! Attention - the output arguments lm, im, lmk, lmp must not be set ! in the CCPP version - they are defined in the interstitial_create routine - subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input - Tbd, Cldprop, Coupling, & - Radtend, & ! input/output - imfdeepcnv, imfdeepcnv_gf, & - f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only - lm, im, lmk, lmp, & ! input - kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output - tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & - gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, & - gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, & - gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113, & - faersw1, faersw2, faersw3, & - faerlw1, faerlw2, faerlw3, aerodp, & - clouds1, clouds2, clouds3, clouds4, clouds5, clouds6, & - clouds7, clouds8, clouds9, cldsa, cldfra, & - mtopa, mbota, de_lgth, alb1d, errmsg, errflg) + subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, imfdeepcnv, & + imfdeepcnv_gf, me, ncnd, ntrac, num_p3d, npdf3d, ncnvcld3d, ntqv, ntcw,& + ntiw, ntlnc, ntinc, ncld, ntrw, ntsw, ntgl, ntwa, ntoz, ntclamt, & + nleffr, nieffr, nseffr, kdt, imp_physics, imp_physics_thompson, & + imp_physics_gfdl, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & + imp_physics_mg, imp_physics_wsm6, imp_physics_fer_hires, lsswr, lslwr, & + ltaerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf, lmfshal, & + lmfdeep2, do_sfcperts, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & + rog, rocp, con_rd, pertalb, xlat, xlon, coslat, sinlat, tsfc, slmsk, & + prsi, prsl, prslk, tgrs, sfc_wts, phy_f3d_mg_cld, phy_f3d_reffr, & + phy_f3d_cnvw, phy_f3d_cnvc, f_ice, f_rain, f_rimef, qgrs, aer_nm, & !inputs from here and above + coszen, coszdg, phy_f3d_leffr, phy_f3d_ieffr, phy_f3d_seffr, & + clouds1, clouds2, clouds3, clouds4, clouds5, & !in/out from here and above + kd, kt, kb, mtopa, mbota, raddt, tsfg, tsfa, de_lgth, alb1d, delp, dz, & !output from here and below + plvl, plyr, tlvl, tlyr, qlyr, olyr, gasvmr_co2, gasvmr_n2o, gasvmr_ch4,& + gasvmr_o2, gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, & + gasvmr_ccl4, gasvmr_cfc113, aerodp, clouds6, clouds7, clouds8, & + clouds9, cldsa, cldfra, faersw1, faersw2, faersw3, faerlw1, faerlw2, & + faerlw3, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, & - GFS_stateout_type, & - GFS_sfcprop_type, & - GFS_coupling_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_tbd_type, & - GFS_cldprop_type, & - GFS_radtend_type, & - GFS_diag_type + use physparam - use physcons, only: eps => con_eps, & - & epsm1 => con_epsm1, & - & fvirt => con_fvirt & - &, rog => con_rog & - &, rocp => con_rocp & - &, con_rd + use radcons, only: itsfc,ltp, lextop, qmin, & qme5, qme6, epsq, prsmin use funcphys, only: fpvs @@ -81,85 +70,126 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input implicit none - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid - type(GFS_sfcprop_type), intent(in) :: Sfcprop - type(GFS_statein_type), intent(in) :: Statein - type(GFS_radtend_type), intent(inout) :: Radtend - type(GFS_tbd_type), intent(in) :: Tbd - type(GFS_cldprop_type), intent(in) :: Cldprop - type(GFS_coupling_type), intent(in) :: Coupling - - integer, intent(in) :: im, lm, lmk, lmp - integer, intent(in) :: imfdeepcnv, imfdeepcnv_gf - integer, intent(out) :: kd, kt, kb - -! F-A mp scheme only - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: f_ice, & - f_rain, f_rimef - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: cwm - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin - real(kind=kind_phys), intent(out) :: raddt - - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: delp, & - dz, plyr, tlyr, qlyr, olyr - - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+1+LTP), intent(out) :: plvl, tlvl - - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: tsfg, tsfa - - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: gasvmr_co2, & - gasvmr_n2o, gasvmr_ch4, gasvmr_o2, gasvmr_co, gasvmr_cfc11, & - gasvmr_cfc12, gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113 - - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDSW), intent(out) :: faersw1, & - faersw2, faersw3 - - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDLW), intent(out) :: faerlw1, & - faerlw2, faerlw3 - - real(kind=kind_phys), dimension(size(Grid%xlon,1),NSPC1), intent(out) :: aerodp - - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(inout) :: clouds1, & - clouds2, clouds3, clouds4, clouds5 - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: clouds6, & - clouds7, clouds8, clouds9, cldfra - - real(kind=kind_phys), dimension(size(Grid%xlon,1),5), intent(out) :: cldsa - integer, dimension(size(Grid%xlon,1),3), intent(out) :: mbota, mtopa - real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: de_lgth, alb1d - + integer, intent(in) :: im, levs, lm, lmk, lmp, imfdeepcnv, & + imfdeepcnv_gf, me, ncnd, ntrac, & + num_p3d, npdf3d, ncnvcld3d, ntqv, & + ntcw, ntiw, ntlnc, ntinc, ncld, & + ntrw, ntsw, ntgl, ntwa, ntoz, & + ntclamt, nleffr, nieffr, nseffr, & + kdt, imp_physics, & + imp_physics_thompson, & + imp_physics_gfdl, & + imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, & + imp_physics_mg, imp_physics_wsm6, & + imp_physics_fer_hires + + logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, & + uni_cld, effr_in, do_mynnedmf, & + lmfshal, lmfdeep2, do_sfcperts + + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup + real(kind=kind_phys), intent(in) :: eps, epsm1, fvirt, rog, rocp, con_rd + + real(kind=kind_phys), dimension(:), intent(in) :: pertalb, xlat, xlon, & + coslat, sinlat, tsfc, & + slmsk + + real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, prslk, & + tgrs, sfc_wts, & + phy_f3d_mg_cld, & + phy_f3d_reffr, & + phy_f3d_cnvw, & + phy_f3d_cnvc + ! F-A mp scheme only + real(kind=kind_phys), dimension(im,lm+LTP), intent(in) :: f_ice, f_rain, & + f_rimef + + real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs, aer_nm + + real(kind=kind_phys), dimension(:), intent(inout) :: coszen, coszdg + + real(kind=kind_phys), dimension(:,:), intent(inout) :: phy_f3d_leffr, & + phy_f3d_ieffr, & + phy_f3d_seffr + real(kind=kind_phys), dimension(im,lm+LTP), intent(inout) :: clouds1, & + clouds2, clouds3, & + clouds4, clouds5 + + integer, intent(out) :: kd, kt, kb + + integer, dimension(im,3), intent(out) :: mbota, mtopa + + real(kind=kind_phys), intent(out) :: raddt + + real(kind=kind_phys), dimension(im), intent(out) :: tsfg, tsfa + real(kind=kind_phys), dimension(im), intent(out) :: de_lgth, & + alb1d + + real(kind=kind_phys), dimension(im,lm+LTP), intent(out) :: delp, dz, & + plyr, tlyr, & + qlyr, olyr + + real(kind=kind_phys), dimension(im,lm+1+LTP), intent(out) :: plvl, tlvl + + + + real(kind=kind_phys), dimension(im,lm+LTP), intent(out) :: gasvmr_co2, & + gasvmr_n2o, & + gasvmr_ch4, & + gasvmr_o2, & + gasvmr_co, & + gasvmr_cfc11,& + gasvmr_cfc12,& + gasvmr_cfc22,& + gasvmr_ccl4,& + gasvmr_cfc113 + real(kind=kind_phys), dimension(im,NSPC1), intent(out) :: aerodp + real(kind=kind_phys), dimension(im,lm+LTP), intent(out) :: clouds6, & + clouds7, & + clouds8, & + clouds9, & + cldfra + real(kind=kind_phys), dimension(im,5), intent(out) :: cldsa + + real(kind=kind_phys), dimension(im,lm+LTP,NBDSW), intent(out) :: faersw1,& + faersw2,& + faersw3 + + real(kind=kind_phys), dimension(im,lm+LTP,NBDLW), intent(out) :: faerlw1,& + faerlw2,& + faerlw3 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: me, nfxr, ntrac, ntcw, ntiw, ncld, ntrw, ntsw, ntgl, ncndl, ntlnc, ntinc, ntwa + integer :: ncndl - integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya, lyb + integer :: i, j, k, k1, k2, lsk, lv, n, itop, ibtc, LP1, lla, llb, lya,lyb real(kind=kind_phys) :: es, qs, delt, tem0d - real(kind=kind_phys), dimension(size(Grid%xlon,1)) :: cvt1, cvb1, tem1d, tskn + real(kind=kind_phys), dimension(im) :: cvt1, cvb1, tem1d, tskn - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP) :: & + real(kind=kind_phys), dimension(im,lm+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & cldcov, deltaq, cnvc, cnvw, & effrl, effri, effrr, effrs, rho, orho ! for Thompson MP - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP) :: & + real(kind=kind_phys), dimension(im,lm+LTP) :: & re_cloud, re_ice, re_snow, qv_mp, qc_mp, & qi_mp, qs_mp, nc_mp, ni_mp, nwfa - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP+1) :: tem2db -! real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP+1) :: hz + real(kind=kind_phys), dimension(im,lm+LTP+1) :: tem2db +! real(kind=kind_phys), dimension(im,lm+LTP+1) :: hz - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,min(4,Model%ncnd)) :: ccnd - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,2:Model%ntrac) :: tracer1 - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NF_CLDS) :: clouds - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NF_VGAS) :: gasvmr - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDSW,NF_AESW) ::faersw - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDLW,NF_AELW) ::faerlw + real(kind=kind_phys), dimension(im,lm+LTP,min(4,ncnd)) :: ccnd + real(kind=kind_phys), dimension(im,lm+LTP,2:ntrac) :: tracer1 + real(kind=kind_phys), dimension(im,lm+LTP,NF_CLDS) :: clouds + real(kind=kind_phys), dimension(im,lm+LTP,NF_VGAS) :: gasvmr + real(kind=kind_phys), dimension(im,lm+LTP,NBDSW,NF_AESW) :: faersw + real(kind=kind_phys), dimension(im,lm+LTP,NBDLW,NF_AELW) :: faerlw real(kind=kind_phys) :: qvs ! @@ -169,22 +199,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input errmsg = '' errflg = 0 - if (.not. (Model%lsswr .or. Model%lslwr)) return + if (.not. (lsswr .or. lslwr)) return !--- set commonly used integers - me = Model%me - NFXR = Model%nfxr - NTRAC = Model%ntrac ! tracers in grrad strip off sphum - start tracer1(2:NTRAC) - ntcw = Model%ntcw - ntiw = Model%ntiw - ntlnc = Model%ntlnc - ntinc = Model%ntinc - ncld = Model%ncld - ntrw = Model%ntrw - ntsw = Model%ntsw - ntgl = Model%ntgl - ntwa = Model%ntwa - ncndl = min(Model%ncnd,4) + ncndl = min(ncnd,4) LP1 = LM + 1 ! num of in/out levels @@ -221,7 +239,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif ! end if_ivflip_block endif ! end if_lextop_block - raddt = min(Model%fhswr, Model%fhlwr) + raddt = min(fhswr, fhlwr) ! print *,' in grrad : raddt=',raddt @@ -230,13 +248,13 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input if ( itsfc == 0 ) then ! use same sfc skin-air/ground temp do i = 1, IM - tskn(i) = Sfcprop%tsfc(i) - tsfg(i) = Sfcprop%tsfc(i) + tskn(i) = tsfc(i) + tsfg(i) = tsfc(i) enddo else ! use diff sfc skin-air/ground temp do i = 1, IM - tskn(i) = Sfcprop%tsfc(i) - tsfg(i) = Sfcprop%tsfc(i) + tskn(i) = tsfc(i) + tsfg(i) = tsfc(i) enddo endif @@ -245,34 +263,34 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! lsk = 0 - if (ivflip == 0 .and. lm < Model%levs) lsk = Model%levs - lm + if (ivflip == 0 .and. lm < levs) lsk = levs - lm ! convert pressure unit from pa to mb do k = 1, LM k1 = k + kd k2 = k + lsk do i = 1, IM - plvl(i,k1+kb) = Statein%prsi(i,k2+kb) * 0.01 ! pa to mb (hpa) - plyr(i,k1) = Statein%prsl(i,k2) * 0.01 ! pa to mb (hpa) - tlyr(i,k1) = Statein%tgrs(i,k2) - prslk1(i,k1) = Statein%prslk(i,k2) + plvl(i,k1+kb) = prsi(i,k2+kb) * 0.01 ! pa to mb (hpa) + plyr(i,k1) = prsl(i,k2) * 0.01 ! pa to mb (hpa) + tlyr(i,k1) = tgrs(i,k2) + prslk1(i,k1) = prslk(i,k2) rho(i,k1) = plyr(i,k1)/(con_rd*tlyr(i,k1)) orho(i,k1) = 1.0/rho(i,k1) !> - Compute relative humidity. - es = min( Statein%prsl(i,k2), fpvs( Statein%tgrs(i,k2) ) ) ! fpvs and prsl in pa - qs = max( QMIN, eps * es / (Statein%prsl(i,k2) + epsm1*es) ) - rhly(i,k1) = max( 0.0, min( 1.0, max(QMIN, Statein%qgrs(i,k2,1))/qs ) ) + es = min( prsl(i,k2), fpvs( tgrs(i,k2) ) ) ! fpvs and prsl in pa + qs = max( QMIN, eps * es / (prsl(i,k2) + epsm1*es) ) + rhly(i,k1) = max( 0.0, min( 1.0, max(QMIN, qgrs(i,k2,ntqv))/qs ) ) qstl(i,k1) = qs enddo enddo !--- recast remaining all tracers (except sphum) forcing them all to be positive - do j = 2, NTRAC + do j = 2, ntrac do k = 1, LM k1 = k + kd k2 = k + lsk - tracer1(:,k1,j) = max(0.0, Statein%qgrs(:,k2,j)) + tracer1(:,k1,j) = max(0.0, qgrs(:,k2,j)) enddo enddo ! @@ -281,28 +299,28 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input k1 = 1 + kd k2 = k1 + kb do i = 1, IM - plvl(i,k2) = 0.01 * Statein%prsi(i,1+kb) ! pa to mb (hpa) + plvl(i,k2) = 0.01 * prsi(i,1+kb) ! pa to mb (hpa) plyr(i,k1) = 0.5 * (plvl(i,k2+1) + plvl(i,k2)) prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp enddo else k1 = 1 + kd do i = 1, IM - plvl(i,k1) = Statein%prsi(i,1) * 0.01 ! pa to mb (hpa) + plvl(i,k1) = prsi(i,1) * 0.01 ! pa to mb (hpa) enddo endif else ! input data from sfc to top - if (Model%levs > lm) then + if (levs > lm) then k1 = lm + kd do i = 1, IM - plvl(i,k1+1) = 0.01 * Statein%prsi(i,Model%levs+1) ! pa to mb (hpa) + plvl(i,k1+1) = 0.01 * prsi(i,levs+1) ! pa to mb (hpa) plyr(i,k1) = 0.5 * (plvl(i,k1+1) + plvl(i,k1)) prslk1(i,k1) = (plyr(i,k1)*0.001) ** rocp enddo else k1 = lp1 + kd do i = 1, IM - plvl(i,k1) = Statein%prsi(i,lp1) * 0.01 ! pa to mb (hpa) + plvl(i,k1) = prsi(i,lp1) * 0.01 ! pa to mb (hpa) enddo endif endif @@ -326,22 +344,21 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input !> - Get layer ozone mass mixing ratio (if use ozone climatology data, !! call getozn()). - if (Model%ntoz > 0) then ! interactive ozone generation + if (ntoz > 0) then ! interactive ozone generation do k=1,lmk do i=1,im - olyr(i,k) = max( QMIN, tracer1(i,k,Model%ntoz) ) + olyr(i,k) = max( QMIN, tracer1(i,k,ntoz) ) enddo enddo else ! climatological ozone - call getozn (prslk1, Grid%xlat, IM, LMK, & ! --- inputs - olyr) ! --- outputs + call getozn (prslk1, xlat, im, lmk, & ! --- inputs + olyr) ! --- outputs endif ! end_if_ntoz !> - Call coszmn(), to compute cosine of zenith angle (only when SW is called) - if (Model%lsswr) then - call coszmn (Grid%xlon,Grid%sinlat, & ! --- inputs - Grid%coslat,Model%solhr, IM, me, & - Radtend%coszen, Radtend%coszdg) ! --- outputs + if (lsswr) then + call coszmn (xlon,sinlat,coslat,solhr,im,me, & ! --- inputs + coszen, coszdg) ! --- outputs endif !> - Call getgases(), to set up non-prognostic gas volume mixing @@ -359,8 +376,8 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! --- ... set up non-prognostic gas volume mixing ratioes - call getgases (plvl, Grid%xlon, Grid%xlat, IM, LMK, & ! --- inputs - gasvmr) ! --- outputs + call getgases (plvl, xlon, xlat, IM, LMK, & ! --- inputs + gasvmr) ! --- outputs !CCPP: re-assign gasvmr(:,:,NF_VGAS) to gasvmr_X(:,:) do k = 1, LMK @@ -400,9 +417,9 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do k = 1, LM k1 = k + kd do i = 1, IM - qlyr(i,k1) = max( tem1d(i), Statein%qgrs(i,k,1) ) + qlyr(i,k1) = max( tem1d(i), qgrs(i,k,ntqv) ) tem1d(i) = min( QME5, qlyr(i,k1) ) - tvly(i,k1) = Statein%tgrs(i,k) * (1.0 + fvirt*qlyr(i,k1)) ! virtual T (K) + tvly(i,k1) = tgrs(i,k) * (1.0 + fvirt*qlyr(i,k1)) ! virtual T (K) delp(i,k1) = plvl(i,k1+1) - plvl(i,k1) enddo enddo @@ -451,9 +468,9 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do k = LM, 1, -1 do i = 1, IM - qlyr(i,k) = max( tem1d(i), Statein%qgrs(i,k,1) ) + qlyr(i,k) = max( tem1d(i), qgrs(i,k,ntqv) ) tem1d(i) = min( QME5, qlyr(i,k) ) - tvly(i,k) = Statein%tgrs(i,k) * (1.0 + fvirt*qlyr(i,k)) ! virtual T (K) + tvly(i,k) = tgrs(i,k) * (1.0 + fvirt*qlyr(i,k)) ! virtual T (K) delp(i,k) = plvl(i,k) - plvl(i,k+1) enddo enddo @@ -495,11 +512,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input !check print *,' in grrad : calling setaer ' - call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & ! --- inputs - tracer1, Tbd%aer_nm, & - Grid%xlon, Grid%xlat, IM, LMK, LMP, & - Model%lsswr,Model%lslwr, & - faersw,faerlw,aerodp) ! --- outputs + call setaer (plvl, plyr, prslk1, tvly, rhly, slmsk, & ! --- inputs + tracer1, aer_nm, xlon, xlat, IM, LMK, LMP,& + lsswr,lslwr, & + faersw,faerlw,aerodp) ! --- outputs ! CCPP do j = 1,NBDSW @@ -537,20 +553,20 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! if (ntcw > 0) then ! prognostic cloud schemes ccnd = 0.0_kind_phys - if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist + if (ncnd == 1) then ! Zhao_Carr_Sundqvist do k=1,LMK do i=1,IM - ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water/ice + ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water/ice enddo enddo - elseif (Model%ncnd == 2) then ! MG or F-A + elseif (ncnd == 2) then ! MG or F-A do k=1,LMK do i=1,IM - ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water - ccnd(i,k,2) = tracer1(i,k,ntiw) ! ice water + ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water + ccnd(i,k,2) = tracer1(i,k,ntiw) ! ice water enddo enddo - elseif (Model%ncnd == 4) then ! MG2 + elseif (ncnd == 4) then ! MG2 do k=1,LMK do i=1,IM ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water @@ -559,7 +575,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(i,k,4) = tracer1(i,k,ntsw) ! snow water enddo enddo - elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3 + elseif (ncnd == 5) then ! GFDL MP, Thompson, MG3 do k=1,LMK do i=1,IM ccnd(i,k,1) = tracer1(i,k,ntcw) ! liquid water @@ -569,10 +585,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo ! for Thompson MP - prepare variables for calc_effr - if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then + if (imp_physics == imp_physics_thompson .and. ltaerosol) then do k=1,LMK do i=1,IM - qvs = Statein%qgrs(i,k,1) + qvs = qgrs(i,k,ntqv) qv_mp (i,k) = qvs/(1.-qvs) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) @@ -582,10 +598,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input nwfa (i,k) = tracer1(i,k,ntwa) enddo enddo - elseif (Model%imp_physics == Model%imp_physics_thompson) then + elseif (imp_physics == imp_physics_thompson) then do k=1,LMK do i=1,IM - qvs = Statein%qgrs(i,k,1) + qvs = qgrs(i,k,ntqv) qv_mp (i,k) = qvs/(1.-qvs) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) @@ -603,17 +619,17 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo enddo - if (Model%imp_physics == Model%imp_physics_gfdl ) then - if (.not. Model%lgfdlmprad) then + if (imp_physics == imp_physics_gfdl ) then + if (.not. lgfdlmprad) then ! rsun the summation methods and order make the difference in calculation -! clw(:,:) = clw(:,:) + tracer1(:,1:LMK,Model%ntcw) & -! + tracer1(:,1:LMK,Model%ntiw) & -! + tracer1(:,1:LMK,Model%ntrw) & -! + tracer1(:,1:LMK,Model%ntsw) & -! + tracer1(:,1:LMK,Model%ntgl) +! clw(:,:) = clw(:,:) + tracer1(:,1:LMK,ntcw) & +! + tracer1(:,1:LMK,ntiw) & +! + tracer1(:,1:LMK,ntrw) & +! + tracer1(:,1:LMK,ntsw) & +! + tracer1(:,1:LMK,ntgl) ccnd(:,:,1) = tracer1(:,1:LMK,ntcw) ccnd(:,:,1) = ccnd(:,:,1) + tracer1(:,1:LMK,ntrw) ccnd(:,:,1) = ccnd(:,:,1) + tracer1(:,1:LMK,ntiw) @@ -621,7 +637,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ccnd(:,:,1) = ccnd(:,:,1) + tracer1(:,1:LMK,ntgl) ! else -! do j=1,Model%ncld +! do j=1,ncld ! ccnd(:,:,1) = ccnd(:,:,1) + tracer1(:,1:LMK,ntcw+j-1) ! cloud condensate amount ! enddo endif @@ -632,34 +648,34 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo endif ! - if (Model%uni_cld) then - if (Model%effr_in) then + if (uni_cld) then + if (effr_in) then do k=1,lm k1 = k + kd do i=1,im - cldcov(i,k1) = Tbd%phy_f3d(i,k,Model%indcld) - effrl(i,k1) = Tbd%phy_f3d(i,k,2) - effri(i,k1) = Tbd%phy_f3d(i,k,3) - effrr(i,k1) = Tbd%phy_f3d(i,k,4) - effrs(i,k1) = Tbd%phy_f3d(i,k,5) + cldcov(i,k1) = phy_f3d_mg_cld(i,k) + effrl(i,k1) = phy_f3d_leffr(i,k) + effri(i,k1) = phy_f3d_ieffr(i,k) + effrr(i,k1) = phy_f3d_reffr(i,k) + effrs(i,k1) = phy_f3d_seffr(i,k) enddo enddo else do k=1,lm k1 = k + kd do i=1,im - cldcov(i,k1) = Tbd%phy_f3d(i,k,Model%indcld) + cldcov(i,k1) = phy_f3d_mg_cld(i,k) enddo enddo endif - elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP - if (Model%do_mynnedmf .and. Model%kdt>1) THEN + elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP + if (do_mynnedmf .and. kdt>1) THEN do k=1,lm k1 = k + kd do i=1,im if (tracer1(i,k1,ntrw)>1.0e-7 .OR. tracer1(i,k1,ntsw)>1.0e-7) then ! GFDL cloud fraction - cldcov(i,k1) = tracer1(I,k1,Model%ntclamt) + cldcov(i,k1) = tracer1(I,k1,ntclamt) else ! MYNN sub-grid cloud fraction cldcov(i,k1) = clouds1(i,k1) @@ -668,37 +684,37 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo else ! GFDL cloud fraction - cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,Model%ntclamt) + cldcov(1:IM,1+kd:LM+kd) = tracer1(1:IM,1:LM,ntclamt) endif - if(Model%effr_in) then + if(effr_in) then do k=1,lm k1 = k + kd do i=1,im - effrl(i,k1) = Tbd%phy_f3d(i,k,1) - effri(i,k1) = Tbd%phy_f3d(i,k,2) - effrr(i,k1) = Tbd%phy_f3d(i,k,3) - effrs(i,k1) = Tbd%phy_f3d(i,k,4) -! if(Model%me==0) then + effrl(i,k1) = phy_f3d_leffr(i,k) + effri(i,k1) = phy_f3d_ieffr(i,k) + effrr(i,k1) = phy_f3d_reffr(i,k) + effrs(i,k1) = phy_f3d_seffr(i,k) +! if(me==0) then ! if(effrl(i,k1)> 5.0) then -! write(6,*) 'rad driver:cloud radii:',Model%kdt, i,k1, & +! write(6,*) 'rad driver:cloud radii:',kdt, i,k1, & ! effrl(i,k1) ! endif ! if(effrs(i,k1)==0.0) then -! write(6,*) 'rad driver:snow mixing ratio:',Model%kdt, i,k1, & +! write(6,*) 'rad driver:snow mixing ratio:',kdt, i,k1, & ! tracer1(i,k,ntsw) ! endif ! endif enddo enddo endif - elseif (Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP + elseif (imp_physics == imp_physics_thompson) then ! Thompson MP ! ! Compute effective radii for QC, QI, QS with (GF, MYNN) or without (all others) sub-grid clouds ! ! Update number concentration, consistent with sub-grid clouds (GF, MYNN) or without (all others) do k=1,lm do i=1,im - if (Model%ltaerosol .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then + if (ltaerosol .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)) * orho(i,k) endif if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then @@ -737,9 +753,9 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input do k=1,lm k1 = k + kd do i=1,im - Tbd%phy_f3d(i,k,Model%nleffr) = effrl(i,k1) - Tbd%phy_f3d(i,k,Model%nieffr) = effri(i,k1) - Tbd%phy_f3d(i,k,Model%nseffr) = effrs(i,k1) + phy_f3d_leffr(i,k) = effrl(i,k1) + phy_f3d_ieffr(i,k) = effri(i,k1) + phy_f3d_seffr(i,k) = effrs(i,k1) enddo enddo else ! all other cases @@ -753,25 +769,27 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! for zhao/moorthi's (imp_phys=99) & ! ferrier's (imp_phys=5) microphysics schemes - if ((Model%num_p3d == 4) .and. (Model%npdf3d == 3)) then ! same as Model%imp_physics = 99 + if ((num_p3d == 4) .and. (npdf3d == 3)) then ! same as imp_physics = 98 do k=1,lm k1 = k + kd do i=1,im - deltaq(i,k1) = Tbd%phy_f3d(i,k,5) - cnvw (i,k1) = Tbd%phy_f3d(i,k,6) - cnvc (i,k1) = Tbd%phy_f3d(i,k,7) + !GJF: this is not consistent with GFS_typedefs, + ! but it looks like the Zhao-Carr-PDF scheme is not in the CCPP + deltaq(i,k1) = 0.0!Tbd%phy_f3d(i,k,5) !GJF: this variable is not in phy_f3d anymore + cnvw (i,k1) = phy_f3d_cnvw(i,k) + cnvc (i,k1) = phy_f3d_cnvc(i,k) enddo enddo - elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then ! same as MOdel%imp_physics=98 + elseif ((npdf3d == 0) .and. (ncnvcld3d == 1)) then ! same as imp_physics=99 do k=1,lm k1 = k + kd do i=1,im deltaq(i,k1) = 0.0 - cnvw (i,k1) = Tbd%phy_f3d(i,k,Model%num_p3d+1) + cnvw (i,k1) = phy_f3d_cnvw(i,k) cnvc (i,k1) = 0.0 enddo enddo - else ! all the rest + else ! all the rest do k=1,lmk do i=1,im deltaq(i,k) = 0.0 @@ -788,7 +806,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input cnvw (i,lyb) = cnvw (i,lya) cnvc (i,lyb) = cnvc (i,lya) enddo - if (Model%effr_in) then + if (effr_in) then do i=1,im effrl(i,lyb) = effrl(i,lya) effri(i,lyb) = effri(i,lya) @@ -798,86 +816,78 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif endif - if (Model%imp_physics == 99) then + if (imp_physics == imp_physics_zhao_carr) then ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK) endif - if (Model%imp_physics == 99 .or. Model%imp_physics == 10) then ! zhao/moorthi's prognostic cloud scheme + if (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_mg) then ! zhao/moorthi's prognostic cloud scheme ! or unified cloud and/or with MG microphysics - if (Model%uni_cld .and. Model%ncld >= 2) then + if (uni_cld .and. ncld >= 2) then call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk,dz,delp, & + xlat, xlon, slmsk, dz, delp, & IM, LMK, LMP, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & + effrl, effri, effrr, effrs, effr_in, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else - call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs - ccnd(1:IM,1:LMK,1), Grid%xlat,Grid%xlon, & - Sfcprop%slmsk, dz, delp, IM, LMK, LMP, & - Model%uni_cld, Model%lmfshal, & - Model%lmfdeep2, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & - clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs + call progcld1 (plyr ,plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs + ccnd(1:IM,1:LMK,1), xlat, xlon, slmsk, dz, & + delp, IM, LMK, LMP, uni_cld, lmfshal, lmfdeep2,& + cldcov, effrl, effri, effrr, effrs, effr_in, & + clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 98) then ! zhao/moorthi's prognostic cloud+pdfcld + elseif(imp_physics == imp_physics_zhao_carr_pdf) then ! zhao/moorthi's prognostic cloud+pdfcld - call progcld3 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs - ccnd(1:IM,1:LMK,1), & - cnvw, cnvc, Grid%xlat, Grid%xlon, & - Sfcprop%slmsk, dz, delp, im, lmk, lmp, deltaq, & - Model%sup, Model%kdt, me, & + call progcld3 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs + ccnd(1:IM,1:LMK,1), cnvw, cnvc, xlat, xlon, & + slmsk, dz, delp, im, lmk, lmp, deltaq, sup, kdt, & + me, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs - elseif (Model%imp_physics == 11) then ! GFDL cloud scheme + elseif (imp_physics == imp_physics_gfdl) then ! GFDL cloud scheme - if (.not.Model%lgfdlmprad) then + if (.not. lgfdlmprad) then call progcld4 (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs - ccnd(1:IM,1:LMK,1), cnvw, cnvc, & - Grid%xlat, Grid%xlon, Sfcprop%slmsk, & - cldcov, dz, delp, im, lmk, lmp, & + ccnd(1:IM,1:LMK,1), cnvw, cnvc, xlat, xlon, & + slmsk, cldcov, dz, delp, im, lmk, lmp, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else - call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & - IM, LMK, LMP, cldcov, & - effrl, effri, effrr, effrs, Model%effr_in, & + call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, xlat, & ! --- inputs + xlon, slmsk, dz,delp, IM, LMK, LMP, cldcov, & + effrl, effri, effrr, effrs, effr_in, & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs ! call progcld4o (plyr, plvl, tlyr, tvly, qlyr, qstl, rhly, & ! --- inputs -! tracer1, Grid%xlat, Grid%xlon, Sfcprop%slmsk, & -! dz, delp, & -! ntrac-1, Model%ntcw-1,Model%ntiw-1,Model%ntrw-1,& -! Model%ntsw-1,Model%ntgl-1,Model%ntclamt-1, & +! tracer1, xlat, xlon, slmsk, dz, delp, & +! ntrac-1, ntcw-1,ntiw-1,ntrw-1, & +! ntsw-1,ntgl-1,ntclamt-1, & ! im, lmk, lmp, & ! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 6 .or. Model%imp_physics == 15) then - if (Model%kdt == 1) then - Tbd%phy_f3d(:,:,Model%nleffr) = 10. - Tbd%phy_f3d(:,:,Model%nieffr) = 50. - Tbd%phy_f3d(:,:,Model%nseffr) = 250. + elseif(imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_fer_hires) then + if (kdt == 1) then + phy_f3d_leffr(:,:) = 10. + phy_f3d_ieffr(:,:) = 50. + phy_f3d_seffr(:,:) = 250. endif call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + xlat,xlon,slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & - Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & + im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, & + cldcov(:,1:LMK),phy_f3d_leffr(:,:), & + phy_f3d_ieffr(:,:), phy_f3d_seffr(:,:), & clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - elseif(Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP + elseif(imp_physics == imp_physics_thompson) then ! Thompson MP - if(Model%do_mynnedmf .or. & - Model%imfdeepcnv == Model%imfdeepcnv_gf ) then ! MYNN PBL or GF conv + if(do_mynnedmf .or. imfdeepcnv == imfdeepcnv_gf ) then ! MYNN PBL or GF conv !-- MYNN PBL or convective GF !-- use cloud fractions with SGS clouds do k=1,lmk @@ -889,27 +899,26 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! --- use clduni as with the GFDL microphysics. ! --- make sure that effr_in=.true. in the input.nml! call progclduni (plyr, plvl, tlyr, tvly, ccnd, ncndl, & ! --- inputs - Grid%xlat, Grid%xlon, Sfcprop%slmsk, dz,delp, & - IM, LMK, LMP, clouds(:,1:LMK,1), & - effrl, effri, effrr, effrs, Model%effr_in , & + xlat, xlon, slmsk, dz, delp, IM, LMK, LMP, & + clouds(:,1:LMK,1), & + effrl, effri, effrr, effrs, effr_in , & clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs else ! MYNN PBL or GF convective are not used call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs - Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & + xlat,xlon,slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & - im, lmk, lmp, Model%uni_cld, & - Model%lmfshal,Model%lmfdeep2, & - cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & - Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs + im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, & + cldcov(:,1:LMK), phy_f3d_leffr(:,:), & + phy_f3d_ieffr(:,:), phy_f3d_seffr(:,:), & + clouds, cldsa, mtopa ,mbota, de_lgth) ! --- outputs endif ! MYNN PBL or GF endif ! end if_imp_physics -! endif ! end_if_ntcw +! endif ! end_if_ntcw do k = 1, LMK do i = 1, IM @@ -931,10 +940,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! perturbation size ! --- turn vegetation fraction pattern into percentile pattern alb1d(:) = 0. - if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then + if (do_sfcperts) then + if (pertalb(1) > 0.) then do i=1,im - call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + call cdfnor(sfc_wts(i,5),alb1d(i)) enddo endif endif diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 9d51e708d..dd021df6d 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -6,69 +6,615 @@ [ccpp-arg-table] name = GFS_rrtmg_pre_run type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = Fortran DDT containing FV3-GFS surface fields - units = DDT +[lm] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical layers for radiation calculation + units = count dimensions = () - type = GFS_sfcprop_type + type = integer intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore - units = DDT +[lmk] + standard_name = adjusted_vertical_layer_dimension_for_radiation + long_name = number of vertical layers for radiation + units = count dimensions = () - type = GFS_statein_type + type = integer intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS data not yet assigned to a defined container - units = DDT +[lmp] + standard_name = adjusted_vertical_level_dimension_for_radiation + long_name = number of vertical levels for radiation + units = count dimensions = () - type = GFS_tbd_type + type = integer intent = in optional = F -[Cldprop] - standard_name = GFS_cldprop_type_instance - long_name = Fortran DDT containing FV3-GFS cloud fields needed by radiation from physics - units = DDT +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag dimensions = () - type = GFS_cldprop_type + type = integer intent = in optional = F -[Coupling] - standard_name = GFS_coupling_type_instance - long_name = Fortran DDT containing FV3-GFS fields needed for coupling - units = DDT +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag dimensions = () - type = GFS_coupling_type + type = integer intent = in optional = F -[Radtend] - standard_name = GFS_radtend_type_instance - long_name = Fortran DDT containing FV3-GFS radiation tendencies - units = DDT +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_radtend_type - intent = inout + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[num_p3d] + standard_name = array_dimension_of_3d_arrays_for_microphysics + long_name = number of 3D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[npdf3d] + standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds + long_name = number of 3d arrays associated with pdf based clouds/mp + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnvcld3d] + standard_name = number_of_convective_3d_cloud_fields + long_name = number of convective 3d clouds fields + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ncld] + standard_name = number_of_hydrometeors + long_name = choice of cloud scheme / number of hydrometeors + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntwa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntclamt] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[nleffr] + standard_name = index_for_cloud_liquid_water_effective_radius + long_name = the index of cloud liquid water effective radius in phy_f3d + units = + dimensions = () + type = integer + intent = in + optional = F +[nieffr] + standard_name = index_for_ice_effective_radius + long_name = the index of ice effective radius in phy_f3d + units = + dimensions = () + type = integer + intent = in + optional = F +[nseffr] + standard_name = index_for_snow_effective_radius + long_name = the index of snow effective radius in phy_f3d + units = + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_wsm6] + standard_name = flag_for_wsm6_microphysics_scheme + long_name = choice of WSM6 microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_fer_hires] + standard_name = flag_for_fer_hires_microphysics_scheme + long_name = choice of Ferrier-Aligo microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lgfdlmprad] + standard_name = flag_for_GFDL_microphysics_radiation_interaction + long_name = flag for GFDL microphysics-radiation interaction + units = flag + dimensions = () + type = logical + intent = in + optional = F +[uni_cld] + standard_name = flag_for_uni_cld + long_name = flag for uni_cld + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = + dimensions = () + type = logical + intent = in + optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfshal] + standard_name = flag_for_lmfshal + long_name = flag for lmfshal + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfdeep2] + standard_name = flag_for_scale_aware_mass_flux_convection + long_name = flag for some scale-aware mass-flux convection scheme active + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_sfcperts] + standard_name = flag_for_stochastic_surface_perturbations + long_name = flag for stochastic surface perturbations option + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhlwr] + standard_name = frequency_for_longwave_radiation + long_name = frequency for longwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[solhr] + standard_name = forecast_hour_of_the_day + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sup] + standard_name = ice_supersaturation_threshold + long_name = ice supersaturation parameter for PDF clouds + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rog] + standard_name = ratio_of_gas_constant_dry_air_to_gravitational_acceleration + long_name = (rd/g) + units = J s2 K-1 kg-1 m-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rocp] + standard_name = ratio_of_gas_constant_dry_air_to_specific_heat_of_dry_air_at_constant_pressure + long_name = (rd/cp) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pertalb] + standard_name = magnitude_of_surface_albedo_perturbation + long_name = magnitude of surface albedo perturbation + units = frac + dimensions = (5) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_wts] + standard_name = weights_for_stochastic_surface_physics_perturbation + long_name = weights for stochastic surface physics perturbation + units = none + dimensions = (horizontal_dimension,number_of_surface_perturbations) + type = real + kind = kind_phys + intent = in + optional = F +[phy_f3d_mg_cld] + standard_name = cloud_fraction_for_MG + long_name = cloud fraction used by Morrison-Gettelman MP + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phy_f3d_reffr] + standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um + long_name = effective radius of cloud rain particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phy_f3d_cnvw] + standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d + long_name = convective cloud water mixing ratio in the phy_f3d array + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phy_f3d_cnvc] + standard_name = convective_cloud_cover_in_phy_f3d + long_name = convective cloud cover in the phy_f3d array + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in optional = F [f_ice] standard_name = fraction_of_ice_water_cloud @@ -97,55 +643,113 @@ kind = kind_phys intent = in optional = F -[flgmin] - standard_name = minimum_large_ice_fraction - long_name = minimum large ice fraction in F-A mp scheme - units = frac - dimensions = (2) +[qgrs] + standard_name = tracer_concentration + long_name = model layer mean tracer concentration + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in optional = F -[cwm] - standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics - long_name = total cloud condensate mixing ratio (except water vapor) updated by physics - units = kg kg-1 +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[coszdg] + standard_name = daytime_mean_cosz_over_rad_call_period + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[phy_f3d_leffr] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F -[lm] - standard_name = number_of_vertical_layers_for_radiation_calculations - long_name = number of vertical layers for radiation calculation - units = count - dimensions = () - type = integer - intent = in +[phy_f3d_ieffr] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout optional = F -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in +[phy_f3d_seffr] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout optional = F -[lmk] - standard_name = adjusted_vertical_layer_dimension_for_radiation - long_name = number of vertical layers for radiation - units = count - dimensions = () - type = integer - intent = in +[clouds1] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout optional = F -[lmp] - standard_name = adjusted_vertical_level_dimension_for_radiation - long_name = number of vertical levels for radiation - units = count - dimensions = () - type = integer - intent = in +[clouds2] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds3] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds4] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clouds5] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout optional = F [kd] standard_name = vertical_index_difference_between_inout_and_local @@ -171,6 +775,22 @@ type = integer intent = out optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step @@ -180,6 +800,42 @@ kind = kind_phys intent = out optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[alb1d] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [delp] standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness on radiation levels @@ -234,24 +890,6 @@ kind = kind_phys intent = out optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [qlyr] standard_name = water_vapor_specific_humidity_at_layer_for_radiation long_name = water vapor specific humidity at vertical layer for radiation calculation @@ -270,22 +908,6 @@ kind = kind_phys intent = out optional = F -[imfdeepcnv] - standard_name = flag_for_mass_flux_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imfdeepcnv_gf] - standard_name = flag_for_gf_deep_convection_scheme - long_name = flag for Grell-Freitas deep convection scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [gasvmr_co2] standard_name = volume_mixing_ratio_co2 long_name = CO2 volume mixing ratio @@ -376,60 +998,6 @@ kind = kind_phys intent = out optional = F -[faersw1] - standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 - long_name = aerosol optical depth for shortwave bands 01-16 - units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys - intent = out - optional = F -[faersw2] - standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 - long_name = aerosol single scattering albedo for shortwave bands 01-16 - units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys - intent = out - optional = F -[faersw3] - standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 - long_name = aerosol asymmetry parameter for shortwave bands 01-16 - units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) - type = real - kind = kind_phys - intent = out - optional = F -[faerlw1] - standard_name = aerosol_optical_depth_for_longwave_bands_01_16 - long_name = aerosol optical depth for longwave bands 01-16 - units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys - intent = out - optional = F -[faerlw2] - standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 - long_name = aerosol single scattering albedo for longwave bands 01-16 - units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys - intent = out - optional = F -[faerlw3] - standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 - long_name = aerosol asymmetry parameter for longwave bands 01-16 - units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) - type = real - kind = kind_phys - intent = out - optional = F [aerodp] standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species @@ -439,51 +1007,6 @@ kind = kind_phys intent = out optional = F -[clouds1] - standard_name = total_cloud_fraction - long_name = layer total cloud fraction - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds2] - standard_name = cloud_liquid_water_path - long_name = layer cloud liquid water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds3] - standard_name = mean_effective_radius_for_liquid_cloud - long_name = mean effective radius for liquid cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds4] - standard_name = cloud_ice_water_path - long_name = layer cloud ice water path - units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[clouds5] - standard_name = mean_effective_radius_for_ice_cloud - long_name = mean effective radius for ice cloud - units = micron - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [clouds6] standard_name = cloud_rain_water_path long_name = cloud rain water path @@ -538,36 +1061,56 @@ kind = kind_phys intent = out optional = F -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops - units = index - dimensions = (horizontal_dimension,3) - type = integer +[faersw1] + standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 + long_name = aerosol optical depth for shortwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys intent = out optional = F -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases - units = index - dimensions = (horizontal_dimension,3) - type = integer +[faersw2] + standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 + long_name = aerosol single scattering albedo for shortwave bands 01-16 + units = frac + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + type = real + kind = kind_phys intent = out optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_dimension) +[faersw3] + standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 + long_name = aerosol asymmetry parameter for shortwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = out optional = F -[alb1d] - standard_name = surface_albedo_perturbation - long_name = surface albedo perturbation +[faerlw1] + standard_name = aerosol_optical_depth_for_longwave_bands_01_16 + long_name = aerosol optical depth for longwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faerlw2] + standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 + long_name = aerosol single scattering albedo for longwave bands 01-16 units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + type = real + kind = kind_phys + intent = out + optional = F +[faerlw3] + standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 + long_name = aerosol asymmetry parameter for longwave bands 01-16 + units = none + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = out From d4d823e919d80a010866414b79b0a6a3643c6910 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 27 Aug 2020 09:36:57 -0600 Subject: [PATCH 041/274] add fluxr and uncomment radiation diagnostics for rrtmgp_[sw,lw]_post --- physics/GFS_rrtmgp_lw_post.F90 | 80 +++++++++++----------- physics/GFS_rrtmgp_lw_post.meta | 9 +++ physics/GFS_rrtmgp_sw_post.F90 | 118 ++++++++++++++++---------------- physics/GFS_rrtmgp_sw_post.meta | 71 ++++++++++--------- 4 files changed, 150 insertions(+), 128 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index a6b37acfc..537ce8879 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -26,8 +26,8 @@ end subroutine GFS_rrtmgp_lw_post_init !! subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & - fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, sfcdlw, & - sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) + fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, & + sfcdlw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -61,7 +61,9 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag real(kind_phys), dimension(nCol,nLev), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer cldtaulw ! approx 10.mu band layer cloud optical depth - + + real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr + ! Outputs (mandatory) real(kind_phys), dimension(nCol), intent(out) :: & sfcdlw, & ! Total sky sfc downward lw flux (W/m2) @@ -168,42 +170,42 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag ! - Collect the fluxr data for wrtsfc ! ####################################################################################### if (save_diag) then -! do i=1,nCol -! ! LW all-sky fluxes -! Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up -! Diag%fluxr(i,19) = Diag%fluxr(i,19) + fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn -! Diag%fluxr(i,20) = Diag%fluxr(i,20) + fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up -! ! LW clear-sky fluxes -! Diag%fluxr(i,28) = Diag%fluxr(i,28) + fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up -! Diag%fluxr(i,30) = Diag%fluxr(i,30) + fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn -! Diag%fluxr(i,33) = Diag%fluxr(i,33) + fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up -! enddo -! -! do i=1,nCol -! Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) -! Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) -! enddo -! -! ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for -! ! the fluxr output. save interface pressure (pa) of top/bot -! do j = 1, 3 -! do i = 1, nCol -! tem0d = raddt * cldsa(i,j) -! itop = mtopa(i,j) -! ibtc = mbota(i,j) -! Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d -! Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * p_lev(i,itop) -! Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * p_lev(i,ibtc) -! Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * t_lay(i,itop) -! -! ! Add optical depth and emissivity output -! tem2 = 0. -! do k=ibtc,itop -! tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel -! enddo -! Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) -! enddo -! enddo + do i=1,nCol + ! LW all-sky fluxes + fluxr(i,1 ) = fluxr(i,1 ) + fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up + fluxr(i,19) = fluxr(i,19) + fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn + fluxr(i,20) = fluxr(i,20) + fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up + ! LW clear-sky fluxes + fluxr(i,28) = fluxr(i,28) + fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up + fluxr(i,30) = fluxr(i,30) + fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn + fluxr(i,33) = fluxr(i,33) + fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up + enddo + + do i=1,nCol + fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) + fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for + ! the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d + fluxr(i,11-j) = fluxr(i,11-j) + tem0d * p_lev(i,itop) + fluxr(i,14-j) = fluxr(i,14-j) + tem0d * p_lev(i,ibtc) + fluxr(i,17-j) = fluxr(i,17-j) + tem0d * t_lay(i,itop) + + ! Add optical depth and emissivity output + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + enddo + fluxr(i,46-j) = fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo endif end subroutine GFS_rrtmgp_lw_post_run diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index c261a7797..c2fba7cea 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -174,6 +174,15 @@ kind = kind_phys intent = in optional = F +[fluxr] + standard_name = cumulative_radiation_diagnostic + long_name = time-accumulated 2D radiation-related diagnostic fields + units = various + dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) + type = real + kind = kind_phys + intent = inout + optional = F [sfcdlw] standard_name = surface_downwelling_longwave_flux_on_radiation_time_step long_name = total sky sfc downward lw flux diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 0d3991fcf..3a9871a5c 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -28,7 +28,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky save_diag, fhswr, coszen, coszdg, t_lay, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sw_gas_props, fluxswUP_allsky, & fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & - mtopa, cld_frac, cldtausw, & + mtopa, cld_frac, cldtausw, fluxr, & nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & sfcdsw, htrsw, sfcfsw, topfsw, htrswc, flxprf_sw, scmpsw, errmsg, errflg) @@ -85,7 +85,9 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! nirdf - downward nir diffused flux (W/m2) ! visbm - downward uv+vis direct beam flux (W/m2) ! visdf - downward uv+vis diffused flux (W/m2) - + + real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr + ! Outputs (mandatory) real(kind_phys), dimension(nCol), intent(out) :: & nirbmdi, & ! sfc nir beam sw downward flux (W/m2) @@ -253,62 +255,62 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! - Collect the fluxr data for wrtsfc ! ####################################################################################### if (save_diag) then -! do i=1,nCol -! Diag%fluxr(i,34) = Diag%fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm -! Diag%fluxr(i,35) = Diag%fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm -! Diag%fluxr(i,36) = Diag%fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm -! Diag%fluxr(i,37) = Diag%fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm -! Diag%fluxr(i,38) = Diag%fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm -! Diag%fluxr(i,39) = Diag%fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm -! if (coszen(i) > 0.) then -! ! SW all-sky fluxes -! tem0d = fhswr * coszdg(i) / coszen(i) -! Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up -! Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + sfcfsw(i)%upfxc * tem0d -! Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn -! ! SW uv-b fluxes -! Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn -! Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn -! ! SW TOA incoming fluxes -! Diag%fluxr(i,23) = Diag%fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn -! ! SW SFC flux components -! Diag%fluxr(i,24) = Diag%fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn -! Diag%fluxr(i,25) = Diag%fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn -! Diag%fluxr(i,26) = Diag%fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn -! Diag%fluxr(i,27) = Diag%fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn -! ! SW clear-sky fluxes -! Diag%fluxr(i,29) = Diag%fluxr(i,29) + topfsw(i)%upfx0 * tem0d -! Diag%fluxr(i,31) = Diag%fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d -! Diag%fluxr(i,32) = Diag%fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d -! endif -! enddo -! -! ! Save total and boundary-layer clouds -! do i=1,nCol -! Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) -! Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) -! enddo -! -! ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud -! ! is reversed for the fluxr output. save interface pressure (pa) of top/bot -! do j = 1, 3 -! do i = 1, nCol -! tem0d = raddt * cldsa(i,j) -! itop = mtopa(i,j) -! ibtc = mbota(i,j) -! Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d -! Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * p_lev(i,itop) -! Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * p_lev(i,ibtc) -! Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * p_lev(i,itop) -! -! ! Add optical depth and emissivity output -! tem1 = 0. -! do k=ibtc,itop -! tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel -! enddo -! Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 -! enddo -! enddo + do i=1,nCol + fluxr(i,34) = fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm + fluxr(i,35) = fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm + fluxr(i,36) = fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm + fluxr(i,37) = fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm + fluxr(i,38) = fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm + fluxr(i,39) = fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm + if (coszen(i) > 0.) then + ! SW all-sky fluxes + tem0d = fhswr * coszdg(i) / coszen(i) + fluxr(i,2 ) = fluxr(i,2) + topfsw(i)%upfxc * tem0d ! total sky top sw up + fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d + fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn + ! SW uv-b fluxes + fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn + fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn + ! SW TOA incoming fluxes + fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn + ! SW SFC flux components + fluxr(i,24) = fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn + fluxr(i,25) = fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn + fluxr(i,26) = fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn + fluxr(i,27) = fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn + ! SW clear-sky fluxes + fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d + fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d + fluxr(i,32) = fluxr(i,32) + sfcfsw(i)%dnfx0 * tem0d + endif + enddo + + ! Save total and boundary-layer clouds + do i=1,nCol + fluxr(i,17) = fluxr(i,17) + raddt * cldsa(i,4) + fluxr(i,18) = fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud + ! is reversed for the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + fluxr(i, 8-j) = fluxr(i, 8-j) + tem0d + fluxr(i,11-j) = fluxr(i,11-j) + tem0d * p_lev(i,itop) + fluxr(i,14-j) = fluxr(i,14-j) + tem0d * p_lev(i,ibtc) + fluxr(i,17-j) = fluxr(i,17-j) + tem0d * p_lev(i,itop) + + ! Add optical depth and emissivity output + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel + enddo + fluxr(i,43-j) = fluxr(i,43-j) + tem0d * tem1 + enddo + enddo endif end subroutine GFS_rrtmgp_sw_post_run diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 94f2cbf5f..cd2512e58 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -138,6 +138,14 @@ kind = kind_phys intent = in optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F [fluxswUP_allsky] standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile @@ -201,17 +209,17 @@ kind = kind_phys intent = in optional = F -[mtopa] - standard_name = model_layer_number_at_cloud_top - long_name = vertical indices for low, middle and high cloud tops +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases units = index dimensions = (horizontal_dimension,3) type = integer intent = in optional = F -[mbota] - standard_name = model_layer_number_at_cloud_base - long_name = vertical indices for low, middle and high cloud bases +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops units = index dimensions = (horizontal_dimension,3) type = integer @@ -235,13 +243,14 @@ kind = kind_phys intent = in optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in +[fluxr] + standard_name = cumulative_radiation_diagnostic + long_name = time-accumulated 2D radiation-related diagnostic fields + units = various + dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) + type = real + kind = kind_phys + intent = inout optional = F [nirbmdi] standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step @@ -333,14 +342,6 @@ kind = kind_phys intent = out optional = F -[sfcfsw] - standard_name = sw_fluxes_sfc - long_name = sw radiation fluxes at sfc - units = W m-2 - dimensions = (horizontal_dimension) - type = sfcfsw_type - intent = out - optional = F [htrsw] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate @@ -350,6 +351,14 @@ kind = kind_phys intent = out optional = F +[sfcfsw] + standard_name = sw_fluxes_sfc + long_name = sw radiation fluxes at sfc + units = W m-2 + dimensions = (horizontal_dimension) + type = sfcfsw_type + intent = out + optional = F [topfsw] standard_name = sw_fluxes_top_atmosphere long_name = sw radiation fluxes at toa @@ -366,15 +375,7 @@ type = real kind = kind_phys intent = out - optional = T -[scmpsw] - standard_name = components_of_surface_downward_shortwave_fluxes - long_name = derived type for special components of surface downward shortwave fluxes - units = W m-2 - dimensions = (horizontal_dimension) - type = cmpfsw_type - intent = in - optional = T + optional = T [flxprf_sw] standard_name = RRTMGP_sw_fluxes long_name = sw fluxes total sky / csk and up / down at levels @@ -382,7 +383,15 @@ dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_plus_one) type = profsw_type intent = out - optional = T + optional = T +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = in + optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 6e1d8484b79c5e82ac0a5fc1d708c96f0c65075d Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 27 Aug 2020 10:38:35 -0600 Subject: [PATCH 042/274] switch to horizontal_loop_extent in radiation interstitials that were touched --- physics/GFS_rrtmg_post.meta | 2 +- physics/GFS_rrtmg_pre.meta | 134 ++++++++++++++++---------------- physics/GFS_rrtmgp_lw_post.meta | 42 +++++----- physics/GFS_rrtmgp_sw_post.meta | 72 ++++++++--------- physics/rrtmg_lw_post.meta | 20 ++--- physics/rrtmg_lw_pre.meta | 20 ++--- physics/rrtmg_sw_post.meta | 46 +++++------ physics/rrtmg_sw_pre.meta | 52 ++++++------- 8 files changed, 194 insertions(+), 194 deletions(-) diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index a90791796..2ecebfcf0 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -286,7 +286,7 @@ standard_name = cumulative_radiation_diagnostic long_name = time-accumulated 2D radiation-related diagnostic fields units = various - dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) + dimensions = (horizontal_loop_extent,number_of_radiation_diagnostic_variables) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index dd021df6d..853560df5 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -485,7 +485,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -494,7 +494,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -503,7 +503,7 @@ standard_name = cosine_of_latitude long_name = cosine of latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -512,7 +512,7 @@ standard_name = sine_of_latitude long_name = sine of latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -521,7 +521,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -530,7 +530,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -539,7 +539,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -548,7 +548,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -557,7 +557,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -566,7 +566,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -575,7 +575,7 @@ standard_name = weights_for_stochastic_surface_physics_perturbation long_name = weights for stochastic surface physics perturbation units = none - dimensions = (horizontal_dimension,number_of_surface_perturbations) + dimensions = (horizontal_loop_extent,number_of_surface_perturbations) type = real kind = kind_phys intent = in @@ -584,7 +584,7 @@ standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -593,7 +593,7 @@ standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um long_name = effective radius of cloud rain particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -602,7 +602,7 @@ standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d long_name = convective cloud water mixing ratio in the phy_f3d array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -611,7 +611,7 @@ standard_name = convective_cloud_cover_in_phy_f3d long_name = convective cloud cover in the phy_f3d array units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -620,7 +620,7 @@ standard_name = fraction_of_ice_water_cloud long_name = fraction of ice water cloud units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -629,7 +629,7 @@ standard_name = fraction_of_rain_water_cloud long_name = fraction of rain water cloud units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -638,7 +638,7 @@ standard_name = rime_factor long_name = rime factor units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -647,7 +647,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -656,7 +656,7 @@ standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys intent = in @@ -665,7 +665,7 @@ standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -674,7 +674,7 @@ standard_name = daytime_mean_cosz_over_rad_call_period long_name = daytime mean cosz over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -683,7 +683,7 @@ standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -692,7 +692,7 @@ standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -701,7 +701,7 @@ standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -710,7 +710,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -719,7 +719,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -728,7 +728,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -737,7 +737,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -746,7 +746,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -779,7 +779,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = out optional = F @@ -787,7 +787,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = out optional = F @@ -804,7 +804,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -813,7 +813,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -822,7 +822,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -831,7 +831,7 @@ standard_name = surface_albedo_perturbation long_name = surface albedo perturbation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -840,7 +840,7 @@ standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness on radiation levels units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -849,7 +849,7 @@ standard_name = layer_thickness_for_radiation long_name = layer thickness on radiation levels units = km - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -858,7 +858,7 @@ standard_name = air_pressure_at_interface_for_radiation_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -867,7 +867,7 @@ standard_name = air_pressure_at_layer_for_radiation_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -876,7 +876,7 @@ standard_name = air_temperature_at_interface_for_radiation long_name = air temperature at vertical interface for radiation calculation units = K - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -885,7 +885,7 @@ standard_name = air_temperature_at_layer_for_radiation long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -894,7 +894,7 @@ standard_name = water_vapor_specific_humidity_at_layer_for_radiation long_name = water vapor specific humidity at vertical layer for radiation calculation units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -903,7 +903,7 @@ standard_name = ozone_concentration_at_layer_for_radiation long_name = ozone concentration units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -912,7 +912,7 @@ standard_name = volume_mixing_ratio_co2 long_name = CO2 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -921,7 +921,7 @@ standard_name = volume_mixing_ratio_n2o long_name = N2O volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -930,7 +930,7 @@ standard_name = volume_mixing_ratio_ch4 long_name = CH4 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -939,7 +939,7 @@ standard_name = volume_mixing_ratio_o2 long_name = O2 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -948,7 +948,7 @@ standard_name = volume_mixing_ratio_co long_name = CO volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -957,7 +957,7 @@ standard_name = volume_mixing_ratio_cfc11 long_name = CFC11 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -966,7 +966,7 @@ standard_name = volume_mixing_ratio_cfc12 long_name = CFC12 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -975,7 +975,7 @@ standard_name = volume_mixing_ratio_cfc22 long_name = CFC22 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -984,7 +984,7 @@ standard_name = volume_mixing_ratio_ccl4 long_name = CCL4 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -993,7 +993,7 @@ standard_name = volume_mixing_ratio_cfc113 long_name = CFC113 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -1002,7 +1002,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = out @@ -1011,7 +1011,7 @@ standard_name = cloud_rain_water_path long_name = cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1020,7 +1020,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1029,7 +1029,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1038,7 +1038,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1047,7 +1047,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle,high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = out @@ -1056,7 +1056,7 @@ standard_name = instantaneous_3d_cloud_fraction long_name = instantaneous 3D cloud fraction for all MPs units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1065,7 +1065,7 @@ standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 long_name = aerosol optical depth for shortwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = out @@ -1074,7 +1074,7 @@ standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 long_name = aerosol single scattering albedo for shortwave bands 01-16 units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = out @@ -1083,7 +1083,7 @@ standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 long_name = aerosol asymmetry parameter for shortwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = out @@ -1092,7 +1092,7 @@ standard_name = aerosol_optical_depth_for_longwave_bands_01_16 long_name = aerosol optical depth for longwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = out @@ -1101,7 +1101,7 @@ standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 long_name = aerosol single scattering albedo for longwave bands 01-16 units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = out @@ -1110,7 +1110,7 @@ standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 long_name = aerosol asymmetry parameter for longwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index c2fba7cea..8ba985ee2 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -54,7 +54,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = RRTMGP_lw_flux_profile_downward_allsky long_name = RRTMGP downward longwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -99,7 +99,7 @@ standard_name = RRTMGP_lw_flux_profile_upward_clrsky long_name = RRTMGP upward longwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -108,7 +108,7 @@ standard_name = RRTMGP_lw_flux_profile_downward_clrsky long_name = RRTMGP downward longwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -126,7 +126,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = in @@ -135,7 +135,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = in @@ -144,7 +144,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -152,7 +152,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -160,7 +160,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -169,7 +169,7 @@ standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band long_name = approx 10mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ standard_name = cumulative_radiation_diagnostic long_name = time-accumulated 2D radiation-related diagnostic fields units = various - dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) + dimensions = (horizontal_loop_extent,number_of_radiation_diagnostic_variables) type = real kind = kind_phys intent = inout @@ -187,7 +187,7 @@ standard_name = surface_downwelling_longwave_flux_on_radiation_time_step long_name = total sky sfc downward lw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -196,7 +196,7 @@ standard_name = lw_fluxes_sfc long_name = lw radiation fluxes at sfc units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcflw_type intent = out optional = F @@ -204,7 +204,7 @@ standard_name = surface_midlayer_air_temperature_in_longwave_radiation long_name = surface air temp during lw calculation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -213,7 +213,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -222,7 +222,7 @@ standard_name = lw_fluxes_top_atmosphere long_name = lw radiation fluxes at top units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = topflw_type intent = out optional = F @@ -230,7 +230,7 @@ standard_name = RRTMGP_lw_fluxes long_name = lw fluxes total sky / csk and up / down at levels units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = proflw_type intent = out optional = T @@ -238,7 +238,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = longwave clear sky heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index cd2512e58..16c5928e2 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -29,7 +29,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -70,7 +70,7 @@ standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -79,7 +79,7 @@ standard_name = daytime_mean_cosz_over_rad_call_period long_name = daytime mean cosz over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -88,7 +88,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -97,7 +97,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -106,7 +106,7 @@ standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -115,7 +115,7 @@ standard_name = surface_albedo_nearIR_diffuse long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -124,7 +124,7 @@ standard_name = surface_albedo_uvvis_dir long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -133,7 +133,7 @@ standard_name = surface_albedo_uvvis_dif long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -150,7 +150,7 @@ standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -159,7 +159,7 @@ standard_name = RRTMGP_sw_flux_profile_downward_allsky long_name = RRTMGP downward shortwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -168,7 +168,7 @@ standard_name = RRTMGP_sw_flux_profile_upward_clrsky long_name = RRTMGP upward shortwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -177,7 +177,7 @@ standard_name = RRTMGP_sw_flux_profile_downward_clrsky long_name = RRTMGP downward shortwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -195,7 +195,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = in @@ -204,7 +204,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = in @@ -213,7 +213,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -221,7 +221,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -229,7 +229,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -238,7 +238,7 @@ standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band long_name = approx .55mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -247,7 +247,7 @@ standard_name = cumulative_radiation_diagnostic long_name = time-accumulated 2D radiation-related diagnostic fields units = various - dimensions = (horizontal_dimension,number_of_radiation_diagnostic_variables) + dimensions = (horizontal_loop_extent,number_of_radiation_diagnostic_variables) type = real kind = kind_phys intent = inout @@ -256,7 +256,7 @@ standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir beam sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -265,7 +265,7 @@ standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir diff sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -274,7 +274,7 @@ standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis beam sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -283,7 +283,7 @@ standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis diff sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -292,7 +292,7 @@ standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir beam sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -301,7 +301,7 @@ standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir diff sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -310,7 +310,7 @@ standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis beam sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -319,7 +319,7 @@ standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis diff sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -328,7 +328,7 @@ standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky sfc netsw flx into ground units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -337,7 +337,7 @@ standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -346,7 +346,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -355,7 +355,7 @@ standard_name = sw_fluxes_sfc long_name = sw radiation fluxes at sfc units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcfsw_type intent = out optional = F @@ -363,7 +363,7 @@ standard_name = sw_fluxes_top_atmosphere long_name = sw radiation fluxes at toa units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = topfsw_type intent = out optional = F @@ -371,7 +371,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky sw heating rates units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -380,7 +380,7 @@ standard_name = RRTMGP_sw_fluxes long_name = sw fluxes total sky / csk and up / down at levels units = W m-2 - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_plus_one) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_plus_one) type = profsw_type intent = out optional = T @@ -388,7 +388,7 @@ standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = in optional = T diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 9fdef489f..417537a9f 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -7,8 +7,8 @@ name = rrtmg_lw_post_run type = scheme [im] - standard_name = horizontal_dimension - long_name = horizontal dimension + standard_name = horizontal_loop_extent + long_name = horizontal loop extent units = count dimensions = () type = integer @@ -66,7 +66,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -75,7 +75,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels long_name = total sky heating rate due to longwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -84,7 +84,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = clear sky heating rate due to longwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -93,7 +93,7 @@ standard_name = lw_fluxes_sfc long_name = lw radiation fluxes at sfc units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcflw_type intent = in optional = F @@ -101,7 +101,7 @@ standard_name = surface_midlayer_air_temperature_in_longwave_radiation long_name = surface air temp during lw calculation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -110,7 +110,7 @@ standard_name = surface_downwelling_longwave_flux_on_radiation_time_step long_name = total sky sfc downward lw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -119,7 +119,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -128,7 +128,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky lw heating rates units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index d4054cc0b..5f75df65c 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -26,7 +26,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -35,7 +35,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -44,7 +44,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -53,7 +53,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -62,7 +62,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -71,7 +71,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -80,7 +80,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -89,7 +89,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -98,7 +98,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 093a4e290..b7b06b255 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -7,8 +7,8 @@ name = rrtmg_sw_post_run type = scheme [im] - standard_name = horizontal_dimension - long_name = horizontal dimension + standard_name = horizontal_loop_extent + long_name = horizontal loop extents units = count dimensions = () type = integer @@ -82,7 +82,7 @@ standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -91,7 +91,7 @@ standard_name = surface_albedo_due_to_near_IR_diffused long_name = surface albedo due to near IR diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -100,7 +100,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_direct long_name = surface albedo due to UV+VIS direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -109,7 +109,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_diffused long_name = surface albedo due to UV+VIS diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -118,7 +118,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels long_name = total sky heating rate due to shortwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = clear sky heating rates due to shortwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -136,7 +136,7 @@ standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir beam sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -145,7 +145,7 @@ standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir diff sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -154,7 +154,7 @@ standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis beam sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -163,7 +163,7 @@ standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis diff sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -172,7 +172,7 @@ standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir beam sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -181,7 +181,7 @@ standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir diff sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -190,7 +190,7 @@ standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis beam sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -199,7 +199,7 @@ standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis diff sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -208,7 +208,7 @@ standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -217,7 +217,7 @@ standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky sfc netsw flx into ground units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -226,7 +226,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -235,7 +235,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky sw heating rates units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -244,7 +244,7 @@ standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = inout optional = F @@ -252,7 +252,7 @@ standard_name = sw_fluxes_sfc long_name = sw radiation fluxes at sfc units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcfsw_type intent = inout optional = F @@ -260,7 +260,7 @@ standard_name = sw_fluxes_top_atmosphere long_name = sw radiation fluxes at toa units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = topfsw_type intent = inout optional = F diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 76c3e6f97..a302c959f 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -7,8 +7,8 @@ name = rrtmg_sw_pre_run type = scheme [im] - standard_name = horizontal_dimension - long_name = horizontal dimension + standard_name = horizontal_loop_extent + long_name = horizontal loop extent units = count dimensions = () type = integer @@ -35,7 +35,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -44,7 +44,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -53,7 +53,7 @@ standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -62,7 +62,7 @@ standard_name = surface_albedo_perturbation long_name = surface albedo perturbation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -71,7 +71,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -80,7 +80,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -89,7 +89,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -98,7 +98,7 @@ standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -116,7 +116,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -125,7 +125,7 @@ standard_name = mean_vis_albedo_with_strong_cosz_dependency long_name = mean vis albedo with strong cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -134,7 +134,7 @@ standard_name = mean_nir_albedo_with_strong_cosz_dependency long_name = mean nir albedo with strong cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -143,7 +143,7 @@ standard_name = mean_vis_albedo_with_weak_cosz_dependency long_name = mean vis albedo with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -152,7 +152,7 @@ standard_name = mean_nir_albedo_with_weak_cosz_dependency long_name = mean nir albedo with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -161,7 +161,7 @@ standard_name = fractional_coverage_with_strong_cosz_dependency long_name = fractional coverage with strong cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -170,7 +170,7 @@ standard_name = fractional_coverage_with_weak_cosz_dependency long_name = fractional coverage with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -179,7 +179,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -188,7 +188,7 @@ standard_name = sea_ice_temperature long_name = sea ice surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -197,7 +197,7 @@ standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused sw albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -214,7 +214,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -222,7 +222,7 @@ standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -231,7 +231,7 @@ standard_name = surface_albedo_due_to_near_IR_diffused long_name = surface albedo due to near IR diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -240,7 +240,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_direct long_name = surface albedo due to UV+VIS direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -249,7 +249,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_diffused long_name = surface albedo due to UV+VIS diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out From b378619c7f60f8488c9d7c43ee63a62646e109c1 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Thu, 27 Aug 2020 10:43:00 -0600 Subject: [PATCH 043/274] revert changes to time_vary.scm files --- physics/GFS_phys_time_vary.scm.F90 | 289 ++++----- physics/GFS_phys_time_vary.scm.meta | 890 ++-------------------------- physics/GFS_rad_time_vary.scm.F90 | 69 +-- physics/GFS_rad_time_vary.scm.meta | 234 +------- 4 files changed, 221 insertions(+), 1261 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 2bb04ebb6..5fcc9ed84 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -33,39 +33,18 @@ module GFS_phys_time_vary !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! - subroutine GFS_phys_time_vary_init (im, nx, ny, me, master, nblks, ntoz, iflip, & - iccn, levh2o_int, levozp_int, idate, blksz, h2o_phys, iaerclm, xlat_d, xlon_d,& - ozpl, h2opl, aer_nm, imap, jmap, jindx1_o3, jindx2_o3, jindx1_h, jindx2_h, & - jindx1_aer, jindx2_aer, iindx1_aer, iindx2_aer, jindx1_ci, jindx2_ci, & - iindx1_ci, iindx2_ci, ddy_o3, ddy_h, ddy_aer, ddx_aer, ddy_ci, ddx_ci, & - oz_pres_int, h2o_pres_int, errmsg, errflg) + subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errflg) - use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & + GFS_Tbd_type, GFS_interstitial_type implicit none ! Interface variables - integer, intent(in) :: im, nx, ny, me, master, & - nblks, ntoz, iflip, iccn,& - levh2o_int, levozp_int - integer, dimension(4), intent(in) :: idate - integer, dimension(nblks), intent(in) :: blksz - logical, intent(in) :: h2o_phys, iaerclm - real(kind=kind_phys), dimension(im), intent(in) :: xlat_d, xlon_d - real(kind=kind_phys), dimension(:,:,:), intent(in) :: ozpl, h2opl, aer_nm - - integer, dimension(im), intent(inout) :: imap, jmap - integer, dimension(:), intent(inout) :: jindx1_o3, jindx2_o3, & - jindx1_h, jindx2_h, & - jindx1_aer, jindx2_aer, & - iindx1_aer, iindx2_aer, & - jindx1_ci, jindx2_ci, & - iindx1_ci, iindx2_ci - real(kind=kind_phys), dimension(:), intent(inout) :: ddy_o3, ddy_h, ddy_aer, & - ddx_aer, ddy_ci, ddx_ci - real(kind=kind_phys), dimension(levozp_int), intent(inout) :: oz_pres_int - real(kind=kind_phys), dimension(levh2o_int), intent(inout) :: h2o_pres_int - + type(GFS_grid_type), intent(inout) :: Grid + type(GFS_control_type), intent(in) :: Model + type(GFS_interstitial_type), intent(inout) :: Interstitial + type(GFS_tbd_type), intent(in) :: Tbd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -81,121 +60,121 @@ subroutine GFS_phys_time_vary_init (im, nx, ny, me, master, nblks, ntoz, iflip, nb = 1 nt = 1 - call read_o3data (ntoz, me, master) + call read_o3data (Model%ntoz, Model%me, Model%master) ! Consistency check that the hardcoded values for levozp and ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(ozpl, dim=2).ne.levozp) then + if (size(Tbd%ozpl, dim=2).ne.levozp) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(ozpl, dim=2) + levozp, " /= ", size(Tbd%ozpl, dim=2) errflg = 1 end if - if (size(ozpl, dim=3).ne.oz_coeff) then + if (size(Tbd%ozpl, dim=3).ne.oz_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(ozpl, dim=3) + oz_coeff, " /= ", size(Tbd%ozpl, dim=3) errflg = 1 end if - call read_h2odata (h2o_phys, me, master) + call read_h2odata (Model%h2o_phys, Model%me, Model%master) ! Consistency check that the hardcoded values for levh2o and ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(h2opl, dim=2).ne.levh2o) then + if (size(Tbd%h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(h2opl, dim=2) + levh2o, " /= ", size(Tbd%h2opl, dim=2) errflg = 1 end if - if (size(h2opl, dim=3).ne.h2o_coeff) then + if (size(Tbd%h2opl, dim=3).ne.h2o_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(h2opl, dim=3) + h2o_coeff, " /= ", size(Tbd%h2opl, dim=3) errflg = 1 end if - if (iaerclm) then + if (Model%iaerclm) then ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def - if (size(aer_nm, dim=3).ne.ntrcaerm) then + if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & - ntrcaerm, " /= ", size(aer_nm, dim=3) + ntrcaerm, " /= ", size(Tbd%aer_nm, dim=3) errflg = 1 else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If iaerclm is .true., then ntrcaer == ntrcaerm - ntrcaer = size(aer_nm, dim=3) + ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm + ntrcaer = size(Tbd%aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (me, master, iflip, idate, errmsg, errflg) + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) if (errflg/=0) return endif else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If iaerclm is .false., then ntrcaer == 1 - ntrcaer = size(aer_nm, dim=3) + ! If Model%iaerclm is .false., then ntrcaer == 1 + ntrcaer = size(Tbd%aer_nm, dim=3) endif - if (iccn == 1) then - call read_cidata (me, master) + if (Model%iccn == 1) then + call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif ! Update values of oz_pres in Interstitial data type for all threads - if (ntoz > 0) then - oz_pres_int = oz_pres + if (Model%ntoz > 0) then + Interstitial%oz_pres = oz_pres end if ! Update values of h2o_pres in Interstitial data type for all threads - if (h2o_phys) then - h2o_pres_int = h2o_pres + if (Model%h2o_phys) then + Interstitial%h2o_pres = h2o_pres end if !--- read in and initialize ozone - if (ntoz > 0) then - call setindxoz (blksz(nb), xlat_d, jindx1_o3, & - jindx2_o3, ddy_o3) + if (Model%ntoz > 0) then + call setindxoz (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_o3, & + Grid%jindx2_o3, Grid%ddy_o3) endif !--- read in and initialize stratospheric water - if (h2o_phys) then - call setindxh2o (blksz(nb), xlat_d, jindx1_h, & - jindx2_h, ddy_h) + if (Model%h2o_phys) then + call setindxh2o (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_h, & + Grid%jindx2_h, Grid%ddy_h) endif !--- read in and initialize aerosols - if (iaerclm) then - call setindxaer (blksz(nb), xlat_d, jindx1_aer, & - jindx2_aer, ddy_aer, xlon_d, & - iindx1_aer, iindx2_aer, ddx_aer, & - me, master) + if (Model%iaerclm) then + call setindxaer (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_aer, & + Grid%jindx2_aer, Grid%ddy_aer, Grid%xlon_d, & + Grid%iindx1_aer, Grid%iindx2_aer, Grid%ddx_aer, & + Model%me, Model%master) endif !--- read in and initialize IN and CCN - if (iccn == 1) then - call setindxci (blksz(nb), xlat_d, jindx1_ci, & - jindx2_ci, ddy_ci, xlon_d, & - iindx1_ci, iindx2_ci, ddx_ci) + if (Model%iccn == 1) then + call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & + Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & + Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) endif !--- initial calculation of maps local ix -> global i and j, store in Tbd ix = 0 nb = 1 - do j = 1, ny - do i = 1, nx + do j = 1,Model%ny + do i = 1,Model%nx ix = ix + 1 - if (ix .gt. blksz(nb)) then + if (ix .gt. Model%blksz(nb)) then ix = 1 nb = nb + 1 endif - jmap(ix) = j - imap(ix) = i + Tbd%jmap(ix) = j + Tbd%imap(ix) = i enddo enddo @@ -247,53 +226,25 @@ end subroutine GFS_phys_time_vary_finalize !> \section arg_table_GFS_phys_time_vary_run Argument Table !! \htmlinclude GFS_phys_time_vary_run.html !! - subroutine GFS_phys_time_vary_run (levs, cnx, cny, isc, jsc, me, master, & - ntoz, iccn, nrcm, nsswr, nszero, kdt, imfdeepcnv, seed0, first_time_step,& - lsswr, cal_pre, random_clds, h2o_phys, iaerclm, fhswr, fhlwr, fhour, & - fhzero, dtp, idate, jindx1_o3, jindx2_o3, jindx1_h, jindx2_h, jindx1_aer,& - jindx2_aer, iindx1_aer, iindx2_aer, jindx1_ci, jindx2_ci, iindx1_ci, & - iindx2_ci, blksz, imap, jmap, ddy_o3, ddy_h, ddy_aer, ddx_aer, ddy_ci, & - ddx_ci, slmsk, vtype, weasd, prsl, Model, clstp, sncovr, rann, in_nm, & - ccn_nm, ozpl, h2opl, aer_nm, Diag, errmsg, errflg) + subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Diag, first_time_step, errmsg, errflg) use mersenne_twister, only: random_setseed, random_number use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_diag_type - + use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & + GFS_Tbd_type, GFS_sfcprop_type, & + GFS_cldprop_type, GFS_diag_type, & + GFS_statein_type + implicit none - integer, intent(in) :: levs, cnx, cny, isc, jsc, & - me, master, ntoz, iccn, & - nrcm, nsswr, nszero, kdt, & - imfdeepcnv, seed0 - logical, intent(in) :: first_time_step, lsswr, & - cal_pre, random_clds, & - h2o_phys, iaerclm - real(kind=kind_phys), intent(in) :: fhswr, fhlwr, fhour, & - fhzero, dtp - - integer, dimension(4), intent(in) :: idate - integer, dimension(:), intent(in) :: jindx1_o3, jindx2_o3, & - jindx1_h, jindx2_h, & - jindx1_aer, jindx2_aer, & - iindx1_aer, iindx2_aer, & - jindx1_ci, jindx2_ci, & - iindx1_ci, iindx2_ci, & - blksz, imap, jmap - real(kind=kind_phys), dimension(:), intent(in) :: ddy_o3, ddy_h, ddy_aer, & - ddx_aer, ddy_ci, ddx_ci, & - slmsk, vtype, weasd - real(kind=kind_phys), dimension(:,:), intent(in) :: prsl - - type(GFS_control_type), intent(in) :: Model - - real(kind=kind_phys), intent(inout) :: clstp - real(kind=kind_phys), dimension(:), intent(inout) :: sncovr - real(kind=kind_phys), dimension(:,:), intent(inout) :: rann, in_nm, ccn_nm - real(kind=kind_phys), dimension(:,:,:), intent(inout) :: ozpl, h2opl, aer_nm - + type(GFS_grid_type), intent(in) :: Grid + type(GFS_statein_type), intent(in) :: Statein + type(GFS_control_type), intent(inout) :: Model + type(GFS_tbd_type), intent(inout) :: Tbd + type(GFS_sfcprop_type), intent(inout) :: Sfcprop + type(GFS_cldprop_type), intent(inout) :: Cldprop type(GFS_diag_type), intent(inout) :: Diag - + logical, intent(in) :: first_time_step character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -304,8 +255,8 @@ subroutine GFS_phys_time_vary_run (levs, cnx, cny, isc, jsc, me, master, & integer :: i, j, k, iseed, iskip, ix, nb, kdt_rad, vegtyp real(kind=kind_phys) :: sec_zero, rsnow real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(cny) - real(kind=kind_phys) :: rndval(cnx*cny*nrcm) + real(kind=kind_phys) :: rannie(Model%cny) + real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) ! Initialize CCPP error handling variables errmsg = '' @@ -322,98 +273,98 @@ subroutine GFS_phys_time_vary_run (levs, cnx, cny, isc, jsc, me, master, & !--- switch for saving convective clouds - cnvc90.f !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(kdt,nsswr) == 0) .and. (lsswr)) then + if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then !--- initialize,accumulate,convert - clstp = 1100 + min(fhswr/con_hr,fhour,con_99) - elseif (mod(kdt,nsswr) == 0) then + Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (mod(Model%kdt,Model%nsswr) == 0) then !--- accumulate,convert - clstp = 0100 + min(fhswr/con_hr,fhour,con_99) - elseif (lsswr) then + Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) + elseif (Model%lsswr) then !--- initialize,accumulate - clstp = 1100 + Model%clstp = 1100 else !--- accumulate - clstp = 0100 + Model%clstp = 0100 endif !--- random number needed for RAS and old SAS and when cal_pre=.true. - if ( (imfdeepcnv <= 0 .or. cal_pre) .and. random_clds ) then - iseed = mod(con_100*sqrt(fhour*con_hr),1.0d9) + seed0 + if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then + iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 call random_setseed(iseed) call random_number(wrk) - do i = 1,cnx*nrcm + do i = 1,Model%cnx*Model%nrcm iseed = iseed + nint(wrk(1)*1000.0) * i call random_setseed(iseed) call random_number(rannie) - rndval(1+(i-1)*cny:i*cny) = rannie(1:cny) + rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) enddo - do k = 1,nrcm - iskip = (k-1)*cnx*cny - do ix=1,blksz(nb) - j = jmap(ix) - i = imap(ix) - rann(ix,k) = rndval(i+isc-1 + (j+jsc-2)*cnx + iskip) + do k = 1,Model%nrcm + iskip = (k-1)*Model%cnx*Model%cny + do ix=1,Model%blksz(nb) + j = Tbd%jmap(ix) + i = Tbd%imap(ix) + Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) enddo enddo endif ! imfdeepcnv, cal_re, random_clds !--- o3 interpolation - if (ntoz > 0) then - call ozinterpol (me, blksz(nb), idate, fhour, & - jindx1_o3, jindx2_o3, ozpl, ddy_o3) + if (Model%ntoz > 0) then + call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & + Grid%jindx1_o3, Grid%jindx2_o3, Tbd%ozpl, Grid%ddy_o3) endif !--- h2o interpolation - if (h2o_phys) then - call h2ointerpol (me, blksz(nb), idate, fhour, & - jindx1_h, jindx2_h, h2opl, ddy_h) + if (Model%h2o_phys) then + call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & + Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h) endif !--- aerosol interpolation - if (iaerclm) then - call aerinterpol (me, master, blksz(nb), & - idate, fhour, & - jindx1_aer, jindx2_aer, & - ddy_aer,iindx1_aer, & - iindx2_aer,ddx_aer, & - levs,prsl, & - aer_nm) + if (Model%iaerclm) then + call aerinterpol (Model%me, Model%master, Model%blksz(nb), & + Model%idate, Model%fhour, & + Grid%jindx1_aer, Grid%jindx2_aer, & + Grid%ddy_aer,Grid%iindx1_aer, & + Grid%iindx2_aer,Grid%ddx_aer, & + Model%levs,Statein%prsl, & + Tbd%aer_nm) endif !--- ICCN interpolation - if (iccn == 1) then - call ciinterpol (me, blksz(nb), idate, fhour, & - jindx1_ci, jindx2_ci, & - ddy_ci,iindx1_ci, & - iindx2_ci,ddx_ci, & - levs,prsl, & - in_nm, ccn_nm) + if (Model%iccn == 1) then + call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & + Grid%jindx1_ci, Grid%jindx2_ci, & + Grid%ddy_ci,Grid%iindx1_ci, & + Grid%iindx2_ci,Grid%ddx_ci, & + Model%levs,Statein%prsl, & + Tbd%in_nm, Tbd%ccn_nm) endif !--- original FV3 code, not needed for SCM; also not compatible with the way ! the time vary steps are run (over each block) --> cannot use !--- repopulate specific time-varying sfc properties for AMIP/forecast runs !if (Model%nscyc > 0) then - ! if (mod(kdt,Model%nscyc) == 1) THEN + ! if (mod(Model%kdt,Model%nscyc) == 1) THEN ! call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) ! endif !endif !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(fhzero*con_hr) - if (sec_zero >= nint(max(fhswr,fhlwr))) then - if (mod(kdt,nszero) == 1) then + sec_zero = nint(Model%fhzero*con_hr) + if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then + if (mod(Model%kdt,Model%nszero) == 1) then call Diag%rad_zero (Model) call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif else - if (mod(kdt,nszero) == 1) then + if (mod(Model%kdt,Model%nszero) == 1) then call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif - kdt_rad = nint(min(fhswr,fhlwr)/dtp) - if (mod(kdt, kdt_rad) == 1) then + kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) + if (mod(Model%kdt, kdt_rad) == 1) then call Diag%rad_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif @@ -422,19 +373,19 @@ subroutine GFS_phys_time_vary_run (levs, cnx, cny, isc, jsc, me, master, & #if 0 !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) if (first_time_step) then - if (nint(sncovr(1)) == -9999) then + if (nint(Sfcprop%sncovr(1)) == -9999) then !--- compute sncovr from existing variables !--- code taken directly from read_fix.f - do ix = 1, blksz(nb) - sncovr(ix) = 0.0 - if (slmsk(ix) > 0.001) then - vegtyp = vtype(ix) + do ix = 1, Model%blksz(nb) + Sfcprop%sncovr(ix) = 0.0 + if (Sfcprop%slmsk(ix) > 0.001) then + vegtyp = Sfcprop%vtype(ix) if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*weasd(ix)/snupx(vegtyp) - if (0.001*weasd(ix) < snupx(vegtyp)) then - sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) + if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then + Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) else - sncovr(ix) = 1.0 + Sfcprop%sncovr(ix) = 1.0 endif endif enddo diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index fd450c336..57a82ecb0 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1,355 +1,38 @@ [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme -[im] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[nx] - standard_name = number_of_points_in_x_direction_for_this_MPI_rank - long_name = number of points in x direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in - optional = F -[ny] - standard_name = number_of_points_in_y_direction_for_this_MPI_rank - long_name = number of points in y direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[master] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[nblks] - standard_name = ccpp_block_count - long_name = for explicit data blocking: number of blocks - units = count - dimensions = () - type = integer - intent = in - optional = F -[ntoz] - standard_name = index_for_ozone - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in - optional = F -[iflip] - standard_name = flag_for_vertical_index_direction_control - long_name = iflip - is not the same as flipv - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iccn] - standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics - long_name = flag for IN and CCN forcing for morrison gettelman microphysics - units = none - dimensions = () - type = integer - intent = in - optional = F -[levh2o_int] - standard_name = vertical_dimension_of_h2o_forcing_data - long_name = number of vertical layers in h2o forcing data - units = count +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT dimensions = () - type = integer - intent = in + type = GFS_grid_type + intent = inout optional = F -[levozp_int] - standard_name = vertical_dimension_of_ozone_forcing_data - long_name = number of vertical layers in ozone forcing data - units = count +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT dimensions = () - type = integer - intent = in - optional = F -[idate] - standard_name = date_and_time_at_model_initialization_reordered - long_name = initial date with different size and ordering - units = none - dimensions = (4) - type = integer - intent = in - optional = F -[blksz] - standard_name = ccpp_block_sizes - long_name = for explicit data blocking: block sizes of all blocks - units = count - dimensions = (ccpp_block_count) - type = integer + type = GFS_control_type intent = in optional = F -[h2o_phys] - standard_name = flag_for_stratospheric_water_vapor_physics - long_name = flag for stratospheric water vapor physics - units = flag +[Interstitial] + standard_name = GFS_interstitial_type_instance + long_name = Fortran DDT containing FV3-GFS interstitial data + units = DDT dimensions = () - type = logical - intent = in + type = GFS_interstitial_type + intent = inout optional = F -[iaerclm] - standard_name = flag_for_aerosol_input_MG_radiation - long_name = flag for using aerosols in Morrison-Gettelman MP_radiation - units = flag +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = Fortran DDT containing FV3-GFS miscellaneous data + units = DDT dimensions = () - type = logical - intent = in - optional = F -[xlat_d] - standard_name = latitude_in_degree - long_name = latitude in degrees - units = degree_north - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[xlon_d] - standard_name = longitude_in_degree - long_name = longitude in degrees - units = degree_east - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = various - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys + type = GFS_tbd_type intent = in optional = F -[h2opl] - standard_name = h2o_forcing - long_name = water forcing data - units = various - dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) - type = real - kind = kind_phys - intent = in - optional = F -[aer_nm] - standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology - long_name = GOCART aerosol climatology number concentration - units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) - type = real - kind = kind_phys - intent = in - optional = F -[imap] - standard_name = map_of_block_column_number_to_global_i_index - long_name = map of local index ix to global index i for this block - units = none - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jmap] - standard_name = map_of_block_column_number_to_global_j_index - long_name = map of local index ix to global index j for this block - units = none - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx1_o3] - standard_name = lower_ozone_interpolation_index - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx2_o3] - standard_name = upper_ozone_interpolation_index - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx1_h] - standard_name = lower_water_vapor_interpolation_index - long_name = interpolation low index for stratospheric water vapor - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx2_h] - standard_name = upper_water_vapor_interpolation_index - long_name = interpolation high index for stratospheric water vapor - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx1_aer] - standard_name = lower_aerosol_y_interpolation_index - long_name = interpolation low index for prescribed aerosols in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx2_aer] - standard_name = upper_aerosol_y_interpolation_index - long_name = interpolation high index for prescribed aerosols in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[iindx1_aer] - standard_name = lower_aerosol_x_interpolation_index - long_name = interpolation low index for prescribed aerosols in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[iindx2_aer] - standard_name = upper_aerosol_x_interpolation_index - long_name = interpolation high index for prescribed aerosols in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx1_ci] - standard_name = lower_cloud_nuclei_y_interpolation_index - long_name = interpolation low index for ice and cloud condensation nuclei in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[jindx2_ci] - standard_name = upper_cloud_nuclei_y_interpolation_index - long_name = interpolation high index for ice and cloud condensation nuclei in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[iindx1_ci] - standard_name = lower_cloud_nuclei_x_interpolation_index - long_name = interpolation low index for ice and cloud condensation nuclei in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[iindx2_ci] - standard_name = upper_cloud_nuclei_x_interpolation_index - long_name = interpolation high index for ice and cloud condensation nuclei in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = inout - optional = F -[ddy_o3] - standard_name = ozone_interpolation_weight - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ddy_h] - standard_name = water_vapor_interpolation_weight - long_name = interpolation high index for stratospheric water vapor - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ddy_aer] - standard_name = aerosol_y_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the y direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ddx_aer] - standard_name = aerosol_x_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the x direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ddy_ci] - standard_name = cloud_nuclei_y_interpolation_weight - long_name = interpolation high index for ice and cloud condensation nuclei in the y direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ddx_ci] - standard_name = cloud_nuclei_x_interpolation_weight - long_name = interpolation high index for ice and cloud condensation nuclei in the x direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[oz_pres_int] - standard_name = natural_log_of_ozone_forcing_data_pressure_levels - long_name = natural log of ozone forcing data pressure levels - units = log(Pa) - dimensions = (vertical_dimension_of_ozone_forcing_data) - type = real - kind = kind_phys - intent = inout - optional = F -[h2o_pres_int] - standard_name = natural_log_of_h2o_forcing_data_pressure_levels - long_name = natural log of h2o forcing data pressure levels - units = log(Pa) - dimensions = (vertical_dimension_of_h2o_forcing_data) - type = real - kind = kind_phys - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -394,435 +77,20 @@ [ccpp-arg-table] name = GFS_phys_time_vary_run type = scheme -[levs] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F -[cnx] - standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face - long_name = number of points in x direction for this cubed sphere face - units = count - dimensions = () - type = integer - intent = in - optional = F -[cny] - standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face - long_name = number of points in y direction for this cubed sphere face - units = count - dimensions = () - type = integer - intent = in - optional = F -[isc] - standard_name = starting_x_index_for_this_MPI_rank - long_name = starting index in the x direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in - optional = F -[jsc] - standard_name = starting_y_index_for_this_MPI_rank - long_name = starting index in the y direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[master] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntoz] - standard_name = index_for_ozone - long_name = tracer index for ozone mixing ratio - units = index - dimensions = () - type = integer - intent = in - optional = F -[iccn] - standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics - long_name = flag for IN and CCN forcing for morrison gettelman microphysics - units = none - dimensions = () - type = integer - intent = in - optional = F -[nrcm] - standard_name = array_dimension_of_random_number - long_name = second dimension of random number stream for RAS - units = count - dimensions = () - type = integer - intent = in - optional = F -[nsswr] - standard_name = number_of_timesteps_between_shortwave_radiation_calls - long_name = number of timesteps between shortwave radiation calls - units = - dimensions = () - type = integer - intent = in - optional = F -[nszero] - standard_name = number_of_timesteps_between_diagnostic_clearing - long_name = number of timesteps between calls to clear diagnostic variables - units = count - dimensions = () - type = integer - intent = in - optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in - optional = F -[imfdeepcnv] - standard_name = flag_for_mass_flux_deep_convection_scheme - long_name = flag for mass-flux deep convection scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[seed0] - standard_name = seed_random_numbers_RAS - long_name = random number seed for the RAS scheme - units = none - dimensions = () - type = integer - intent = in - optional = F -[first_time_step] - standard_name = flag_for_first_time_step - long_name = flag for first time step for time integration loop (cold/warmstart) - units = flag - dimensions = () - type = logical - intent = in - optional = F -[lsswr] - standard_name = flag_to_calc_sw - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[cal_pre] - standard_name = flag_for_precipitation_type_algorithm - long_name = flag controls precip type algorithm - units = flag - dimensions = () - type = logical - intent = in - optional = F -[random_clds] - standard_name = flag_for_random_clouds_for_RAS - long_name = flag for using random clouds with the RAS scheme - units = flag - dimensions = () - type = logical - intent = in - optional = F -[h2o_phys] - standard_name = flag_for_stratospheric_water_vapor_physics - long_name = flag for stratospheric water vapor physics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[iaerclm] - standard_name = flag_for_aerosol_input_MG_radiation - long_name = flag for using aerosols in Morrison-Gettelman MP_radiation - units = flag - dimensions = () - type = logical - intent = in - optional = F -[fhswr] - standard_name = frequency_for_shortwave_radiation - long_name = frequency for shortwave radiation - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[fhlwr] - standard_name = frequency_for_longwave_radiation - long_name = frequency for longwave radiation - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[fhour] - standard_name = forecast_time - long_name = current forecast time - units = h - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[fhzero] - standard_name = frequency_for_diagnostic_clearing - long_name = frequency for clearing diagnostic fields - units = h +[Grid] + standard_name = GFS_grid_type_instance + long_name = Fortran DDT containing FV3-GFS grid and interpolation related data + units = DDT dimensions = () - type = real - kind = kind_phys + type = GFS_grid_type intent = in optional = F -[dtp] - standard_name = time_step_for_physics - long_name = physics timestep - units = s +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[idate] - standard_name = date_and_time_at_model_initialization_reordered - long_name = initial date with different size and ordering - units = none - dimensions = (4) - type = integer - intent = in - optional = F -[jindx1_o3] - standard_name = lower_ozone_interpolation_index - long_name = interpolation low index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jindx2_o3] - standard_name = upper_ozone_interpolation_index - long_name = interpolation high index for ozone - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jindx1_h] - standard_name = lower_water_vapor_interpolation_index - long_name = interpolation low index for stratospheric water vapor - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jindx2_h] - standard_name = upper_water_vapor_interpolation_index - long_name = interpolation high index for stratospheric water vapor - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jindx1_aer] - standard_name = lower_aerosol_y_interpolation_index - long_name = interpolation low index for prescribed aerosols in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jindx2_aer] - standard_name = upper_aerosol_y_interpolation_index - long_name = interpolation high index for prescribed aerosols in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[iindx1_aer] - standard_name = lower_aerosol_x_interpolation_index - long_name = interpolation low index for prescribed aerosols in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[iindx2_aer] - standard_name = upper_aerosol_x_interpolation_index - long_name = interpolation high index for prescribed aerosols in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jindx1_ci] - standard_name = lower_cloud_nuclei_y_interpolation_index - long_name = interpolation low index for ice and cloud condensation nuclei in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jindx2_ci] - standard_name = upper_cloud_nuclei_y_interpolation_index - long_name = interpolation high index for ice and cloud condensation nuclei in the y direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[iindx1_ci] - standard_name = lower_cloud_nuclei_x_interpolation_index - long_name = interpolation low index for ice and cloud condensation nuclei in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[iindx2_ci] - standard_name = upper_cloud_nuclei_x_interpolation_index - long_name = interpolation high index for ice and cloud condensation nuclei in the x direction - units = index - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[blksz] - standard_name = ccpp_block_sizes - long_name = for explicit data blocking: block sizes of all blocks - units = count - dimensions = (ccpp_block_count) - type = integer - intent = in - optional = F -[imap] - standard_name = map_of_block_column_number_to_global_i_index - long_name = map of local index ix to global index i for this block - units = none - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[jmap] - standard_name = map_of_block_column_number_to_global_j_index - long_name = map of local index ix to global index j for this block - units = none - dimensions = (horizontal_dimension) - type = integer - intent = in - optional = F -[ddy_o3] - standard_name = ozone_interpolation_weight - long_name = interpolation high index for ozone - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ddy_h] - standard_name = water_vapor_interpolation_weight - long_name = interpolation high index for stratospheric water vapor - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ddy_aer] - standard_name = aerosol_y_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the y direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ddx_aer] - standard_name = aerosol_x_interpolation_weight - long_name = interpolation high index for prescribed aerosols in the x direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ddy_ci] - standard_name = cloud_nuclei_y_interpolation_weight - long_name = interpolation high index for ice and cloud condensation nuclei in the y direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ddx_ci] - standard_name = cloud_nuclei_x_interpolation_weight - long_name = interpolation high index for ice and cloud condensation nuclei in the x direction - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[vtype] - standard_name = vegetation_type_classification_real - long_name = vegetation type for lsm - units = index - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[weasd] - standard_name = water_equivalent_accumulated_snow_depth - long_name = water equiv of acc snow depth over land and sea ice - units = mm - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[prsl] - standard_name = air_pressure - long_name = mean layer pressure - units = Pa - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys + type = GFS_statein_type intent = in optional = F [Model] @@ -831,78 +99,30 @@ units = DDT dimensions = () type = GFS_control_type - intent = in - optional = F -[clstp] - standard_name = convective_cloud_switch - long_name = index used by cnvc90 (for convective clouds) - units = none - dimensions = () - type = real - kind = kind_phys - intent = inout - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys intent = inout optional = F -[rann] - standard_name = random_number_array - long_name = random number array (0-1) - units = none - dimensions = (horizontal_dimension,array_dimension_of_random_number) - type = real - kind = kind_phys - intent = inout - optional = F -[in_nm] - standard_name = in_number_concentration - long_name = IN number concentration - units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ccn_nm] - standard_name = ccn_number_concentration - long_name = CCN number concentration - units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ozpl] - standard_name = ozone_forcing - long_name = ozone forcing data - units = various - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) - type = real - kind = kind_phys +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = Fortran DDT containing FV3-GFS miscellaneous data + units = DDT + dimensions = () + type = GFS_tbd_type intent = inout optional = F -[h2opl] - standard_name = h2o_forcing - long_name = water forcing data - units = various - dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) - type = real - kind = kind_phys +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = Fortran DDT containing FV3-GFS surface fields + units = DDT + dimensions = () + type = GFS_sfcprop_type intent = inout optional = F -[aer_nm] - standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology - long_name = GOCART aerosol climatology number concentration - units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) - type = real - kind = kind_phys +[Cldprop] + standard_name = GFS_cldprop_type_instance + long_name = Fortran DDT containing FV3-GFS cloud fields + units = DDT + dimensions = () + type = GFS_cldprop_type intent = inout optional = F [Diag] @@ -913,6 +133,14 @@ type = GFS_diag_type intent = inout optional = F +[first_time_step] + standard_name = flag_for_first_time_step + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -929,4 +157,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 738065cfc..13ae5e14b 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -21,46 +21,29 @@ end subroutine GFS_rad_time_vary_init !> \section arg_table_GFS_rad_time_vary_run Argument Table !! \htmlinclude GFS_rad_time_vary_run.html !! - subroutine GFS_rad_time_vary_run (cnx, cny, lsswr, lslwr, isubc_sw, & - isubc_lw, sec, nblks, blksz, isc, jsc, imp_physics, & - imp_physics_zhao_carr, kdt, tgrs, qgrs_wv, prsi, imap, jmap, & - icsdsw, icsdlw, t_minus_two_delt, qv_minus_two_delt, & - t_minus_delt, qv_minus_delt, ps_minus_two_delt, ps_minus_delt, & - errmsg, errflg) + subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) use physparam, only: ipsd0, ipsdlim, iaerflg use mersenne_twister, only: random_setseed, random_index, random_stat use machine, only: kind_phys + use GFS_typedefs, only: GFS_statein_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_tbd_type use radcons, only: qmin, con_100 implicit none - integer, intent(in) :: cnx, cny, isubc_sw, isubc_lw, & - nblks, isc, jsc, imp_physics,& - imp_physics_zhao_carr, kdt - logical, intent(in) :: lsswr, lslwr - real(kind=kind_phys), intent(in) :: sec - - integer, dimension(nblks), intent(in) :: blksz - integer, dimension(:), intent(in) :: imap, jmap - - integer, dimension(:), intent(inout) :: icsdsw, icsdlw - - real(kind=kind_phys), dimension(:,:), intent(in) :: tgrs, qgrs_wv - real(kind=kind_phys), dimension(:,:), intent(in) :: prsi - - real(kind=kind_phys), dimension(:,:), intent(inout) :: t_minus_two_delt, & - qv_minus_two_delt, t_minus_delt, qv_minus_delt - real(kind=kind_phys), dimension(:), intent(inout) :: ps_minus_two_delt,& - ps_minus_delt - + type(GFS_control_type), intent(inout) :: Model + type(GFS_statein_type), intent(in) :: Statein + type(GFS_tbd_type), intent(inout) :: Tbd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg !--- local variables type (random_stat) :: stat - integer :: ix, nb, j, i, ipseed - integer :: numrdm(cnx*cny*2) + integer :: ix, nb, j, i, nblks, ipseed + integer :: numrdm(Model%cnx*Model%cny*2) ! Initialize CCPP error handling variables errmsg = '' @@ -68,34 +51,34 @@ subroutine GFS_rad_time_vary_run (cnx, cny, lsswr, lslwr, isubc_sw, & nb = 1 - if (lsswr .or. lslwr) then + if (Model%lsswr .or. Model%lslwr) then !--- call to GFS_radupdate_run is now in GFS_rrtmg_setup_run !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) - if ((isubc_lw==2) .or. (isubc_sw==2)) then - ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 + if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then + ipseed = mod(nint(con_100*sqrt(Model%sec)), ipsdlim) + 1 + ipsd0 call random_setseed (ipseed, stat) call random_index (ipsdlim, numrdm, stat) !--- set the random seeds for each column in a reproducible way - do ix=1,blksz(nb) - j = jmap(ix) - i = imap(ix) + do ix=1,Model%blksz(nb) + j = Tbd%jmap(ix) + i = Tbd%imap(ix) !--- for testing purposes, replace numrdm with '100' - icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) - icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) + Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) + Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) enddo endif ! isubc_lw and isubc_sw - if (imp_physics == imp_physics_zhao_carr) then - if (kdt == 1) then - t_minus_two_delt(:,:) = tgrs - qv_minus_two_delt(:,:) = max(qmin,qgrs_wv(:,:)) - t_minus_delt(:,:) = tgrs - qv_minus_delt(:,:) = max(qmin,qgrs_wv(:,:)) - ps_minus_two_delt(:) = prsi(:,1) - ps_minus_delt(:) = prsi(:,1) + if (Model%imp_physics == 99) then + if (Model%kdt == 1) then + Tbd%phy_f3d(:,:,1) = Statein%tgrs + Tbd%phy_f3d(:,:,2) = max(qmin,Statein%qgrs(:,:,1)) + Tbd%phy_f3d(:,:,3) = Statein%tgrs + Tbd%phy_f3d(:,:,4) = max(qmin,Statein%qgrs(:,:,1)) + Tbd%phy_f2d(:,1) = Statein%prsi(:,1) + Tbd%phy_f2d(:,2) = Statein%prsi(:,1) endif endif diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index b5de5ed12..7e87f1f8a 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -6,230 +6,28 @@ [ccpp-arg-table] name = GFS_rad_time_vary_run type = scheme -[cnx] - standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face - long_name = number of points in x direction for this cubed sphere face - units = count +[Model] + standard_name = GFS_control_type_instance + long_name = Fortran DDT containing FV3-GFS model control parameters + units = DDT dimensions = () - type = integer - intent = in - optional = F -[cny] - standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face - long_name = number of points in y direction for this cubed sphere face - units = count - dimensions = () - type = integer - intent = in - optional = F -[lsswr] - standard_name = flag_to_calc_sw - long_name = logical flags for sw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[lslwr] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[isubc_sw] - standard_name = flag_for_sw_clouds_without_sub_grid_approximation - long_name = flag for sw clouds without sub-grid approximation - units = flag - dimensions = () - type = integer - intent = in - optional = F -[isubc_lw] - standard_name = flag_for_lw_clouds_without_sub_grid_approximation - long_name = flag for lw clouds without sub-grid approximation - units = flag - dimensions = () - type = integer - intent = in - optional = F -[sec] - standard_name = seconds_elapsed_since_model_initialization - long_name = seconds elapsed since model initialization - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[nblks] - standard_name = ccpp_block_count - long_name = for explicit data blocking: number of blocks - units = count - dimensions = () - type = integer - intent = in - optional = F -[blksz] - standard_name = ccpp_block_sizes - long_name = for explicit data blocking: block sizes of all blocks - units = count - dimensions = (ccpp_block_count) - type = integer - intent = in - optional = F -[isc] - standard_name = starting_x_index_for_this_MPI_rank - long_name = starting index in the x direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in - optional = F -[jsc] - standard_name = starting_y_index_for_this_MPI_rank - long_name = starting index in the y direction for this MPI rank - units = count - dimensions = () - type = integer - intent = in - optional = F -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in + type = GFS_control_type + intent = inout optional = F -[imp_physics_zhao_carr] - standard_name = flag_for_zhao_carr_microphysics_scheme - long_name = choice of Zhao-Carr microphysics scheme - units = flag +[Statein] + standard_name = GFS_statein_type_instance + long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore + units = DDT dimensions = () - type = integer + type = GFS_statein_type intent = in optional = F -[kdt] - standard_name = index_of_time_step - long_name = current forecast iteration - units = index +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = Fortran DDT containing FV3-GFS data not yet assigned to a defined container + units = DDT dimensions = () - type = integer - intent = in - optional = F -[tgrs] - standard_name = air_temperature - long_name = model layer mean temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[qgrs_wv] - standard_name = water_vapor_specific_humidity - long_name = water vapor specific humidity - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[prsi] - standard_name = air_pressure_at_interface - long_name = air pressure at model layer interfaces - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[imap] - standard_name = map_of_block_column_number_to_global_i_index - long_name = map of local index ix to global index i for this block - units = none - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F -[jmap] - standard_name = map_of_block_column_number_to_global_j_index - long_name = map of local index ix to global index j for this block - units = none - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F -[icsdsw] - standard_name = seed_random_numbers_sw - long_name = random seeds for sub-column cloud generators sw - units = none - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F -[icsdlw] - standard_name = seed_random_numbers_lw - long_name = random seeds for sub-column cloud generators lw - units = none - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F -[t_minus_two_delt] - standard_name = air_temperature_two_timesteps_back - long_name = air temperature two timesteps back - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qv_minus_two_delt] - standard_name = water_vapor_specific_humidity_two_timesteps_back - long_name = water vapor specific humidity two timesteps back - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[t_minus_delt] - standard_name = air_temperature_at_previous_timestep - long_name = air temperature at previous timestep - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qv_minus_delt] - standard_name = water_vapor_specific_humidity_at_previous_timestep - long_name = water vapor specific humidity at previous timestep - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[ps_minus_two_delt] - standard_name = surface_air_pressure_two_timesteps_back - long_name = surface air pressure two timesteps back - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[ps_minus_delt] - standard_name = surface_air_pressure_at_previous_timestep - long_name = surface air pressure at previous timestep - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys + type = GFS_tbd_type intent = inout optional = F [errmsg] From 915f71a0b5741a9d02057d86eea1aff6886152af Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 31 Aug 2020 12:34:08 -0600 Subject: [PATCH 044/274] remove do_sfcperts and pertabl from GFS_rrtmg_pre --- physics/GFS_rrtmg_pre.F90 | 8 ++++---- physics/GFS_rrtmg_pre.meta | 17 ----------------- 2 files changed, 4 insertions(+), 21 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 0759ce596..05442d0be 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -26,8 +26,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & imp_physics_zhao_carr_pdf, imp_physics_mg, imp_physics_wsm6, & imp_physics_fer_hires, lndp_var_list, lsswr, lslwr, & ltaerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf, lmfshal, & - lmfdeep2, do_sfcperts, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & - rog, rocp, con_rd, pertalb, xlat, xlon, coslat, sinlat, tsfc, slmsk, & + lmfdeep2, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & + rog, rocp, con_rd, xlat, xlon, coslat, sinlat, tsfc, slmsk, & prsi, prsl, prslk, tgrs, sfc_wts, phy_f3d_mg_cld, phy_f3d_reffr, & phy_f3d_cnvw, phy_f3d_cnvc, f_ice, f_rain, f_rimef, qgrs, aer_nm, & !inputs from here and above coszen, coszdg, phy_f3d_leffr, phy_f3d_ieffr, phy_f3d_seffr, & @@ -91,12 +91,12 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, & uni_cld, effr_in, do_mynnedmf, & - lmfshal, lmfdeep2, do_sfcperts + lmfshal, lmfdeep2 real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup real(kind=kind_phys), intent(in) :: eps, epsm1, fvirt, rog, rocp, con_rd - real(kind=kind_phys), dimension(:), intent(in) :: pertalb, xlat, xlon, & + real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & coslat, sinlat, tsfc, & slmsk diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index d602834a4..6cee57101 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -399,14 +399,6 @@ type = logical intent = in optional = F -[do_sfcperts] - standard_name = flag_for_stochastic_surface_perturbations - long_name = flag for stochastic surface perturbations option - units = flag - dimensions = () - type = logical - intent = in - optional = F [fhswr] standard_name = frequency_for_shortwave_radiation long_name = frequency for shortwave radiation @@ -497,15 +489,6 @@ kind = kind_phys intent = in optional = F -[pertalb] - standard_name = magnitude_of_surface_albedo_perturbation - long_name = magnitude of surface albedo perturbation - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F [xlat] standard_name = latitude long_name = latitude From 45cfe52756e7bd7a839e56ce2574840cbb8349b8 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Wed, 2 Sep 2020 22:09:32 +0000 Subject: [PATCH 045/274] 1st attempt - Sept. 2 --- physics/GFS_GWD_generic.F90 | 2 +- physics/cires_orowam2017.F90 | 347 +++++++ physics/cires_ugwp_initialize_v1.F90 | 799 ++++++++++++++++ physics/cires_ugwp_module_v1.F90 | 666 +++++++++++++ physics/cires_ugwp_ngw_utils.F90 | 73 ++ physics/cires_ugwp_orolm97_v1.F90 | 985 ++++++++++++++++++++ physics/cires_ugwp_solv2_v1_mod.F90 | 810 ++++++++++++++++ physics/cires_ugwp_triggers_v1.F90 | 576 ++++++++++++ physics/cires_vert_orodis.F90 | 8 + physics/drag_suite.F90 | 67 +- physics/drag_suite.meta | 24 + physics/unified_ugwp.F90 | 686 ++++++++++++++ physics/unified_ugwp.meta | 1296 ++++++++++++++++++++++++++ physics/unified_ugwp_post.F90 | 83 ++ physics/unified_ugwp_post.meta | 315 +++++++ 15 files changed, 6708 insertions(+), 29 deletions(-) create mode 100644 physics/cires_orowam2017.F90 create mode 100644 physics/cires_ugwp_initialize_v1.F90 create mode 100644 physics/cires_ugwp_module_v1.F90 create mode 100644 physics/cires_ugwp_ngw_utils.F90 create mode 100644 physics/cires_ugwp_orolm97_v1.F90 create mode 100644 physics/cires_ugwp_solv2_v1_mod.F90 create mode 100644 physics/cires_ugwp_triggers_v1.F90 create mode 100644 physics/unified_ugwp.F90 create mode 100644 physics/unified_ugwp.meta create mode 100644 physics/unified_ugwp_post.F90 create mode 100644 physics/unified_ugwp_post.meta diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index 09c969162..ed3ff4484 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -83,7 +83,7 @@ subroutine GFS_GWD_generic_pre_run( & clx(:,2) = 0.0 clx(:,3) = 0.0 clx(:,4) = 0.0 - elseif (nmtvr == 24) then ! GSD_drag_suite + elseif (nmtvr == 24) then ! GSD_drag_suite and unified_ugwp oc(:) = mntvar(:,2) oa4(:,1) = mntvar(:,3) oa4(:,2) = mntvar(:,4) diff --git a/physics/cires_orowam2017.F90 b/physics/cires_orowam2017.F90 new file mode 100644 index 000000000..752c6f84e --- /dev/null +++ b/physics/cires_orowam2017.F90 @@ -0,0 +1,347 @@ +module cires_orowam2017 + + +contains + + + subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, + & dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, + & del, sigma, hprime, gamma, theta, + & sinlat, xlatd, taup, taud, pkdis) +! + USE MACHINE , ONLY : kind_phys + use ugwp_common , only : grav, omega2 +! + implicit none + + integer :: im, levs + integer :: npt + integer :: kdt, me, master + integer :: kref(im), ipt(im) + real(kind=kind_phys), intent(in) :: dtp, dxres + real(kind=kind_phys), intent(in) :: taub(im) + + real(kind=kind_phys), intent(in) :: sinlat(im), xlatd(im) + real(kind=kind_phys), intent(in), dimension(im) :: sigma, + & hprime, gamma, theta + + real(kind=kind_phys), intent(in), dimension(im) :: xn, yn + + real(kind=kind_phys), intent(in), dimension(im, levs) :: + & u1, v1, t1, bn2, rho, prsl, del + + real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi +! +! out : taup, taud, pkdis +! + real(kind=kind_phys), intent(inout), dimension(im, levs+1) :: taup + real(kind=kind_phys), intent(inout), dimension(im, levs) :: taud + real(kind=kind_phys), intent(inout), dimension(im, levs) :: pkdis + real(kind=kind_phys) :: belps, aelps, nhills, selps +! +! multiwave oro-spectra +! locals +! + integer :: i, j, k, isp, iw + + integer, parameter :: nworo = 30 + real(kind=kind_phys), parameter :: fc_flag = 0.0 + real(kind=kind_phys), parameter :: mkzmin = 6.28e-3/50.0 + real(kind=kind_phys), parameter :: mkz2min = mkzmin* mkzmin + real(kind=kind_phys), parameter :: kedmin = 1.e-3 + real(kind=kind_phys), parameter :: kedmax = 350.,axmax=250.e-5 + real(kind=kind_phys), parameter :: rtau = 0.01 ! nonlin-OGW scale 1/10sec + real(kind=kind_phys), parameter :: Linsat2 =0.5 + real(kind=kind_phys), parameter :: kxmin = 6.28e-3/100. + real(kind=kind_phys), parameter :: kxmax = 6.28e-3/5.0 + real(kind=kind_phys), parameter :: dkx = (kxmax -kxmin)/(nworo-1) + real(kind=kind_phys), parameter :: kx_slope= -5./3. + real(kind=kind_phys), parameter :: hps =7000., rhp2 = .5/hps + real(kind=kind_phys), parameter :: cxmin=0.5, cxmin2=cxmin*cxmin + + real :: akx(nworo), cxoro(nworo), akx2(nworo) + real :: aspkx(nworo), c2f2(nworo) , cdf2(nworo) + real :: tau_sp(nworo,levs+1), wkdis(nworo, levs+1) + real :: tau_kx(nworo),taub_kx(nworo) + real, dimension(nworo, levs+1) :: wrms, akzw + + real :: tauz(levs+1), rms_wind(levs+1) + real :: wave_act(nworo,levs+1) + + real :: kxw, kzw, kzw2, kzw3, kzi, dzmet, rhoint + real :: rayf, kturb + real :: uz, bv, bv2,kxsp, fcor2, cf2 + + real :: fdis + real :: wfdm, wfdt, wfim, wfit + real :: betadis, betam, betat, kds, cx, rhofac + real :: etwk, etws, tauk, cx2sat + real :: cdf1, tau_norm +! +! mean flow +! + real, dimension(levs+1) :: uzi,rhoi,ktur, kalp, dzi + + integer :: nw, nzi, ksrc + taud (:, :) = 0.0 ; pkdis(:,:) = 0.0 ; taup (:,:) = 0.0 + tau_sp (:,:) = 0.0 ; wrms(:,:) = 0.0 + nw = nworo + nzi = levs+1 + + do iw = 1, nw +! !kxw = 0.25/(dxres)*iw + kxw = kxmin+(iw-1)*dkx + akx(iw) = kxw + akx2(iw) = kxw*kxw + aspkx(iw) = kxw ** (kx_slope) + tau_kx(iw) = aspkx(iw)*dkx + enddo + + tau_norm = sum(tau_kx) + tau_kx(:) = tau_kx(:)/tau_norm + + if (kdt == 1) then +771 format( 'vay-oro19 ', 3(2x,F8.3)) + write(6,771) + & maxval(tau_kx)*maxval(taub)*1.e3, + & minval(tau_kx), maxval(tau_kx) + endif +! +! main loop over oro-points +! + do i =1, npt + j = ipt(i) + +! +! estimate "nhills" => stochastic choices for OGWs +! + if (taub(i) > 0.) then +! +! max_kxridge =min( .5*sigma(j)/hprime(j), kmax) +! ridge-dependent dkx = (max_kxridge -kxmin)/(nw-1) +! option to make grid-box variable kx-spectra kxw = kxmin+(iw-1)*dkx +! + wave_act(1:nw, 1:levs+1) = 1.0 + ksrc = kref(i) + tauz(1:ksrc) = taub(i) + taub_kx(1:nw) = tau_kx(1:nw) * taub(i) + wkdis(:,:) = kedmin + + call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), + & prsi(j,:), prsL(j,:), del(j,:), rho(i,:), + & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, + & xn(i), yn(i)) + + fcor2 = (omega2*sinlat(j))*(omega2*sinlat(j))*fc_flag + + k = ksrc + + bv2 = bn2(i,k) + uz = uzi(k) !u1(j,ksrc)*xn(i)+v1(j,ksrc)*yn(i)! + kturb = ktur(k) + rayf = kalp(k) + rhoint = rhoi(k) + dzmet = dzi(k) + kzw = max(sqrt(bv2)/max(cxmin, uz), mkzmin) +! +! specify oro-kx spectra and related variables k=ksrc +! + do iw = 1, nw + kxw = akx(iw) + cxoro(iw) = 0.0 - uz + c2f2(iw) = fcor2/akx2(iw) + wrms(iw,k)= taub_kx(iw)/rhoint*kzw/kxw + tau_sp(iw, k) = taub_kx(iw) +! +! + if (cxoro(iw) > cxmin) then + wave_act(iw,k:levs+1) = 0. ! crit-level + else + cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) + if ( cdf2(iw) < cxmin2) then + wave_act(iw,k:levs+1) = 0. ! coriolis cut-off + else + kzw2 = max(Bv2/Cdf2(iw) - akx2(iw), mkz2min) + kzw = sqrt(kzw2) + akzw(iw,k)= kzw + wrms(iw,k)= taub_kx(iw)/rhoint * kzw/kxw + endif + endif + enddo ! nw-spectral loop +! +! defined abobe, k = ksrc: akx(nworo), cxoro(nworo), tau_sp(ksrc, nworo) +! propagate upward multiwave-spectra are filtered by dissipation & instability +! +! tau_sp(:,ksrc+1:levs+1) = tau_sp(:, ksrc) + do k= ksrc+1, levs + uz = uzi(k) + bv2 =bn2(i,k) + bv = sqrt(bv2) + rayf = kalp(k) + rhoint= rhoi(k) + dzmet = dzi(k) + rhofac = rhoi(k-1)/rhoi(k) + + do iw = 1, nworo +! + if (wave_act(iw, k-1) <= 0.0) cycle + cxoro(iw)= 0.0 - uz + if ( cxoro(iw) > cxmin) then + wave_act(iw,k:levs+1) = 0.0 ! crit-level + else + cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) + if ( cdf2(iw) < cxmin2) wave_act(iw,k:levs+1) = 0.0 + endif + if ( wave_act(iw,k) <= 0.0) cycle +! +! upward propagation +! + kzw2 = Bv2/Cdf2(iw) - akx2(iw) + + if (kzw2 < mkz2min) then + wave_act(iw,k:levs+1) = 0.0 + else +! +! upward propagation w/o reflection +! + kxw = akx(iw) + kzw = sqrt(kzw2) + akzw(iw,k) = kzw + kzw3 = kzw2*kzw + + cx = cxoro(iw) + betadis = cdf2(iw) / (Cx*Cx+c2f2(iw)) + betaM = 1.0 / (1.0+betadis) + betaT = 1.0 - BetaM + kds = wkdis(iw,k-1) + + etws = wrms(iw,k-1)*rhofac * kzw/akzw(iw,k-1) + + kturb = ktur(k)+pkdis(j,k-1) + wfiM = kturb*kzw2 +rayf + wfiT = wfiM ! do updates with Pr-numbers Kv/Kt + cdf1 = sqrt(Cdf2(iw)) + wfdM = wfiM/(kxw*Cdf1)*BetaM + wfdT = wfiT/(kxw*Cdf1)*BetaT + kzi = 2.*kzw*(wfdM+wfdT)*dzmet + Fdis = exp(-kzi) + + etwk = etws*Fdis + Cx2sat = Linsat2*Cdf2(iw) + + if (etwk > cx2sat) then + Kds = kxw*Cdf1*rhp2/kzw3 + etwk = cx2sat + wfiM = kds*kzw2 + wfdM = wfiM/(kxw*Cdf1) + kzi = 2.*kzw*(wfdm + wfdm)*dzmet + etwk = cx2sat*exp(-kzi) + endif +! if( lat(j) eq 40.5 ) then stop + wkdis(iw,k) = kds + wrms(iw,k) = etwk + tauk = etwk*kxw/kzw + tau_sp(iw,k) = tauk *rhoint + if ( tau_sp(iw,k) > tau_sp(iw,k-1)) + & tau_sp(iw,k) = tau_sp(iw,k-1) + + ENDIF ! upward + ENDDO ! spectral + +!......... do spectral sum of rms, wkdis, tau + + tauz(k) = sum( tau_sp(:,k)*wave_act(:,k) ) + rms_wind(k) = sum( wrms(:,k)*wave_act(:,k) ) + + pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k))+rms_wind(k)*rtau + + if (pkdis(j,k) > kedmax) pkdis(j,k) = kedmax + + ENDDO ! k=ksrc+1, levs + + k = ksrc + tauz(k) = sum(tau_sp(:,k)*wave_act(:,k)) + tauz(k) = tauz(k+1) ! zero momentum dep-n at k=ksrc + + pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k)) + rms_wind(k) = sum(wrms(:,k)*wave_act(:,k)) + tauz(levs+1) = tauz(levs) + taup(i, 1:levs+1) = tauz(1:levs+1) + do k=ksrc, levs + taud(i,k) = ( tauz(k+1) - tauz(k))*grav/del(j,k) +! if (taud(i,k) .gt. 0)taud(i,k)=taud(i,k)*.01 +! if (abs(taud(i,k)).ge.axmax)taud(i,k)=sign(taud(i,k),axmax) + enddo + endif ! taub > 0 + enddo ! oro-points (i, j, ipt) +!23456 + end subroutine oro_wam_2017 +!------------------------------------------------------------- +! +! define mean flow and dissipation for OGW-kx spectrum +! +!------------------------------------------------------------- + subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, + & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) + + use ugwp_common , only : grav, rgrav, rdi, velmin, dw2min + implicit none + + integer :: nz, nzi + real, dimension(nz ) :: u1, v1, t1, delp, rho, pmid + real, dimension(nz ) :: bn2 ! define at the interfaces + real, dimension(nz+1) :: pint + real :: xn, yn +! output + + real, dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp + +! locals + integer :: i, j, k + real :: ui, vi, ti, uz, vz, shr2, rdz, kamp + real :: zgrow, zmet, rdpm, ritur, kmol, w1 +! paremeters + real, parameter :: hps = 7000., rpspa = 1.e-5 + real, parameter :: rhps=1.0/hps + real, parameter :: h4= 0.25/hps + real, parameter :: rimin = 1.0/8.0, kedmin = 0.01 + real, parameter :: lturb = 30. , uturb = 150.0 + real, parameter :: lsc2 = lturb*lturb,usc2 = uturb*uturb + kalp(1:nzi) = 2.e-7 ! radiative damping + + do k=2, nz + rdpm = grav/(pmid(k-1)-pmid(k)) + ui = .5*(u1(k-1)+u1(k)) + vi = .5*(v1(k-1)+v1(k)) + uzi(k) = Ui*xn + Vi*yn + ti = .5*(t1(k-1)+t1(k)) + rhoi(k) = rdi*pint(k)/ti + rdz = rdpm *rhoi(k) + dzi(k) = 1./rdz + uz = u1(k)-u1(k-1) + vz = v1(k)-v1(k-1) + shr2 = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) + zmet = -hps*alog(pint(k)*rpspa) + zgrow = exp(zmet*h4) + kmol = 2.e-5*exp(zmet*rhps)+kedmin + ritur = max(bn2(k)/shr2, rimin) + kamp = sqrt(shr2)*lsc2 *zgrow + w1 = 1./(1. + 5*ritur) + ktur(k) = kamp * w1 * w1 +kmol + enddo + + k = 1 + uzi(k) = uzi(k+1) + ktur(k) = ktur(k+1) + rhoi(k) = rdi*pint(k)/t1(k+1) + dzi(k) = rgrav*delp(k)/rhoi(k) + + k = nzi + uzi(k) = uzi(k-1) + ktur(k) = ktur(k-1) + rhoi(k) = rhoi(k-1)*.5 + dzi(k) = dzi(k-1) + + end subroutine oro_meanflow + +end module cires_orowam2017 diff --git a/physics/cires_ugwp_initialize_v1.F90 b/physics/cires_ugwp_initialize_v1.F90 new file mode 100644 index 000000000..eef5cc04e --- /dev/null +++ b/physics/cires_ugwp_initialize_v1.F90 @@ -0,0 +1,799 @@ +!=============================== +! cu-cires ugwp-scheme +! initialization of selected +! init gw-solvers (1,2,3,4) +! init gw-source specifications +! init gw-background dissipation +!============================== +! +! Part-0 specifications of common constants, limiters and "criiical" values +! +! + + module ugwp_common +! +! use machine, only : kind_phys +! use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & +! rv => con_rv, cpd => con_cp, fv => con_fvirt,& +! arad => con_rerth + implicit none + + real, parameter :: grav =9.81, cpd = 1004. + real, parameter :: rd = 287.0 , rv =461.5 + real, parameter :: grav2 = grav + grav + real, parameter :: rgrav = 1.0/grav, rgrav2= rgrav*rgrav + + real, parameter :: fv = rv/rd - 1.0 + real, parameter :: rdi = 1.0 / rd, rcpd = 1./cpd, rcpd2 = 0.5/cpd + real, parameter :: gor = grav/rd + real, parameter :: gr2 = grav*gor + real, parameter :: grcp = grav*rcpd, gocp = grcp + real, parameter :: rcpdl = cpd*rgrav ! 1/[g/cp] == cp/g + real, parameter :: grav2cpd = grav*grcp ! g*(g/cp)= g^2/cp + + real, parameter :: pi = 4.*atan(1.0), pi2 = 2.*pi, pih = .5*pi + real, parameter :: rad_to_deg=180.0/pi, deg_to_rad=pi/180.0 + + real, parameter :: arad = 6370.e3 +! + real, parameter :: bnv2min = (pi2/1800.)*(pi2/1800.) + real, parameter :: bnv2max = (pi2/30.)*(pi2/30.) + + real, parameter :: dw2min=1.0, velmin=sqrt(dw2min), minvel = 0.5 + real, parameter :: omega1 = pi2/86400. + real, parameter :: omega2 = 2.*omega1, omega3 = 3.*omega1 + real, parameter :: hpscale= 7000., rhp=1./hpscale, rhp2=.5*rhp, rh4 = 0.25*rhp + real, parameter :: mkzmin = pi2/80.0e3, mkz2min = mkzmin*mkzmin + real, parameter :: mkzmax = pi2/500., mkz2max = mkzmax*mkzmax + real, parameter :: cdmin = 2.e-2/mkzmax + end module ugwp_common +! +! +!=================================================== +! +!Part-1 init => wave dissipation + RFriction +! +!=================================================== + subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) + + use ugwp_common, only : pih + + + implicit none + integer , intent(in) :: me, master + integer , intent(in) :: levs + real, intent(in) :: pa_rf, tau_rf + real, intent(in) :: zkm(levs), pmb(levs) ! in km-Pa + real, intent(out), dimension(levs+1) :: kvg, ktg, krad, kion +! +!locals + data +! + integer :: k + real, parameter :: vusurf = 2.e-5 + real, parameter :: musurf = vusurf/1.95 + real, parameter :: hpmol = 8.5 +! + real, parameter :: kzmin = 0.1 + real, parameter :: kturbo = 100. + real, parameter :: zturbo = 130. + real, parameter :: zturw = 30. + real, parameter :: inv_pra = 3. !kt/kv =inv_pr +! + real, parameter :: alpha = 1./86400./15. ! height variable see Zhu-1993 from 60-days => 6 days + real :: pa_alp = 750. ! super-RF parameters + real :: tau_alp = 10. ! days (750 Pa /10days) +! + real, parameter :: kdrag = 1./86400./30. !parametrization for WAM for FV3GFS SuperRF + real, parameter :: zdrag = 100. + real, parameter :: zgrow = 50. +! + real :: vumol, mumol, keddy, ion_drag + real :: rf_fv3, rtau_fv3, ptop, pih_dlog +! + real :: ae1 ,ae2 + pa_alp = pa_rf + tau_alp = tau_rf + + ptop = pmb(levs) + rtau_fv3 = 1./86400./tau_alp + pih_dlog = pih/log(pa_alp/ptop) + + do k=1, levs + ae1 = -zkm(k)/hpmol + vumol = vusurf*exp(ae1) + mumol = musurf*exp(ae1) + ae2 = -((zkm(k)-zturbo) /zturw)**2 + keddy = kturbo*exp(ae2) + + kvg(k) = vumol + keddy + ktg(k) = mumol + keddy*inv_pra + + krad(k) = alpha +! + ion_drag = kdrag +! + kion(k) = ion_drag! +! add Rayleigh_Super of FV3 for pmb < pa_alp +! + if (pmb(k) .le. pa_alp) then + rf_fv3=rtau_fv3*sin(pih_dlog*log(pa_alp/pmb(k)))**2 + krad(k) = krad(k) + rf_fv3 + kion(k) = kion(k) + rf_fv3 + + endif + +! write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) + enddo + + k= levs+1 + kion(k) = kion(k-1) + krad(k) = krad(k-1) + kvg(k) = kvg(k-1) + ktg(k) = ktg(k-1) + if (me == master) then + write(6, * ) ' zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) ' + do k=1, levs, 1 + write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k), pmb(k) + enddo + endif +! + 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) + + end subroutine init_global_gwdis +! +! + subroutine rf_damp_init(levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) + implicit none + + integer :: levs + real :: pa_rf, tau_rf + real :: dtp + + real :: pmb(levs) + real :: rfdis(levs), rfdist(levs) + integer :: levs_rf + + real :: krf, krfz + integer :: k +! + rfdis(1:levs) = 1.0 + rfdist(1:levs) = 0.0 + levs_rf = levs + if (tau_rf <= 0.0 .or. pa_rf == 0.0) return + + krf = 1.0/(tau_rf*86400.0) + + do k=levs, 1, -1 + if(pmb(k) < pa_rf ) then ! applied only on constant pressure surfaces fixed pmb in "Pa" + krfz = krf*log(pa_rf/pmb(k)) + rfdis(k) = 1.0/(1.+krfz*dtp) + rfdist(k) = (rfdis(k) -1.0)/dtp ! du/dtp + levs_rf = k + endif + enddo + + end subroutine rf_damp_init +! ======================================================================== +! Part 2 - sources +! wave sources +! ======================================================================== +! +! ugwp_oro_init +! +!========================================================================= + module ugwp_oro_init + + use ugwp_common, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi + use ugwp_common, only : mkzmin, mkz2min + implicit none +! +! constants and "crirtical" values to run oro-mtb_gw physics +! +! choice of oro-scheme: strver = 'vay_2018' , 'gfs_2018', 'kdn_2005', 'smc_2000' +! +! + real, parameter :: hncrit=9000. ! max value in meters for elvmax + real, parameter :: hminmt=50. ! min mtn height (*j*) + real, parameter :: sigfac=4.0 ! mb3a expt test for elvmax factor +! +! + real, parameter :: minwnd=1.0 ! min wind component (*j*) + real, parameter :: dpmin=5000.0 ! minimum thickness of the reference layer in pa + real, parameter :: hpmax=2400.0, hpmin=25.0 + + character(len=8) :: strver = 'gfs_2018' + character(len=8) :: strbase = 'gfs_2018' + real, parameter :: rimin=-10., ric=0.25 + +! + real, parameter :: efmin=0.5, efmax=10.0 + + + real, parameter :: sigma_std=1./100., gamm_std=1.0 + + real, parameter :: frmax=10., frc =1.0, frmin =0.01 +! + + real, parameter :: ce=0.8, ceofrc=ce/frc, cg=0.5 + real, parameter :: gmax=1.0, veleps=1.0, factop=0.5 +! + real, parameter :: rlolev=50000.0 +! + + +! hncrit set to 8000m and sigfac added to enhance elvmax mtn hgt + + + + real, parameter :: kxoro=6.28e-3/200. ! + real, parameter :: coro = 0.0 + integer, parameter :: nridge=2 + + real :: cdmb ! scale factors for mtb + real :: cleff ! scale factors for orogw + integer :: nworo ! number of waves + integer :: nazoro ! number of azimuths + integer :: nstoro ! flag for stochastic launch above SG-peak + + integer, parameter :: mdir = 8 + real, parameter :: fdir=.5*mdir/pi + + integer nwdir(mdir) + data nwdir/6,7,5,8,2,3,1,4/ + save nwdir + + real, parameter :: odmin = 0.1, odmax = 10.0 +!------------------------------------------------------------------------------ +! small-scale orography parameters for TOFD of Beljaars et al., 2004, QJRMS +!------------------------------------------------------------------------------ + + integer, parameter :: n_tofd = 2 ! depth of SSO for TOFD compared with Zpbl + real, parameter :: const_tofd = 0.0759 ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + real, parameter :: ze_tofd = 1500.0 ! BJ's z-decay in meters + real, parameter :: a12_tofd = 0.0002662*0.005363 ! BJ's k-spect const for sigf2 * a1*a2*exp(-[z/zdec]**1.5] + real, parameter :: ztop_tofd = 10.*ze_tofd ! no TOFD > this height too higher 15 km +!------------------------------------------------------------------------------ +! + real, parameter :: fcrit_sm = 0.7, fcrit_sm2 = fcrit_sm * fcrit_sm + real, parameter :: fcrit_gfs = 0.7 + real, parameter :: fcrit_mtb = 0.7 + + real, parameter :: zbr_pi = (1.0/2.0)*pi + real, parameter :: zbr_ifs = 0.5*pi + + contains +! + subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & + lonr, kxw, cdmbgwd ) +! +! + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: cdmbgwd(2) ! scaling factors for MTb (1) & (2) for cleff = cleff * cdmbgwd(2) + ! high res-n "larger" MTB and "less-active" cleff in GFS-2018 + real :: cdmbX + real :: kxw + real :: effac ! it is analog of cdmbgwd(2) for GWs, off for now +!-----------------------------! GFS-setup for cdmb & cleff +! cdmb = 4.0 * (192.0/IMX) +! cleff = 0.5E-5 / SQRT(IMX/192.0) = 0.5E-5*SQRT(192./IMX) +! + real, parameter :: lonr_refmb = 4.0 * 192.0 + real, parameter :: lonr_refgw = 192.0 + +! copy to "ugwp_oro_init" => nwaves, nazdir, nstoch + + nworo = nwaves + nazoro = nazdir + nstoro = nstoch + + cdmbX = lonr_refmb/float(lonr) + cdmb = cdmbX + if (cdmbgwd(1) >= 0.0) cdmb = cdmb * cdmbgwd(1) + + cleff = 0.5e-5 * sqrt(lonr_refgw/float(lonr)) !* effac + +!!! cleff = kxw * sqrt(lonr_refgw/float(lonr)) !* effac + + if (cdmbgwd(2) >= 0.0) cleff = cleff * cdmbgwd(2) +! +!.................................................................... +! higher res => smaller h' ..&.. higher kx +! flux_gwd ~ 'u'^2*kx/kz ~kxu/n ~1/dx *u/n tau ~ h'*h'*kx*kx = const (h'-less kx-grow) +!.................................................................... +! +! print *, ' init_oro_gws 2-1cdmb', cdmbgwd(2), cdmbgwd(1) + end subroutine init_oro_gws +! + + end module ugwp_oro_init +! ========================================================================= +! +! ugwp_conv_init +! +!========================================================================= + module ugwp_conv_init + + implicit none + real :: eff_con ! scale factors for conv GWs + integer :: nwcon ! number of waves + integer :: nazcon ! number of azimuths + integer :: nstcon ! flag for stochastic choice of launch level above Conv-cloud + real :: con_dlength + real :: con_cldf + + real, parameter :: cmin = 5 !2.5 + real, parameter :: cmax = 95. !82.5 + real, parameter :: cmid = 22.5 + real, parameter :: cwid = cmid + real, parameter :: bns = 2.e-2, bns2 = bns*bns, bns4=bns2*bns2 + real, parameter :: mstar = 6.28e-3/2. ! 2km + real :: dc + + real, allocatable :: ch_conv(:), spf_conv(:) + real, allocatable :: xaz_conv(:), yaz_conv(:) + contains +! + subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & + lonr, kxw, cgwf) + use ugwp_common, only : pi2, arad + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: cgwf(2) + real :: kxw, effac + real :: work1 = 0.5 + real :: chk, tn4, snorm + integer :: k + + nwcon = nwaves + nazcon = nazdir + nstcon = nstoch + eff_con = effac + + con_dlength = pi2*arad/float(lonr) + con_cldf = cgwf(1) * work1 + cgwf(2) *(1.-work1) +! +! allocate & define spectra in "selected direction": "dc" "ch(nwaves)" +! + if (.not. allocated(ch_conv)) allocate (ch_conv(nwaves)) + if (.not. allocated(spf_conv)) allocate (spf_conv(nwaves)) + if (.not. allocated(xaz_conv)) allocate (xaz_conv(nazdir)) + if (.not. allocated(yaz_conv)) allocate (yaz_conv(nazdir)) + + dc = (cmax-cmin)/float(nwaves-1) +! +! we may use different spectral "shapes" +! for example FVS-93 "Desabeius" +! E(s=1, t=3,m, w, k) ~ m^s/(m*^4 + m^4) ~ m^-3 saturated tail +! + do k = 1,nwaves + chk = cmin + (k-1)*dc + tn4 = (mstar*chk)**4 + ch_conv(k) = chk + spf_conv(k) = bns4*chk/(bns4+tn4) + enddo + + snorm = sum(spf_conv) + spf_conv = spf_conv/snorm*1.5 + + call init_nazdir(nazdir, xaz_conv, yaz_conv) + end subroutine init_conv_gws + + + end module ugwp_conv_init +!========================================================================= +! +! ugwp_fjet_init +! +!========================================================================= + + module ugwp_fjet_init + implicit none + real :: eff_fj ! scale factors for conv GWs + integer :: nwfj ! number of waves + integer :: nazfj ! number of azimuths + integer :: nstfj ! flag for stochastic choice of launch level above Conv-cloud +! + real, parameter :: fjet_trig=0. ! if ( abs(frgf) > fjet_trig ) launch GW-packet + + + real, parameter :: cmin = 2.5 + real, parameter :: cmax = 67.5 + real :: dc + real, allocatable :: ch_fjet(:) , spf_fjet(:) + real, allocatable :: xaz_fjet(:), yaz_fjet(:) + contains + subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) + use ugwp_common, only : pi2, arad + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: kxw, effac , chk + + integer :: k + + nwfj = nwaves + nazfj = nazdir + nstfj = nstoch + eff_fj = effac + + if (.not. allocated(ch_fjet)) allocate (ch_fjet(nwaves)) + if (.not. allocated(spf_fjet)) allocate (spf_fjet(nwaves)) + if (.not. allocated(xaz_fjet)) allocate (xaz_fjet(nazdir)) + if (.not. allocated(yaz_fjet)) allocate (yaz_fjet(nazdir)) + + dc = (cmax-cmin)/float(nwaves-1) + do k = 1,nwaves + chk = cmin + (k-1)*dc + ch_fjet(k) = chk + spf_fjet(k) = 1.0 + enddo + call init_nazdir(nazdir, xaz_fjet, yaz_fjet) + + end subroutine init_fjet_gws + + end module ugwp_fjet_init +! +!========================================================================= +! +! + module ugwp_okw_init +!========================================================================= + implicit none + + real :: eff_okw ! scale factors for conv GWs + integer :: nwokw ! number of waves + integer :: nazokw ! number of azimuths + integer :: nstokw ! flag for stochastic choice of launch level above Conv-cloud +! + real, parameter :: okw_trig=0. ! if ( abs(okwp) > okw_trig ) launch GW-packet + + real, parameter :: cmin = 2.5 + real, parameter :: cmax = 67.5 + real :: dc + real, allocatable :: ch_okwp(:), spf_okwp(:) + real, allocatable :: xaz_okwp(:), yaz_okwp(:) + + contains +! + subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) + + use ugwp_common, only : pi2, arad + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real :: kxw, effac , chk + + integer :: k + + nwokw = nwaves + nazokw = nazdir + nstokw = nstoch + eff_okw = effac + + if (.not. allocated(ch_okwp)) allocate (ch_okwp(nwaves)) + if (.not. allocated(spf_okwp)) allocate (spf_okwp(nwaves)) + if (.not. allocated(xaz_okwp)) allocate (xaz_okwp(nazdir)) + if (.not. allocated(yaz_okwp)) allocate (yaz_okwp(nazdir)) + dc = (cmax-cmin)/float(nwaves-1) + do k = 1,nwaves + chk = cmin + (k-1)*dc + ch_okwp(k) = chk + spf_okwp(k) = 1. + enddo + + call init_nazdir(nazdir, xaz_okwp, yaz_okwp) + + end subroutine init_okw_gws + + end module ugwp_okw_init + +!=============================== end of GW sources +! +! init specific gw-solvers (1,2,3,4) +! + +!=============================== +! Part -3 init wave solvers +!=============================== + + module ugwp_lsatdis_init + implicit none + + integer :: nwav, nazd + integer :: nst + real :: eff + integer, parameter :: incdim = 4, iazdim = 4 +! + contains + + subroutine initsolv_lsatdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) + + implicit none +! + integer :: me, master + integer :: nwaves, nazdir + integer :: nstoch + real :: effac + logical :: do_physb + real :: kxw +! +!locals: define azimuths and Ch(nwaves) - domain when physics-based soureces +! are not actibve +! + integer :: inc, jk, jl, iazi, i, j, k + + if( nwaves == 0 .or. nstoch == 1 ) then +! redefine from the default + nwav = incdim + nazd = iazdim + nst = 0 + eff = 1.0 + else +! from input_nml multi-wave spectra + nwav = nwaves + nazd = nazdir + nst = nstoch + eff = effac + endif +! + end subroutine initsolv_lsatdis +! + end module ugwp_lsatdis_init +! +! + module ugwp_wmsdis_init + + use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, omega2 + use ugwp_common, only : bnv2max, bnv2min, minvel + use ugwp_common, only : mkzmin, mkz2min, mkzmax, mkz2max, cdmin + implicit none + + real, parameter :: maxdudt = 250.e-5, maxdtdt=15.e-2 + real, parameter :: dked_min =0.01, dked_max=250.0 + + real, parameter :: gptwo=2.0 + + real , parameter :: bnfix = pi2/300., bnfix2= bnfix * bnfix + real , parameter :: bnfix4 = bnfix2 * bnfix2 + real , parameter :: bnfix3 = bnfix2 * bnfix +! +! make parameter list that will be passed to SOLVER +! +! integer, parameter :: klaunch=55 ! 32 - ~ 1km ;55 - 5.5 km ; 52 4.7km ; 60-7km index for selecting launch level +! integer, parameter :: ilaunch=klaunch + + integer , parameter :: iazidim=4 ! number of azimuths + integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum + real , parameter :: ucrit=cdmin + + real , parameter :: zcimin = 2.5 + real , parameter :: zcimax = 125.0 + real , parameter :: zgam = 0.25 +! +! Verical spectra +! + real , parameter :: pind_wd = 5./3. + real , parameter :: sind_kz = 1. + real , parameter :: tind_kz = 3. + real , parameter :: stind_kz = sind_kz + tind_kz +! +! from kmob_ugwp namelist +! + real :: nslope ! the GW sprctral slope at small-m + real :: lzstar + real :: lzmin + real :: lzmax + real :: lhmet + real :: tamp_mpa !amplitude for GEOS-5/MERRA-2 + real :: tau_min ! min of GW MF 0.25 mPa + integer :: ilaunch + real :: gw_eff + + real :: v_kxw, rv_kxw, v_kxw2 + + + +!=========================================================================== + integer :: nwav, nazd, nst + real :: eff + + real :: zaz_fct, zms + real, allocatable :: zci(:), zci4(:), zci3(:),zci2(:), zdci(:) + real, allocatable :: zcosang(:), zsinang(:) + real, allocatable :: lzmet(:), czmet(:), mkzmet(:), dczmet(:), dmkz(:) + +! +! GW-eddy constants for wave-mode dissipation by background and stability of +! "final" flow after application of GW-effects +! + real, parameter :: iPr_pt = 0.5 + real, parameter :: lturb = 30., sc2 = lturb*lturb ! stable on 80-km TL lmix ~ 500 met. + real, parameter :: ulturb=150., sc2u = ulturb* ulturb ! unstable + real, parameter :: ric =0.25 + real, parameter :: rimin = -10., prmin = 0.25 + real, parameter :: prmax = 4.0 +! + contains +!============================================================================ + subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) + +! call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & +! knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) +! + implicit none +! +!input -control for solvers: +! nwaves, nazdir, nstoch, effac, do_physb, kxw +! +! + integer :: me, master, nwaves, nazdir, nstoch + real :: effac, kxw + logical :: do_physb + real :: dlzmet +! +!locals +! + integer :: inc, jk, jl, iazi +! + real :: zang, zang1, znorm + real :: zx1, zx2, ztx, zdx, zxran, zxmin, zxmax, zx, zpexp + real :: fpc, fpc_dc + real :: ae1,ae2 + if( nwaves == 0) then +! +! redefine from the deafault +! + nwav = incdim + nazd = iazidim + nst = 0 + eff = 1.0 + gw_eff = eff + else +! +! from input.nml +! + nwav = nwaves + nazd = nazdir + nst = nstoch + gw_eff = effac + endif + + + v_kxw = pi2/lhmet ; v_kxw2 = v_kxw*v_kxw + rv_kxw = 1./v_kxw + + allocate ( zci(nwav), zci4(nwav), zci3(nwav),zci2(nwav), zdci(nwav) ) + allocate ( zcosang(nazd), zsinang(nazd) ) + allocate (lzmet(nwav), czmet(nwav), mkzmet(nwav), dczmet(nwav), dmkz(nwav) ) + + if (me == master) then + print *, 'ugwp_v1: init_gw_wmsdis_control ' +! + print *, 'ugwp_v1: WMS_DIS launch layer ', ilaunch + print *, 'ugwp_v1: WMS_DIS tot_mflux in mpa', tamp_mpa*1000. + print *, 'ugwp_v1: WMS_DIS lhmet in km ' , lhmet*1.e-3 + endif + + zpexp = gptwo * 0.5 ! gptwo=2 , zpexp = 1. + +! +! set up azimuth directions and some trig factors +! +! + zang = pi2 / float(nazd) + +! get normalization factor to ensure that the same amount of momentum +! flux is directed (n,s,e,w) no mater how many azimuths are selected. +! + znorm = 0.0 + do iazi=1, nazd + zang1 = (iazi-1)*zang + zcosang(iazi) = cos(zang1) + zsinang(iazi) = sin(zang1) + znorm = znorm + abs(zcosang(iazi)) + enddo +! zaz_fct = 1.0 + zaz_fct = 2.0 / znorm ! correction factor for azimuthal sums + +! define coordinate transform for "Ch" ....x = 1/c stretching transform +! ----------------------------------------------- +! +! x=1/Cphase transform +! see eq. 28-30 Scinocca 2003. x = 1/c stretching transform +! + zxmax = 1.0 / zcimin + zxmin = 1.0 / zcimax + zxran = zxmax - zxmin + zdx = zxran / real(nwav-1) ! dkz +! + ae1=zxran/zgam + zx1 = zxran/(exp(ae1)-1.0 ) ! zgam =1./4. + zx2 = zxmin - zx1 + +! +! computations for zci =1/zx, stretching "accuracy" is not "accurate" spectra transform +! it represents additional "empirical" redistribution of "spectral" mode in C-space +! + zms = pi2 / lzstar + + do inc=1, nwav + ztx = real(inc-1)*zdx+zxmin + ae1 = (ztx-zxmin)/zgam + zx = zx1*exp(ae1)+zx2 !eq.(29-30),Scinocca-2003 + zci(inc) = 1.0 /zx ! + zdci(inc) = zci(inc)**2*(zx1/zgam)*exp(ae1)*zdx ! + zci4(inc) = (zms*zci(inc))**4 + zci2(inc) = (zms*zci(inc))**2 + zci3(inc) = (zms*zci(inc))**3 + enddo +! +! +! alternatuve lzmax-lzmin +! +! + dlzmet = (lzmax-lzmin)/ real(nwav-1) + do inc=1, nwav + lzmet(inc) = lzmin + (inc-1)*dlzmet + mkzmet(inc) = pi2/lzmet(inc) + zci(inc) =lzmet(inc)/(pi2/bnfix) + zci4(inc) = (zms*zci(inc))**4 + zci2(inc) = (zms*zci(inc))**2 + zci3(inc) = (zms*zci(inc))**3 + + enddo + + zdx = (zci(nwav)-zci(1))/ real(nwav-1) + + + if (me == master) then + print * + print *, 'ugwp_v0: zcimin=' , zcimin + print *, 'ugwp_v0: zcimax=' , zcimax + print *, 'ugwp_v0: zgam= ', zgam + print * + +! print *, ' ugwp_v1 nslope=', nslope + print * + print *, 'ugwp_v1: zcimin/zci=' , maxval(zci) + print *, 'ugwp_v1: zcimax/zci=' , minval(zci) + print *, 'ugwp_v1: cd_crit=', ucrit + print *, 'ugwp_v1: launch_level', ilaunch + print *, ' ugwp_v1 lzstar=', lzstar + print *, ' ugwp_v1 nslope=', nslope + + print * + do inc=1, nwav + zdci(inc) = zdx + if (nslope == 1) fpc = bnfix4*zci(inc)/ (bnfix4+zci4(inc)) + if (nslope == 0) fpc = bnfix3*zci(inc)/ (bnfix3+zci3(inc)) + fpc_dc = fpc * zdci(inc) + write(6,111) inc, zci(inc), zdci(inc),ucrit, fpc, fpc_dc, 6.28e-3/bnfix*zci(inc) + enddo + endif + 111 format( 'wms-zci', i4, 7 (3x, F8.3)) + + end subroutine initsolv_wmsdis +! +! make a list of all-initilized parameters needed for "gw_solver_wmsdis" +! + + end module ugwp_wmsdis_init +!========================================================================= +! +! work TODO for 2-extra WAM-solvers: +! DSPDIS (Hines)+ADODIS (Alexander-Dunkerton-Ortland) +! +!========================================================================= + subroutine init_dspdis + implicit none + end subroutine init_dspdis + + subroutine init_adodis + implicit none + end subroutine init_adodis + diff --git a/physics/cires_ugwp_module_v1.F90 b/physics/cires_ugwp_module_v1.F90 new file mode 100644 index 000000000..ecc00ecfb --- /dev/null +++ b/physics/cires_ugwp_module_v1.F90 @@ -0,0 +1,666 @@ + +module cires_ugwp_module_v1 + +! +! driver is called after pbl & before chem-parameterizations +! it uses ugwp_common (like phys_cons) and some module-param od solvers/sources init-modules +!.................................................................................... +! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re +!................................................................................... +! +! + use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4 + implicit none + logical :: module_is_initialized +!logical :: do_ugwp = .false. ! control => true - ugwp false old gws + rayeleigh friction + character(len=8) :: strsolver='pss-1986' + logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources + logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver + integer, parameter :: idebug_gwrms=1 ! control for diag computaions pw wind-temp GW-rms and MF fluxs + logical, parameter :: do_adjoro = .false. + real, parameter :: max_kdis = 250. ! 400 m2/s + real, parameter :: max_axyz = 250.e-5 ! 400 m/s/day + real, parameter :: max_eps = max_kdis*4.e-7 ! ~16 K/day max_kdis*BN2/cp + real, parameter :: maxdudt = max_axyz + real, parameter :: maxdtdt = max_eps + real, parameter :: dked_min = 0.01 + real, parameter :: dked_max = max_kdis + + + real, parameter :: hps = hpscale + real, parameter :: hpskm = hps/1000. +! + + real, parameter :: ricrit = 0.25 + real, parameter :: frcrit = 0.50 + real, parameter :: linsat = 1.00 + real, parameter :: linsat2 = linsat*linsat +! +! integer :: curday_ugwp ! yyyymmdd 20150101 +! integer :: ddd_ugwp ! ddd of year from 1-366 + + integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) + integer, dimension(4) :: knob_ugwp_source ! [1,1,1,0] - (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_wvspec ! number of waves for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_azdir ! number of wave azimuths for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_stoch ! 1 - deterministic ; 0 - stochastic + real, dimension(4) :: knob_ugwp_effac ! efficiency factors for- (oro, fronts, conv, imbf-owp] + + integer :: knob_ugwp_doaxyz=1 ! 1 -gwdrag + integer :: knob_ugwp_doheat=1 ! 1 -gwheat + integer :: knob_ugwp_dokdis=0 ! 1 -gwmixing + integer :: knob_ugwp_ndx4lh = 2 ! n-number of "unresolved" "n*dx" for lh_gw + integer :: knob_ugwp_nslope = 1 ! spectral"growth" S-slope of GW-energy spectra mkz^S + + real :: knob_ugwp_palaunch = 500.e2 ! fixed pressure layer in Pa for "launch" of NGWs + real :: knob_ugwp_lzmax = 12.5e3 ! 12.5 km max-VERT-WL of GW-spectra + real :: knob_ugwp_lzstar = 2.0e3 ! UTLS mstar = 6.28/lzstar 2-2.5 km + real :: knob_ugwp_lzmin = 1.5e3 ! 1.5 km min-VERT-WL of GW-spectra + real :: knob_ugwp_taumin = 0.25e-3 + real :: knob_ugwp_tauamp = 7.75e-3 ! range from 30.e-3 to 3.e-3 ( space-borne values) + real :: knob_ugwp_lhmet = 200.e3 ! 200 km + real :: knob_ugwp_tlimb = .true. +! + real :: kxw = pi2/200.e3 ! single horizontal wavenumber of ugwp schemes +! +! tune-ups for qbo +! + real :: knob_ugwp_qbolev = 500.e2 ! fixed pressure layer in Pa for "launch" of conv-GWs + real :: knob_ugwp_qbosin = 1.86 ! semiannual cycle of tau_qbo_src in radians + real :: knob_ugwp_qbotav = 2.285e-3 ! additional to "climate" for QBO-sg forcing + real :: knob_ugwp_qboamp = 1.191e-3 ! additional to "climate" QBO + real :: knob_ugwp_qbotau = 10. ! relaxation time scale in days + real :: knob_ugwp_qbolat = 15. ! qbo-domain for extra-forcing + real :: knob_ugwp_qbowid = 7.5 ! qbo-attenuation for extra-forcing + character(len=8) :: knob_ugwp_orosolv='pss-1986' + + character(len=255) :: ugwp_qbofile = 'qbo_zmf_2009_2018.nc' + character(len=255) :: ugwp_taufile = 'ugwp_limb_tau.nc' + +! character(len=250) :: knob_ugwp_qbofile='qbo_zmf_2009_2018.nc'! +! character(len=250) :: knob_ugwp_amffile='mern_zmf_amf_12month.nc' +! character(len=255) :: file_limb_tab='ugwp_limb_tau.nc' + +! integer, parameter :: ny_tab=73, nt_tab=14 +! real, parameter :: rdy_tab = 1./2.5, rdd_tab = 1./30. +! real :: days_tab(nt_tab), lat_tab(ny_tab) +! real :: abmf_tab(ny_tab,nt_tab) + + integer :: ugwp_azdir + integer :: ugwp_stoch + + integer :: ugwp_src + integer :: ugwp_nws + real :: ugwp_effac + +! + data knob_ugwp_source / 1,0, 1, 0 / ! oro-conv-fjet-okw-taub_lat: 1-active 0-off + data knob_ugwp_wvspec /1,32,32,32/ ! number of waves for- (oro, fronts, conv, imbf-owp, taulat] + data knob_ugwp_azdir /2, 4, 4,4/ ! number of wave azimuths for- (oro, fronts, conv, imbf-okwp] + data knob_ugwp_stoch /0, 0, 0,0/ ! 0 - deterministic ; 1 - stochastic, non-activated option + data knob_ugwp_effac /1.,1.,1.,1./ ! efficiency factors for- (oro, fronts, conv, imbf-owp] + integer :: knob_ugwp_version = 0 + integer :: launch_level = 55 +! + namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & + knob_ugwp_stoch, knob_ugwp_effac,knob_ugwp_doaxyz, knob_ugwp_doheat, knob_ugwp_dokdis, & + knob_ugwp_ndx4lh, knob_ugwp_version, knob_ugwp_palaunch, knob_ugwp_nslope, knob_ugwp_lzmax, & + knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & + knob_ugwp_qbolev, knob_ugwp_qbosin, knob_ugwp_qbotav, knob_ugwp_qboamp, knob_ugwp_qbotau, & + knob_ugwp_qbolat, knob_ugwp_qbowid, knob_ugwp_tlimb, knob_ugwp_orosolv + +!&cires_ugwp_nml +! knob_ugwp_solver=2 +! knob_ugwp_source=1,1,1,0 +! knob_ugwp_wvspec=1,32,32,32 +! knob_ugwp_azdir =2, 4, 4,4 +! knob_ugwp_stoch =0, 0, 0,0 +! knob_ugwp_effac=1, 1, 1,1 +! knob_ugwp_doaxyz=1 +! knob_ugwp_doheat=1 +! knob_ugwp_dokdis=0 +! knob_ugwp_ndx4lh=4 +!/ +! +! allocatable arrays, initilized during "cires_ugwp_init" & +! released during "cires_ugwp_finalize" +! + real, allocatable :: kvg(:), ktg(:), krad(:), kion(:) + real, allocatable :: zkm(:), pmb(:) + real, allocatable :: rfdis(:), rfdist(:) + integer :: levs_rf + real :: pa_rf, tau_rf +! +! tabulated GW-sources +! + integer :: ntau_d1y, ntau_d2t, nqbo_d1y, nqbo_d2z, nqbo_d3t + real, allocatable :: ugwp_taulat(:), ugwp_qbolat(:) + real, allocatable :: tau_limb(:,:), days_limb(:) + real, allocatable :: uzmf_merra(:,:,:), days_merra(:), pmb127(:) + real, allocatable :: uqboe(:,:) + real, allocatable :: days_y4ddd(:), zkm127(:) + real, allocatable :: tau_qbo(:), stau_qbo(:) + integer,allocatable :: days_y4md(:) + real, allocatable :: vert_qbo(:) + +! +! limiters +! + real, parameter :: latqbo =20., widqbo=15., taurel = 21600. + integer, parameter :: kz2 = 127-7, kz1= 127-49, kz5=5 ! 64km - 18km +! + +!====================================================================== + real, parameter :: F_coriol=1 ! Coriolis effects + real, parameter :: F_nonhyd=1 ! Nonhydrostatic waves + real, parameter :: F_kds =0 ! Eddy mixing due to GW-unstable below + real, parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw + real, parameter :: iPr_turb =1./3., iPr_mol =1.95 + real, parameter :: rhp1=1./hps, rh2=0.5*rhp1, rhp4 = rh2*rh2 + real, parameter :: khp = 0.287*rhp1 ! R/Cp/Hp + real, parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model + + contains +! +! ----------------------------------------------------------------------- +! +! init of cires_ugwp (_init) called from CCPP cap file +! +! ----------------------------------------------------------------------- + + + + subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & + lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & + pa_rf_in, tau_rf_in) +! +! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 +! + ! use netcdf + use ugwp_oro_init, only : init_oro_gws + use ugwp_conv_init, only : init_conv_gws + use ugwp_fjet_init, only : init_fjet_gws + use ugwp_okw_init, only : init_okw_gws + use ugwp_wmsdis_init, only : initsolv_wmsdis + + use ugwp_lsatdis_init, only : initsolv_lsatdis + + + use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar + use ugwp_wmsdis_init, only : tau_min, tamp_mpa + implicit none + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + integer, intent (in) :: logunit + integer, intent (in) :: lonr + integer, intent (in) :: levs + integer, intent (in) :: latr + integer, intent (in) :: jdat_gfs(8) + real, intent (in) :: ak(levs+1), bk(levs+1), pref + real, intent (in) :: dtp + real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW dims(2) !!! + real, intent (in) :: pa_rf_in, tau_rf_in + + character(len=64), intent (in) :: fn_nml2 + character(len=64), parameter :: fn_nml='input.nml' + +! character, intent (in) :: input_nml_file +! integer, parameter :: logunit = 6 + integer :: ios + logical :: exists + real :: dxsg + + integer :: ncid, iernc, vid, dimid, status + integer :: k + integer :: ddd_ugwp, curday_ugwp + real :: avqbo(6) + avqbo = [0.05, 0.1, 0.25, 0.5, 0.75, 0.95] +! + if (me == master) print *, trim (fn_nml), ' GW-namelist file ' + inquire (file =trim (fn_nml) , exist = exists) +! + if (.not. exists) then + if (me == master) & + write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' + else + open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = cires_ugwp_nml) + close (nlunit) +! + strsolver= knob_ugwp_orosolv + pa_rf = pa_rf_in + tau_rf = tau_rf_in + + curday_ugwp = jdat_gfs(1)*10000 + jdat_gfs(2)*100 +jdat_gfs(3) + call calendar_ugwp(jdat_gfs(1), jdat_gfs(2), jdat_gfs(3), ddd_ugwp) + +! write version number and namelist to log file + if (me == master) then + write (logunit, *) " ================================================================== " + write (logunit, *) "cires_ugwp_namelist_extended_v1" + write (logunit, nml = cires_ugwp_nml) + write (logunit, *) " ================================================================== " + + write (6, *) " ================================================================== " + write (6, *) "cires_ugwp_namelist_extended_v1" + write (6, nml = cires_ugwp_nml) + write (6, *) " ================================================================== " + write (6, *) "calendar_ugwp ddd_ugwp=", ddd_ugwp + write (6, *) "calendar_ugwp curday_ugwp=", curday_ugwp + write (6, *) " ================================================================== " + write (6, *) ddd_ugwp, ' jdat_gfs ddd of year ' + endif +! +! effective kxw - resolution-aware +! + dxsg = pi2*arad/float(lonr) * knob_ugwp_ndx4lh + kxw = pi2/knob_ugwp_lhmet +! +! kxw = pi2/dxsg +! +! init global background dissipation for ugwp -> 4d-variable for fv3wam linked with pbl-vert_diff +! + +! allocate(fcor(latr), fcor2(latr) ) +! + allocate( kvg(levs+1), ktg(levs+1) ) + allocate( krad(levs+1), kion(levs+1) ) + allocate( zkm(levs), pmb(levs) ) + allocate( rfdis(levs), rfdist(levs) ) + + allocate (vert_qbo(levs)) + +! +! ak -pa bk-dimensionless from surf => tol_lid_pressure =0 +! + + do k=1, levs + pmb(k) = 1.e0*(ak(k) + pref*bk(k)) ! Pa -unit Pref = 1.e5, pmb = Pa + zkm(k) = -hpskm*alog(pmb(k)/pref) + enddo + vert_qbo(1:levs) = 0. + + do k=kz1, kz2 + vert_qbo(k)=1. + if (k.le.(kz1+kz5)) vert_qbo(k) = avqbo(k+1-kz1) + if (k.ge.(kz2-kz5)) vert_qbo(k) = avqbo(kz2+1-k) + if (me == master) print *, 'vertqbo', vert_qbo(k), zkm(k) + enddo + +! +! find ilaunch +! + + do k=levs, 1, -1 + if (pmb(k) .gt. knob_ugwp_palaunch ) exit + enddo + + launch_level = max(k-1, 5) ! above 5-layers from the surface + +! +! Part-1 :init_global_gwdis +! + call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) + call rf_damp_init (levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) +! +! Part-2 :init_SOURCES_gws +! + +! +! call init-solver for "stationary" multi-wave spectra and sub-grid oro +! + call init_oro_gws( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & + knob_ugwp_stoch(1), knob_ugwp_effac(1), lonr, kxw, cdmvgwd ) +! +! call init-sources for "non-sationary" multi-wave spectra +! + do_physb_gwsrcs=.true. + + IF (do_physb_gwsrcs) THEN + + if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init ' + if (knob_ugwp_wvspec(4) > 0) then +! okw + call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & + knob_ugwp_stoch(4), knob_ugwp_effac(4), lonr, kxw ) + if (me == master) print *, ' init_okw_gws ' + endif + + if (knob_ugwp_wvspec(3) > 0) then +! fronts + call init_fjet_gws(knob_ugwp_wvspec(3), knob_ugwp_azdir(3), & + knob_ugwp_stoch(3), knob_ugwp_effac(3), lonr, kxw ) + if (me == master) print *, ' init_fjet_gws ' + endif + + if (knob_ugwp_wvspec(2) > 0) then +! conv + call init_conv_gws(knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), lonr, kxw, cgwf ) + if (me == master) & + print *, ' init_convective GWs cgwf', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) + + endif + + ENDIF !IF (do_physb_gwsrcs) +! +! +! Tabulated sources +! +! goto 121 + + iernc=NF90_OPEN(trim(ugwp_taufile), nf90_nowrite, ncid) + + if(iernc.ne.0) then + write(6,*) + write(6,*) ' cannot open file_limb_tab data-file', trim(ugwp_taufile) + write(6,*) + stop + else + + + status = nf90_inq_dimid(ncid, "lat", DimID) +! if (status /= nf90_noerr) call handle_err(status) +! + status = nf90_inquire_dimension(ncid, DimID, len =ntau_d1y ) + + status = nf90_inq_dimid(ncid, "days", DimID) + status = nf90_inquire_dimension(ncid, DimID, len =ntau_d2t ) + if (me == master) print *, ntau_d1y, ntau_d2t, ' dimd-tlimb ' + allocate (ugwp_taulat(ntau_d1y ), days_limb(ntau_d2t)) + allocate ( tau_limb (ntau_d1y, ntau_d2t )) + + iernc=nf90_inq_varid( ncid, 'DAYS', vid ) + iernc= nf90_get_var( ncid, vid, days_limb) + iernc=nf90_inq_varid( ncid, 'LATS', vid ) + iernc= nf90_get_var( ncid, vid, ugwp_taulat) + iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) + iernc= nf90_get_var( ncid, vid, tau_limb) + + iernc=nf90_close(ncid) + + endif +! + iernc=NF90_OPEN(trim(ugwp_qbofile), nf90_nowrite, ncid) + + if(iernc.ne.0) then + write(6,*) + write(6,*) ' cannot open qbofile data-file', trim(ugwp_qbofile) + write(6,*) + stop + else + + status = nf90_inq_dimid(ncid, "lat", DimID) + status = nf90_inquire_dimension(ncid, DimID, len =nqbo_d1y ) + status = nf90_inq_dimid(ncid, "lev", DimID) + status = nf90_inquire_dimension(ncid, DimID, len =nqbo_d2z) + status = nf90_inq_dimid(ncid, "days", DimID) + status = nf90_inquire_dimension(ncid, DimID, len =nqbo_d3t ) + if (me == master) print *, nqbo_d1y, nqbo_d2z, nqbo_d3t, ' dims tauqbo ' + allocate (ugwp_qbolat(nqbo_d1y ), days_merra(nqbo_d3t) ) + allocate (zkm127(nqbo_d2z), pmb127(nqbo_d2z)) + allocate ( uzmf_merra (nqbo_d1y, nqbo_d2z, nqbo_d3t )) + allocate ( uqboe (nqbo_d2z, nqbo_d3t )) + allocate (days_y4ddd(nqbo_d3t), days_y4md(nqbo_d3t) ) + allocate (tau_qbo(nqbo_d3t), stau_qbo(nqbo_d3t) ) + + iernc=nf90_inq_varid( ncid, 'DAYS', vid ) + iernc= nf90_get_var( ncid, vid, days_merra) + + iernc=nf90_inq_varid( ncid, 'Y4MD', vid ) + iernc= nf90_get_var( ncid, vid, days_y4md) + + iernc=nf90_inq_varid( ncid, 'Y4DDD', vid ) + iernc= nf90_get_var( ncid, vid, days_y4ddd) + + iernc=nf90_inq_varid( ncid, 'LATS', vid ) + iernc= nf90_get_var( ncid, vid, ugwp_qbolat) + + iernc=nf90_inq_varid( ncid, 'LEVS', vid ) + iernc= nf90_get_var( ncid, vid, zkm127) + + + iernc=nf90_inq_varid( ncid, 'UQBO', vid ) + iernc= nf90_get_var( ncid, vid, uzmf_merra) + + iernc=nf90_inq_varid( ncid, 'TAUQBO', vid ) + iernc= nf90_get_var( ncid, vid, tau_qbo) + + iernc=nf90_inq_varid( ncid, 'STAUQBO', vid ) + iernc= nf90_get_var( ncid, vid, stau_qbo) + iernc=nf90_inq_varid( ncid, 'UQBOE', vid ) + iernc= nf90_get_var( ncid, vid, uqboe) + iernc=nf90_close(ncid) + endif + + if (me == master) then + print * + print *, ' ugwp_tabulated files input ' + print *, ' ugwp_taulat ', ugwp_taulat + print *, ' days ', days_limb + print *, ' TAU-limb ', maxval(tau_limb)*1.e3, minval(tau_limb)*1.e3 + print *, ' TAU-qbo ', maxval(stau_qbo)*1.e3, minval(stau_qbo)*1.e3 + print *, ' YMD-qbo ', maxval(days_y4md), minval(days_y4md) + print *, ' YDDD-qbo ', maxval(days_y4ddd), minval(days_y4ddd) + print *, ' uzmf_merra ',maxval(uzmf_merra), minval(uzmf_merra) + print *, ' uEq_merra ',maxval(uqboe), minval(uqboe) + print * + endif + +! +121 continue +! endif ! tabulated sources SABER/HIRDLS/QBO + +!====================== +! Part-3 :init_SOLVERS +! ===================== +! +! call init-solvers for "broad" non-stationary multi-wave spectra +! + if (knob_ugwp_solver==1) then +! + call initsolv_lsatdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw ) + endif + if (knob_ugwp_solver==2) then +! +! re-assign from namelists +! + nslope = knob_ugwp_nslope ! the GW sprctral slope at small-m + lzstar = knob_ugwp_lzstar + lzmax = knob_ugwp_lzmax + lzmin = knob_ugwp_lzmin + lhmet = knob_ugwp_lhmet + tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 + tau_min =knob_ugwp_taumin ! min of GW MF 0.25 mPa + ilaunch = launch_level + kxw = pi2/lhmet + call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) + endif +! +! other solvers not yet tested for fv3gfs +! +!< if (knob_ugwp_solver==3) call init_dspdis +!< if (knob_ugwp_solver==4) call init_adodis +! + +!====================== + module_is_initialized = .true. + if (me == master) print *, ' CIRES-ugwp-V1 is initialized ', module_is_initialized + + end subroutine cires_ugwp_init_v1 + + +!============================================= + + + subroutine cires_ugwp_advance +!----------------------------------------------------------------------- +! +! options for the day-to-day variable sources/spectra + diagnostics +! for stochastic "triggers" +! diagnose GW-source functions * FGF + OKWP + SGO/CONV from IAU-fields +! or use for stochastic GWP-sources "memory" +!----------------------------------------------------------------------- + implicit none +! +! update sources +! a) physics-based triggers for multi-wave +! b) stochastic-based spectra and amplitudes +! c) use "memory" on GW-spectra from previous time-step +! d) update "background" GW dissipation as needed +! + end subroutine cires_ugwp_advance + +! +! ----------------------------------------------------------------------- +! finalize of cires_ugwp (_finalize) +! ----------------------------------------------------------------------- + + + subroutine cires_ugwp_finalize +! +! deallocate sources/spectra & some diagnostics need to find where "deaalocate them" +! before "end" of the FV3GFS +! + implicit none +! +! deallocate arrays employed in: +! cires_ugwp_advance / cires_ugwp_driver / cires_ugwp_init +! + deallocate( kvg, ktg ) + deallocate( krad, kion ) + deallocate( zkm, pmb ) + deallocate( rfdis, rfdist) + deallocate(ugwp_taulat, ugwp_qbolat) + deallocate(tau_limb, uzmf_merra) + deallocate(days_limb, days_merra, pmb127) + + end subroutine cires_ugwp_finalize + +! +! +! +! + subroutine calendar_ugwp(yr, mm, dd, ddd_ugwp) +! +! computes day of year to get tau_limb forcing written with 1-day precision +! + implicit none + integer, intent(in) :: yr, mm, dd + integer :: ddd_ugwp + + integer :: iw3jdn + integer :: jd1, jddd + jd1 = iw3jdn(yr,1,1) + jddd = iw3jdn(yr,mm,dd) + ddd_ugwp = jddd-jd1+1 + + end subroutine calendar_ugwp + + + subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j2tau, & + j1_qbo,j2_qbo, w1_j1qbo, w2_j2qbo, dexp_latqbo ) + + implicit none +! +! ntau_d1y, ntau_d2t, nqbo_d1y, nqbo_d2z, nqbo_d3t +! ugwp_taulat(:), ugwp_qbolat(:), ugwp_merlat(:) +! + integer :: npts, me, master + integer, dimension(npts) :: j1_tau,j2_tau, j1_qbo, j2_qbo + real , dimension(npts) :: dlat, w1_j1tau, w2_j2tau, w1_j1qbo, w2_j2qbo + real , dimension(npts) :: dexp_latqbo + real :: widqbo2, xabs +! + integer i,j, j1, j2 +! +! weights for tau_limb w1_j1tau, w2_j2tau +! + do j=1,npts + j2_qbo(j) = nqbo_d1y + do i=1, nqbo_d1y + if (dlat(j) < ugwp_qbolat(i)) then + j2_qbo(j) = i + exit + endif + enddo + + + j2_qbo(j) = min(j2_qbo(j),nqbo_d1y) + j1_qbo(j) = max(j2_qbo(j)-1,1) + + if (j1_qbo(j) /= j2_qbo(j) ) then + w2_j2qbo(j) = (dlat(j) - ugwp_qbolat(j1_qbo(j))) & + / (ugwp_qbolat(j2_qbo(j))-ugwp_qbolat(j1_qbo(j))) + + else + w2_j2qbo(j) = 1.0 + endif + w1_j1qbo(j) = 1.0 - w2_j2qbo(j) + +! + enddo +! +! weights for tau_limb w1_j1tau, w2_j2tau +! + do j=1,npts + j2_tau(j) = ntau_d1y + do i=1,ntau_d1y + if (dlat(j) < ugwp_taulat(i)) then + j2_tau(j) = i + exit + endif + enddo + + + j2_tau(j) = min(j2_tau(j),ntau_d1y) + j1_tau(j) = max(j2_tau(j)-1,1) + + if (j1_tau(j) /= j2_tau(j) ) then + w2_j2tau(j) = (dlat(j) - ugwp_taulat(j1_tau(j))) & + / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) + + else + w2_j2tau(j) = 1.0 + endif + w1_j1tau(j) = 1.0 - w2_j2tau(j) + + enddo + widqbo2 =1./widqbo/widqbo + do j=1,npts + dexp_latqbo(j) =0. + xabs =abs(dlat(j)) + if (xabs .le. latqbo) then + dexp_latqbo(j) = exp(-xabs*xabs*widqbo2) + if (xabs .le. 4.0 ) dexp_latqbo(j) =1. +! print *, ' indx_ugwp dexp=', dexp_latqbo(j), nint(dlat(j)) + endif + enddo + + if (me == master ) then +222 format( 2x, 'vay-wqbo', I4, 5(2x, F10.3)) +223 format( 2x, 'vay-limb', I4, 5(2x, F10.3)) + print *, 'vay_indx_ugwp ', size(dlat), ' npts ', npts + do j=1,npts + j1 = j1_tau(j) + j2 = j2_tau(j) + write(6,223) j, ugwp_taulat(j1), dlat(j), ugwp_taulat(j2), w2_j2tau(j), w1_j1tau(j) + enddo + print * + do j=1,npts + j1 = j1_qbo(j) + j2 = j2_qbo(j) + write(6,222) j, ugwp_qbolat(j1), dlat(j), ugwp_qbolat(j2), w2_j2qbo(j), w1_j1qbo(j) + enddo + endif + end subroutine cires_indx_ugwp + +! + end module cires_ugwp_module_v1 + diff --git a/physics/cires_ugwp_ngw_utils.F90 b/physics/cires_ugwp_ngw_utils.F90 new file mode 100644 index 000000000..4b2a19884 --- /dev/null +++ b/physics/cires_ugwp_ngw_utils.F90 @@ -0,0 +1,73 @@ +module cires_ugwp_ngw_utils + + +contains + + + subroutine tau_limb_advance(me, master, im, levs, ddd, curdate, & + j1_tau, j2_tau, ddy_j1tau, ddy_j2tau, tau_sat, kdt ) + + + + + use machine, only : kind_phys + + use cires_ugwp_module_v1, only : ntau_d1y, ntau_d2t + use cires_ugwp_module_v1, only : ugwp_taulat, days_limb, tau_limb + +! use cires_ugwp_module, only : ugwp_qbolat, days_merra, pmb127, days_y4md, days_y4ddd +! use cires_ugwp_module, only : tau_qbo, stau_qbo, uqboe, u2 => uzmf_merra + + implicit none + + integer, intent(in) :: me, master, im, levs, ddd, curdate, kdt + integer, intent(in), dimension(im) :: j1_tau, j2_tau + + real , intent(in), dimension(im) :: ddy_j1tau, ddy_j2tau + + real, intent(out) :: tau_sat(im) + + integer :: i, j1, j2, k, it1, it2, iday + real :: tem, tx1, tx2, w1, w2, day2, day1, ddx + integer :: yr1, yr2 +! + integer :: iqbo1=1 +! + + + + it1 = 2 + do iday=1, ntau_d2t + if (float(ddd) .lt. days_limb(iday) ) then + it2 = iday + exit + endif + enddo + it2 = min(it2,ntau_d2t) + it1 = max(it2-1,1) + if (it2 > ntau_d2t ) then + print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t + stop + endif + w2 = (float(ddd)-days_limb(it1))/(days_limb(it2)-days_limb(it1)) + w1 = 1.0-w2 + do i=1, im + j1 = j1_tau(i) + j2 = j2_tau(i) + tx1 = tau_limb(j1, it1)*ddy_j1tau(i)+tau_limb(j2, it1)*ddy_j2tau(i) + tx2 = tau_limb(j1, it2)*ddy_j1tau(i)+tau_limb(j2, it2)*ddy_j2tau(i) + tau_sat(i) = tx1*w1 + w2*tx2 + enddo + + if (me == master ) then + print*, maxval(tau_limb), minval(tau_limb), ' tau_limb ' + print*, ntau_d2t + print*, days_limb(1) , days_limb(ntau_d2t) , ddd, ' days-taulimb ' + print*, 'curdate ', curdate + print*, maxval(tau_sat), minval(tau_sat), ' tau_sat_fv3 ' + endif + return + + end subroutine tau_limb_advance + +end module cires_ugwp_ngw_utils diff --git a/physics/cires_ugwp_orolm97_v1.F90 b/physics/cires_ugwp_orolm97_v1.F90 new file mode 100644 index 000000000..1a6cedcb3 --- /dev/null +++ b/physics/cires_ugwp_orolm97_v1.F90 @@ -0,0 +1,985 @@ +module cires_ugwp_orolm97_v1 + + +contains + + + + subroutine gwdps_oro_v1(im, km, imx, do_tofd, & + pdvdt, pdudt, pdtdt, pkdis, u1,v1,t1,q1,kpbl, & + prsi,del,prsl,prslk, zmeti, zmet, dtp, kdt, hprime, & + oc, oa4, clx4, theta, sigma, gamma, elvmaxd, sgh30, & + dusfc, dvsfc, xlatd, sinlat, coslat, sparea, & + cdmbgwd, me, master, rdxzb, & + zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & + dudt_mtb, dudt_ogw, dudt_tms) +!---------------------------------------- +! ugwp_v1: gwdps_oro_v1 following recent updates of Lott & Miller 1997 +! eventually will be replaced with more "advanced"LLWB +! and multi-wave solver that produce competitive FV3GFS-skills +! +! computation of kref for ogw + coorde diagnostics +! all constants/parameters inside cires_ugwp_initialize.f90 +!---------------------------------------- + + use machine , only : kind_phys + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2, & + pi, rad_to_deg, deg_to_rad, pi2, & + rdi, gor, grcp, gocp, fv, gr2, & + bnv2min, dw2min, velmin, arad + + use ugwp_oro_init, only : rimin, ric, efmin, efmax , & + hpmax, hpmin, sigfaci => sigfac , & + dpmin, minwnd, hminmt, hncrit , & + rlolev, gmax, veleps, factop , & + frc, ce, ceofrc, frmax, cg, & + fdir, mdir, nwdir, & + cdmb, cleff, fcrit_gfs, fcrit_mtb, & + n_tofd, ze_tofd, ztop_tofd + + use cires_ugwp_module, only : kxw, max_kdis, max_axyz + + use cires_orowam2017, only : oro_wam_2017 + + use cires_vert_orodis, only : ugwp_tofd1d + + +! use sso_coorde, only : pgwd, pgwd4 +!---------------------------------------- + implicit none + real(kind=kind_phys), parameter :: pgwd=1, pgwd4= pgwd + real(kind=kind_phys), parameter :: sigfac = 3, sigfacs = 0.5 + character(len=8) :: strsolver='pss-1986' ! current operational solver or 'wam-2017' + real(kind=kind_phys) :: gammin = 0.00999999 + real(kind=kind_phys), parameter :: nhilmax = 25. + real(kind=kind_phys), parameter :: sso_min = 3000. + logical, parameter :: do_adjoro = .false. +!---------------------------------------- + + integer, intent(in) :: im, km, imx, kdt + integer, intent(in) :: me, master + logical, intent(in) :: do_tofd + + + + integer, intent(in) :: kpbl(im) ! index for the pbl top layer! + real(kind=kind_phys), intent(in) :: dtp ! time step + real(kind=kind_phys), intent(in) :: cdmbgwd(2) + + real(kind=kind_phys), intent(in) :: hprime(im), oc(im), oa4(im,4), & + clx4(im,4), theta(im), sigma(im), & + gamma(im), elvmaxd(im) + + real(kind=kind_phys), intent(in) :: sgh30(im) + real(kind=kind_phys), intent(in), dimension(im,km) :: & + u1, v1, t1, q1,del, prsl, prslk, zmet + + real(kind=kind_phys), intent(in),dimension(im,km+1):: prsi, zmeti + real(kind=kind_phys), intent(in) :: xlatd(im),sinlat(im), coslat(im) + real(kind=kind_phys), intent(in) :: sparea(im) + +! +!output -phys-tend + real(kind=kind_phys),dimension(im,km),intent(out) :: & + pdvdt, pdudt, pkdis, pdtdt +! output - diag-coorde + real(kind=kind_phys),dimension(im,km),intent(out) :: & + dudt_mtb, dudt_ogw, dudt_tms +! + real(kind=kind_phys),dimension(im) :: rdxzb, zmtb, zogw , & + tau_ogw, tau_mtb, tau_tofd, dusfc, dvsfc + +! +!--------------------------------------------------------------------- +! # of permissible sub-grid orography hills for "any" resolution < 25 +! correction for "elliptical" hills based on shilmin-area =sgrid/25 +! 4.*gamma*b_ell*b_ell >= shilmin +! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min +! gamma_min = 1/4*shilmin/sso_min/sso_min +!23.01.2019: cdmb = 4.*192/768_c192=1 x 0.5 +! 192: cdmbgwd = 0.5, 2.5 +! cleff = 2.5*0.5e-5 * sqrt(192./768.) => lh_eff = 1004. km +! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective OGW-lin +!--------------------------------------------------------------------- +! +! locals SSO +! + real(kind=kind_phys) :: vsigma(im), vgamma(im) + + real(kind=kind_phys) :: ztoph,zlowh,ph_blk, dz_blk + real(kind=kind_phys) :: shilmin, sgrmax, sgrmin + real(kind=kind_phys) :: belpmin, dsmin, dsmax +! real(kind=kind_phys) :: arhills(im) ! not used why do we need? + real(kind=kind_phys) :: xlingfs + +! +! locals mean flow ...etc +! + real(kind=kind_phys), dimension(im,km) :: ri_n, bnv2, ro + real(kind=kind_phys), dimension(im,km) :: vtk, vtj, velco +!mtb + real(kind=kind_phys), dimension(im) :: oa, clx , elvmax, wk + real(kind=kind_phys), dimension(im) :: pe, ek, up + + real(kind=kind_phys), dimension(im,km) :: db, ang, uds + + real(kind=kind_phys) :: zlen, dbtmp, r, phiang, dbim, zr + real(kind=kind_phys) :: eng0, eng1, cosang2, sinang2 + real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem +! +! tofd +! some constants now in "use ugwp_oro_init" + "use ugwp_common" +! +!================== + real(kind=kind_phys) :: unew, vnew, zpbl, sigflt, zsurf + real(kind=kind_phys), dimension(km) :: utofd1, vtofd1 + real(kind=kind_phys), dimension(km) :: epstofd1, krf_tofd1 + real(kind=kind_phys), dimension(km) :: up1, vp1, zpm + + real(kind=kind_phys),dimension(im, km) :: axtms, aytms +! +! ogw +! + logical icrilv(im) +! + real(kind=kind_phys), dimension(im) :: xn, yn, ubar, vbar, ulow, & + roll, bnv2bar, scor, dtfac, xlinv, delks, delks1 +! + real(kind=kind_phys) :: taup(im,km+1), taud(im,km) + real(kind=kind_phys) :: taub(im), taulin(im), heff, hsat, hdis + + integer, dimension(im) :: kref, idxzb, ipt, kreflm, iwklm, iwk, izlow + +! +!check what we need +! + real(kind=kind_phys) :: bnv, fr, ri_gw, brvf + real(kind=kind_phys) :: tem, tem1, tem2, temc, temv + real(kind=kind_phys) :: ti, rdz, dw2, shr2, bvf2 + real(kind=kind_phys) :: rdelks, efact, coefm, gfobnv + real(kind=kind_phys) :: scork, rscor, hd, fro, sira + real(kind=kind_phys) :: dtaux, dtauy, zmetp, zmetk + + real(kind=kind_phys) :: grav2, rcpdt, windik, wdir + real(kind=kind_phys) :: sigmin, dxres,sigres,hdxres, cdmb4, mtbridge + + real(kind=kind_phys) :: kxridge, inv_b2eff, zw1, zw2 + real(kind=kind_phys) :: belps, aelps, nhills, selps +! +! various integers +! + integer :: kmm1, kmm2, lcap, lcapp1 + integer :: npt, kbps, kbpsp1,kbpsm1 + integer :: kmps, idir, nwd, klcap, kp1, kmpbl, kmll + integer :: k_mtb, k_zlow, ktrial, klevm1 + integer :: i, j, k +! + rcpdt = 1.0 / (cpd*dtp) + grav2 = grav + grav +! +! mtb-blocking sigma_min and dxres => cires_initialize +! + sgrmax = maxval(sparea) ; sgrmin = minval(sparea) + dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) + + dxres = pi2*arad/float(imx) + hdxres = 0.5*dxres +! shilmin = sgrmin/nhilmax ! not used - moorthi + +! gammin = min(sso_min/dsmax, 1.) ! moorthi - with this results are not reproducible + gammin = min(sso_min/dxres, 1.) ! moorthi + +! sigmin = 2.*hpmin/dsmax !dxres ! moorthi - this will not reproduce + sigmin = 2.*hpmin/dxres !dxres + +! if (kdt == 1) then +! print *, sgrmax, sgrmin , ' min-max sparea ' +! print *, 'sigmin-hpmin-dsmax', sigmin, hpmin, dsmax +! print *, 'dxres/dsmax ', dxres, dsmax +! print *, ' shilmin gammin ', shilmin, gammin +! endif + + kxridge = float(imx)/arad * cdmbgwd(2) + + if (me == master .and. kdt == 1) then + print *, ' gwdps_v0 kxridge ', kxridge + print *, ' gwdps_v0 scale2 ', cdmbgwd(2) + print *, ' gwdps_v0 imx ', imx + print *, ' gwdps_v0 gam_min ', gammin + print *, ' gwdps_v0 sso_min ', sso_min + endif + + do i=1,im + idxzb(i) = 0 + zmtb(i) = 0.0 + zogw(i) = 0.0 + rdxzb(i) = 0.0 + tau_ogw(i) = 0.0 + tau_mtb(i) = 0.0 + dusfc(i) = 0.0 + dvsfc(i) = 0.0 + tau_tofd(i) = 0.0 +! + ipt(i) = 0 +! + enddo + + do k=1,km + do i=1,im + pdvdt(i,k) = 0.0 + pdudt(i,k) = 0.0 + pdtdt(i,k) = 0.0 + pkdis(i,k) = 0.0 + dudt_mtb(i,k) = 0.0 + dudt_ogw(i,k) = 0.0 + dudt_tms(i,k) = 0.0 + enddo + enddo + +! ---- for lm and gwd calculation points +!cires_ugwp_initialize.F90: real, parameter :: hpmax=2400.0, hpmin=25.0 +!cires_ugwp_initialize.F90: real, parameter :: hminmt=50. ! min mtn height (*j*) +!---- for lm and gwd calculation points + + + npt = 0 + + do i = 1,im + if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then + npt = npt + 1 + ipt(npt) = i + endif + enddo + + if (npt == 0) then +! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt +! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin + return ! no gwd/mb calculation done + endif +!======================================================== + +! + if (do_adjoro ) then + + do i = 1,im +! arhills(i) = 1.0 +! + sigres = max(sigmin, sigma(i)) +! if (sigma(i) < sigmin) sigma(i)= sigmin + dxres = sqrt(sparea(i)) + if (2.*hprime(i)/sigres > dxres) sigres=2.*hprime(i)/dxres + aelps = min(2.*hprime(i)/sigres, 0.5*dxres) + if (gamma(i) > 0.0 ) belps = min(aelps/gamma(i),.5*dxres) +! +! small-scale "turbulent" oro-scales < sso_min +! + if( aelps < sso_min ) then + +! a, b > sso_min upscale ellipse a/b > 0.1 a>sso_min & h/b=>new_sigm +! + aelps = sso_min + if (belps < sso_min ) then + gamma(i) = 1.0 + belps = aelps*gamma(i) + else + gamma(i) = min(aelps/belps, 1.0) + endif + + sigma(i) = 2.*hprime(i)/aelps + gamma(i) = min(aelps/belps, 1.0) + + endif + + selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill + nhills = min(nhilmax, sparea(i)/selps) +! arhills(i) = max(nhills, 1.0) + +!333 format( ' nhil: ', i6, 4(2x, f9.3), 2(2x, e9.3)) +! if (kdt==1 ) +! & write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, +! & belps*1.e-3, sigma(i),gamma(i) + + + enddo + endif !(do_adjoro ) + + + + do i=1,npt + iwklm(i) = 2 + idxzb(i) = 0 + kreflm(i) = 0 + enddo + + do k=1,km + do i=1,im + db(i,k) = 0.0 + ang(i,k) = 0.0 + uds(i,k) = 0.0 + enddo + enddo + + kmm1 = km - 1 ; kmm2 = km - 2 ; kmll = kmm1 + lcap = km ; lcapp1 = lcap + 1 + + cdmb4 = 0.25*cdmb + + do i = 1, npt + j = ipt(i) + elvmax(j) = min (elvmaxd(j)*0. + sigfac * hprime(j), hncrit) + izlow(i) = 1 ! surface-level + enddo +! + do k = 1, kmm1 + do i = 1, npt + j = ipt(i) + ztoph = sigfac * hprime(j) + zlowh = sigfacs* hprime(j) + zmetp = zmet(j,k+1) + zmetk = zmet(j,k) +! if (( elvmax(j) <= zmetp) .and. (elvmax(j).ge.zmetk) ) +! & iwklm(i) = max(iwklm(i), k+1 ) + if (( ztoph <= zmetp) .and. (ztoph >= zmetk) ) iwklm(i) = max(iwklm(i), k+1 ) + if (zlowh <= zmetp .and. zlowh >= zmetk) izlow(i) = max(izlow(i),k) + + enddo + enddo +! + do k = 1,km + do i =1,npt + j = ipt(i) + vtj(i,k) = t1(j,k) * (1.+fv*q1(j,k)) + vtk(i,k) = vtj(i,k) / prslk(j,k) + ro(i,k) = rdi * prsl(j,k) / vtj(i,k) ! density mid-levels + taup(i,k) = 0.0 + enddo + enddo +! +! check ri_n or ri_mf computation +! + do k = 1,kmm1 + do i =1,npt + j = ipt(i) + rdz = 1. / (zmet(j,k+1) - zmet(j,k)) + tem1 = u1(j,k) - u1(j,k+1) + tem2 = v1(j,k) - v1(j,k+1) + dw2 = tem1*tem1 + tem2*tem2 + shr2 = max(dw2,dw2min) * rdz * rdz +! ti = 2.0 / (t1(j,k)+t1(j,k+1)) +! bvf2 = grav*(gocp+rdz*(vtj(i,k+1)-vtj(i,k)))* ti +! ri_n(i,k) = max(bvf2/shr2,rimin) ! richardson number +! + bvf2 = grav2 * rdz * (vtk(i,k+1)-vtk(i,k))/ (vtk(i,k+1)+vtk(i,k)) + + bnv2(i,k+1) = max( bvf2, bnv2min ) + ri_n(i,k+1) = bnv2(i,k)/shr2 ! richardson number consistent with bnv2 +! +! add here computation for ktur and ogw-dissipation fro ve-gfs +! + enddo + enddo + k = 1 + do i = 1, npt + bnv2(i,k) = bnv2(i,k+1) + enddo +! +! level iwklm => zmet(j,k) < sigfac * hprime(j) < zmet(j,k+1) +! + do i = 1, npt + j = ipt(i) + k_zlow = izlow(i) + if (k_zlow == iwklm(i)) k_zlow = 1 + delks(i) = 1.0 / (prsi(j,k_zlow) - prsi(j,iwklm(i))) +! delks1(i) = 1.0 /(prsl(j,k_zlow) - prsl(j,iwklm(i))) + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + pe (i) = 0.0 + ek (i) = 0.0 + bnv2bar(i) = 0.0 + enddo +! + do i = 1, npt + k_zlow = izlow(i) + if (k_zlow == iwklm(i)) k_zlow = 1 + do k = k_zlow, iwklm(i)-1 ! kreflm(i)= iwklm(i)-1 + j = ipt(i) ! laye-aver rho, u, v + rdelks = del(j,k) * delks(i) + ubar(i) = ubar(i) + rdelks * u1(j,k) ! trial mean u below + vbar(i) = vbar(i) + rdelks * v1(j,k) ! trial mean v below + roll(i) = roll(i) + rdelks * ro(i,k) ! trial mean ro below +! + bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks + enddo + enddo +! + do i = 1, npt + j = ipt(i) +! +! integrate from ztoph = sigfac*hprime down to zblk if exists +! find ph_blk, dz_blk like in LM-97 and ifs +! + ph_blk =0. + do k = iwklm(i), 1, -1 + phiang = atan2(v1(j,k),u1(j,k))*rad_to_deg + ang(i,k) = ( theta(j) - phiang ) + if ( ang(i,k) > 90. ) ang(i,k) = ang(i,k) - 180. + if ( ang(i,k) < -90. ) ang(i,k) = ang(i,k) + 180. + ang(i,k) = ang(i,k) * deg_to_rad + uds(i,k) = max(sqrt(u1(j,k)*u1(j,k) + v1(j,k)*v1(j,k)), velmin) +! + if (idxzb(i) == 0 ) then + dz_blk = zmeti(j,k+1) - zmeti(j,k) + pe(i) = pe(i) + bnv2(i,k) *( elvmax(j) - zmet(j,k) ) * dz_blk + + up(i) = max(uds(i,k) * cos(ang(i,k)), velmin) + ek(i) = 0.5 * up(i) * up(i) + + ph_blk = ph_blk + dz_blk*sqrt(bnv2(i,k))/up(i) + +! --- dividing stream lime is found when pe =exceeds ek. oper-l gfs +! if ( pe(i) >= ek(i) ) then + if ( ph_blk >= fcrit_gfs ) then + idxzb(i) = k + zmtb (j) = zmet(j, k) + rdxzb(j) = real(k, kind=kind_phys) + endif + + endif + enddo +! +! alternative expression: zmtb = max(heff*(1. -fcrit_gfs/fr), 0) +! fcrit_gfs/fr +! + goto 788 + + bnv = sqrt( bnv2bar(i) ) + heff = 2.*min(hprime(j),hpmax) + zw2 = ubar(i)*ubar(i)+vbar(i)*vbar(i) + ulow(i) = sqrt(max(zw2,dw2min)) + fr = heff*bnv/ulow(i) + zw1 = max(heff*(1. -fcrit_gfs/fr), 0.0) + zw2 = zmet(j,2) + if (fr > fcrit_gfs .and. zw1 > zw2 ) then + do k=2, kmm1 + zmetp = zmet(j,k+1) + zmetk = zmet(j,k) + if (zw1 <= zmetp .and. zw1 >= zmetk) exit + enddo + idxzb(i) = k + zmtb (j) = zmet(j, k) + else + zmtb (j) = 0. + idxzb(i) = 0 + endif + +788 continue +! +! --- the drag for mtn blocked flow +! + if ( idxzb(i) > 0 ) then + +! (4.16)-ifs + gam2 = gamma(j)*gamma(j) + bgam = 1.0 - 0.18*gamma(j) - 0.04*gam2 + cgam = 0.48*gamma(j) + 0.30*gam2 + + do k = idxzb(i)-1, 1, -1 + zlen = sqrt( (zmtb(j)-zmet(j,k) )/(zmet(j,k ) + hprime(j)) ) + tem = cos(ang(i,k)) + cosang2 = tem * tem + sinang2 = 1.0 - cosang2 +! +! cos =1 sin =0 => 1/r= gam zr = 2.-gam +! cos =0 sin =1 => 1/r= 1/gam zr = 2.- 1/gam +! + rdem = cosang2 + gam2 * sinang2 + rnom = cosang2*gam2 + sinang2 +! +! metoffice dec 2010 +! correction of h. wells & a. zadra for the +! aspect ratio of the hill seen by mean flow +! (1/r , r-inverse below: 2-r) + + rdem = max(rdem, 1.e-6) + r = sqrt(rnom/rdem) + zr = max( 2. - r, 0. ) + + sigres = max(sigmin, sigma(j)) + if (hprime(j)/sigres > dxres) sigres = hprime(j)/dxres + mtbridge = zr * sigres*zlen / hprime(j) +! (4.15)-ifs +! dbtmp = cdmb4 * mtbridge * & +! & max(cos(ang(i,k)), gamma(j)*sin(ang(i,k))) +! (4.16)-ifs + dbtmp = cdmb4*mtbridge*(bgam* cosang2 +cgam* sinang2) + db(i,k)= dbtmp * uds(i,k) + enddo +! + endif + enddo +!............................. +!............................. +! end mtn blocking section +!............................. +!............................. +! +!--- orographic gravity wave drag section +! +! scale cleff between im=384*2 and 192*2 for t126/t170 and t62 +! inside "cires_ugwp_initialize.f90" now +! + kmpbl = km / 2 + iwk(1:npt) = 2 +! +! meto/UK-scheme: +! k_mtb = max(k_zmtb, k_n*hprime/2] to reduce diurnal variations taub_ogw +! + do k=3,kmpbl + do i=1,npt + j = ipt(i) + tem = (prsi(j,1) - prsi(j,k)) + if (tem < dpmin) iwk(i) = k ! dpmin=50 mb + +!=============================================================== +! lev=111 t=311.749 hkm=0.430522 ps-p(iwk)=52.8958 +! below "hprime" - source of ogws and below zblk !!! +! 27 2 kpbl ~ 1-2 km < hprime +!=============================================================== + enddo + enddo +! +! iwk - adhoc gfs-parameter to select ogw-launch level between +! level ~0.4-0.5 km from surface or/and pbl-top +! in ugwp-v1: options to modify as htop ~ (2-3)*hprime > zmtb +! in ugwp-v0 we ensured that : zogw > zmtb +! + + kbps = 1 + kmps = km + k_mtb = 1 + do i=1,npt + j = ipt(i) + k_mtb = max(1, idxzb(i)) + + kref(i) = max(iwk(i), kpbl(j)+1 ) ! reference level pbl or smt-else ???? + kref(i) = max(kref(i), iwklm(i) ) ! iwklm => sigfac*hprime + + if (kref(i) <= k_mtb) kref(i) = k_mtb + 1 ! layer above zmtb + kbps = max(kbps, kref(i)) + kmps = min(kmps, kref(i)) +! + delks(i) = 1.0 / (prsi(j,k_mtb) - prsi(j,kref(i))) + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + bnv2bar(i)= 0.0 + enddo +! + kbpsp1 = kbps + 1 + kbpsm1 = kbps - 1 + k_mtb = 1 +! + do i = 1,npt + k_mtb = max(1, idxzb(i)) + do k = k_mtb,kbps !kbps = max(kref) ;kmps= min(kref) + if (k < kref(i)) then + j = ipt(i) + rdelks = del(j,k) * delks(i) + ubar(i) = ubar(i) + rdelks * u1(j,k) ! mean u below kref + vbar(i) = vbar(i) + rdelks * v1(j,k) ! mean v below kref + roll(i) = roll(i) + rdelks * ro(i,k) ! mean ro below kref + bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks + endif + enddo + enddo +! +! orographic asymmetry parameter (oa), and (clx) + do i = 1,npt + j = ipt(i) + wdir = atan2(ubar(i),vbar(i)) + pi + idir = mod(nint(fdir*wdir),mdir) + 1 + nwd = nwdir(idir) + oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(j,mod(nwd-1,4)+1) + clx(i) = clx4(j,mod(nwd-1,4)+1) + enddo +! + do i = 1,npt + dtfac(i) = 1.0 + icrilv(i) = .false. ! initialize critical level control vector + ulow(i) = max(sqrt(ubar(i)*ubar(i)+vbar(i)*vbar(i)),velmin) + xn(i) = ubar(i) / ulow(i) + yn(i) = vbar(i) / ulow(i) + enddo +! + do k = 1, kmm1 + do i = 1,npt + j = ipt(i) + velco(i,k) = 0.5 * ((u1(j,k)+u1(j,k+1))*xn(i)+ (v1(j,k)+v1(j,k+1))*yn(i)) + + enddo + enddo +! +!------------------ +! v0: incorporates latest modifications for kxridge and heff/hsat +! and taulin for fr <=fcrit_gfs +! and concept of "clipped" hill if zmtb > 0. to make +! the integrated "tau_sso = tau_ogw +tau_mtb" close to reanalysis data +! it is still used the "single-orowave"-approach along ulow-upwind +! +! in contrast to the 2-orthogonal wave (2otw) schemes of ifs/meto/e-canada +! 2otw scheme requires "aver angle" and wind projections on 2 axes of ellipse a-b +! with 2-stresses: taub_a & taub_b as of Phillips (1984) +!------------------ + taub(:) = 0. ; taulin(:)= 0. + do i = 1,npt + j = ipt(i) + bnv = sqrt( bnv2bar(i) ) + heff = min(hprime(j),hpmax) + + if( zmtb(j) > 0.) heff = max(sigfac*heff-zmtb(j), 0.)/sigfac + if (heff <= 0) cycle + + hsat = fcrit_gfs*ulow(i)/bnv + heff = min(heff, hsat) + + fr = min(bnv * heff /ulow(i), frmax) +! + efact = (oa(i) + 2.) ** (ceofrc*fr) + efact = min( max(efact,efmin), efmax ) +! + coefm = (1. + clx(i)) ** (oa(i)+1.) +! + xlinv(i) = coefm * cleff ! effective kxw for lin-wave + xlingfs = coefm * cleff +! + tem = fr * fr * oc(j) + gfobnv = gmax * tem / ((tem + cg)*bnv) +! +!new specification of xlinv(i) & taulin(i) + + sigres = max(sigmin, sigma(j)) + if (heff/sigres > hdxres) sigres = heff/hdxres + inv_b2eff = 0.5*sigres/heff + kxridge = 1.0 / sqrt(sparea(j)) + xlinv(i) = xlingfs !or max(kxridge, inv_b2eff) ! 6.28/lx ..0.5*sigma(j)/heff = 1./lridge + taulin(i) = 0.5*roll(i)*xlinv(i)*bnv*ulow(i)*heff*heff*pgwd4 + + if ( fr > fcrit_gfs ) then + taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & + * ulow(i) * gfobnv * efact ! nonlinear flux tau0...xlinv(i) +! + else +! taub(i) = taulin(i) ! linear flux for fr <= fcrit_gfs + taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & + * ulow(i) * gfobnv * efact +! + endif +! +! + k = max(1, kref(i)-1) + tem = max(velco(i,k)*velco(i,k), dw2min) + scor(i) = bnv2(i,k) / tem ! scorer parameter below kref level +! +! diagnostics for zogw > zmtb +! + zogw(j) = zmeti(j, kref(i) ) + enddo +! +!----set up bottom values of stress +! + do k = 1, kbps + do i = 1,npt + if (k <= kref(i)) taup(i,k) = taub(i) + enddo + enddo + + if (strsolver == 'pss-1986') then + +!====================================================== +! v0-gfs orogw-solver of palmer et al 1986 -"pss-1986" +! in v1-orogw linsatdis of "wam-2017" +! with llwb-mechanism for +! rotational/non-hydrostat ogws important for +! highres-fv3gfs with dx < 10 km +!====================================================== + + do k = kmps, kmm1 ! vertical level loop from min(kref) + kp1 = k + 1 + do i = 1, npt +! + if (k >= kref(i)) then + icrilv(i) = icrilv(i) .or. ( ri_n(i,k) < ric).or. (velco(i,k) <= 0. ) + endif + enddo +! + do i = 1,npt + if (k >= kref(i)) then + if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) then + temv = 1.0 / max(velco(i,k), velmin) +! + if (oa(i) > 0. .and. kp1 < kref(i)) then +! + scork = bnv2(i,k) * temv * temv + rscor = min(1.0, scork / scor(i)) + scor(i) = scork + else + rscor = 1. + endif +! + brvf = sqrt(bnv2(i,k)) ! brent-vaisala frequency interface +! tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k))*brvf*velco(i,k)*0.5 + + tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k))*brvf*0.5 & + * max(velco(i,k), velmin) + hd = sqrt(taup(i,k) / tem1) + fro = brvf * hd * temv +! +! rim is the "wave"-richardson number by palmer,shutts, swinbank 1986 +! + + tem2 = sqrt(ri_n(i,k)) + tem = 1. + tem2 * fro + ri_gw = ri_n(i,k) * (1.0-fro) / (tem * tem) +! +! check stability to employ the 'dynamical saturation hypothesis' +! of palmer,shutts, swinbank 1986 +! + if (ri_gw <= ric .and.(oa(i) <= 0. .or. kp1 >= kref(i) )) then + temc = 2.0 + 1.0 / tem2 + hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf + taup(i,kp1) = tem1 * hd * hd + else + taup(i,kp1) = taup(i,k) * rscor + endif +! + taup(i,kp1) = min(taup(i,kp1), taup(i,k)) + endif + endif + enddo + enddo +! +! zero momentum deposition at the top model layer +! + taup(1:npt,km+1) = taup(1:npt,km) +! +! calculate wave acc-n: - (grav)*d(tau)/d(p) = taud +! + do k = 1,km + do i = 1,npt + taud(i,k) = grav*(taup(i,k+1) - taup(i,k))/del(ipt(i),k) + enddo + enddo + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!------if the gravity wave drag would force a critical line in the +!------layers below sigma=rlolev during the next deltim timestep, +!------then only apply drag until that critical line is reached. +! empirical implementation of the llwb-mechanism: lower level wave breaking +! by limiting "ax = dtfac*ax" due to possible llwb around kref and 500 mb +! critical line [v - ax*dtp = 0.] is smt like "llwb" for stationary ogws +!2019: this option limits sensitivity of taux/tauy to increase/decrease of taub +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + do k = 1,kmm1 + do i = 1,npt + if (k >= kref(i) .and. prsi(ipt(i),k) >= rlolev) then + + if(taud(i,k) /= 0.) then + tem = dtp * taud(i,k) ! tem = du/dt-oro*dt => U/dU vs 1 + dtfac(i) = min(dtfac(i),abs(velco(i,k)/tem)) ! reduce Ax= Ax*(1, or U/dU <=1) +! dtfac(i) = 1.0 + endif + endif + enddo + enddo +! +!--------------------------- orogw-solver of gfs pss-1986 +! + else +! +!-----------Unified orogw-solver of wam2017 +! +! sigres = max(sigmin, sigma(j)) +! if (heff/sigres.gt.dxres) sigres=heff/dxres +! inv_b2eff = 0.5*sigres/heff +! xlinv(i) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./lridge + + dtfac(:) = 1.0 + + call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, & + dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsl, & + del, sigma, hprime, gamma, theta, sinlat, xlatd, taup, taud, pkdis) + + endif ! oro_wam_2017 - linsatdis-solver of wam-2017 +! +!---- above orogw-solver of wam2017 +! +! tofd as in beljaars-2004 +! +! --------------------------- + if( do_tofd ) then + axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 + if ( kdt == 1 .and. me == 0) then + print *, 'vay do_tofd from surface to ', ztop_tofd + endif + do i = 1,npt + j = ipt(i) + zpbl = zmet( j, kpbl(j) ) + + sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of ls-sso + + zsurf = zmeti(j,1) + do k=1,km + zpm(k) = zmet(j,k) + up1(k) = u1(j,k) + vp1(k) = v1(j,k) + enddo + + call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, & + up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) + + do k=1,km + axtms(j,k) = utofd1(k) + aytms(j,k) = vtofd1(k) +! +! add tofd to gw-tendencies +! + pdvdt(j,k) = pdvdt(j,k) + aytms(j,k) + pdudt(j,k) = pdudt(j,k) + axtms(j,k) + enddo +!2018-diag + tau_tofd(j) = sum( utofd1(1:km)* del(j,1:km)) + enddo + endif ! do_tofd + +!-------------------------------------------- +! combine oro-drag effects MB +TOFD + OGWs +!-------------------------------------------- +! + diag-3d + + dudt_tms = axtms + tau_ogw = 0. + tau_mtb = 0. + + do k = 1,km + do i = 1,npt + j = ipt(i) +! + eng0 = 0.5*(u1(j,k)*u1(j,k)+v1(j,k)*v1(j,k)) +! + if ( k < idxzb(i) .and. idxzb(i) /= 0 ) then +! +! if blocking layers -- no ogws +! + dbim = db(i,k) / (1.+db(i,k)*dtp) + pdvdt(j,k) = - dbim * v1(j,k) +pdvdt(j,k) + pdudt(j,k) = - dbim * u1(j,k) +pdudt(j,k) + eng1 = eng0*(1.0-dbim*dtp)*(1.-dbim*dtp) + + dusfc(j) = dusfc(j) - dbim * u1(j,k) * del(j,k) + dvsfc(j) = dvsfc(j) - dbim * v1(j,k) * del(j,k) +!2018-diag + dudt_mtb(j,k) = -dbim * u1(j,k) + tau_mtb(j) = tau_mtb(j) + dudt_mtb(j,k)* del(j,k) + + else +! +! ogw-s above blocking height +! + taud(i,k) = taud(i,k) * dtfac(i) + dtaux = taud(i,k) * xn(i) * pgwd + dtauy = taud(i,k) * yn(i) * pgwd + + pdvdt(j,k) = dtauy +pdvdt(j,k) + pdudt(j,k) = dtaux +pdudt(j,k) + + unew = u1(j,k) + dtaux*dtp ! pdudt(j,k)*dtp + vnew = v1(j,k) + dtauy*dtp ! pdvdt(j,k)*dtp + eng1 = 0.5*(unew*unew + vnew*vnew) +! + dusfc(j) = dusfc(j) + dtaux * del(j,k) + dvsfc(j) = dvsfc(j) + dtauy * del(j,k) +!2018-diag + dudt_ogw(j,k) = dtaux + tau_ogw(j) = tau_ogw(j) +dtaux*del(j,k) + endif +! +! local energy deposition sso-heat +! + pdtdt(j,k) = max(eng0-eng1,0.)*rcpdt + enddo + enddo +! dusfc w/o tofd sign as in the era-i, merra and cfsr + do i = 1,npt + j = ipt(i) + dusfc(j) = -rgrav * dusfc(j) + dvsfc(j) = -rgrav * dvsfc(j) + tau_mtb(j) = -rgrav * tau_mtb(j) + tau_ogw(j) = -rgrav * tau_ogw(j) + tau_tofd(j) = -rgrav * tau_tofd(j) + enddo + + return + + +!============ debug ------------------------------------------------ + if (kdt <= 2 .and. me == 0) then + print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw_axoro' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw_ayoro' +! print *, maxval(kdis), minval(kdis), 'vgw_kdispro m2/sec' + print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw_epsoro' + print *, maxval(zmtb), ' z_mtb ', maxval(tau_mtb), ' tau_mtb ' + print *, maxval(zogw), ' z_ogw ', maxval(tau_ogw), ' tau_ogw ' +! print *, maxval(tau_tofd), ' tau_tofd ' +! print *, maxval(axtms)*86400., minval(axtms)*86400, 'vgw_axtms' +! print *,maxval(dudt_mtb)*86400.,minval(dudt_mtb)*86400,'vgw_axmtb' + if (maxval(abs(pdudt))*86400. > 100.) then + + print *, maxval(u1), minval(u1), ' u1 gwdps-v0 ' + print *, maxval(v1), minval(v1), ' v1 gwdps-v0 ' + print *, maxval(t1), minval(t1), ' t1 gwdps-v0 ' + print *, maxval(q1), minval(q1), ' q1 gwdps-v0 ' + print *, maxval(del), minval(del), ' del gwdps-v0 ' + print *, maxval(zmet),minval(zmet), 'zmet' + print *, maxval(zmeti),minval(zmeti), 'zmeti' + print *, maxval(prsi), minval(prsi), ' prsi ' + print *, maxval(prsl), minval(prsl), ' prsl ' + print *, maxval(ro), minval(ro), ' ro-dens ' + print *, maxval(bnv2(1:npt,:)), minval(bnv2(1:npt,:)),' bnv2 ' + print *, maxval(kpbl), minval(kpbl), ' kpbl ' + print *, maxval(sgh30), maxval(hprime), maxval(elvmax),'oro-d' + print * + do i =1, npt + j= ipt(i) + print *,zogw(j)/hprime(j), zmtb(j)/hprime(j), & + zmet(j,1)*1.e-3, nint(hprime(j)/sigma(j)) +! +!.................................................................... +! +! zogw/hp=5.9 zblk/hp=10.7 zm=11.1m ridge/2=2,489m/9,000m +! from 5 to 20 km , we need to count for "ridges" > dx/4 ~ 15 km +! we must exclude blocking by small ridges +! vay-kref < iblk zogw-lev 15 block-level: 39 +! +! velmin => 1.0, 0.01, 0.1 etc.....unification of wind limiters +! max(sqrt(u1(j,k)*u1(j,k) + v1(j,k)*v1(j,k)), minwnd) +! max(dw2,dw2min) * rdz * rdz +! ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0) +! tem = max(velco(i,k)*velco(i,k), 0.1) +! temv = 1.0 / max(velco(i,k), 0.01) +! & * max(velco(i,k),0.01) +!.................................................................... + enddo + print * + stop + endif + endif + +!cires_ugwp_solv2_v1.f90 + return + end subroutine gwdps_oro_v1 + + +end module cires_ugwp_orolm97_v1 diff --git a/physics/cires_ugwp_solv2_v1_mod.F90 b/physics/cires_ugwp_solv2_v1_mod.F90 new file mode 100644 index 000000000..ec2ec7bf2 --- /dev/null +++ b/physics/cires_ugwp_solv2_v1_mod.F90 @@ -0,0 +1,810 @@ +module cires_ugwp_solv2_v1_mod + + +contains + + +!--------------------------------------------------- +! Broad spectrum FVS-1993, mkz^nSlope with nSlope = 0, 1,2 +! dissipative solver with NonHyd/ROT-effects +! reflected GWs treated as waves with "negligible" flux, +! they are out of given column +!--------------------------------------------------- + subroutine cires_ugwp_solv2_v1(im, levs, dtp , & + tm , um, vm, qm, prsl, prsi, zmet, zmeti, & + prslk, xlatd, sinlat, coslat, & + pdudt, pdvdt, pdtdt, dked, tauabs, wrms, trms, & + tau_ngw, mpi_id, master, kdt) +! +!-------------------------------------------------------------------------------- +! nov 2015 alternative gw-solver for nggps-wam +! nov 2017 nh/rotational gw-modes for nh-fv3gfs +! oct 2019 adding empirical satellite-based +! source function and *F90 CIRES-style of the code +! -------------------------------------------------------------------------------- +! + + use machine, only : kind_phys + + use cires_ugwp_module,only : krad, kvg, kion, ktg + + use cires_ugwp_module,only : knob_ugwp_doheat, knob_ugwp_dokdis, idebug_gwrms + + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpdl, grav2cpd, & + omega2, rcpd, rcpd2, pi, pi2, fv, & + rad_to_deg, deg_to_rad, & + rdi, gor, grcp, gocp, & + bnv2min, bnv2max, dw2min, velmin, gr2, & + hpscale, rhp, rh4, grav2, rgrav2, mkzmin, mkz2min +! + use ugwp_wmsdis_init, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & + maxdudt, gw_eff, dked_min, dked_max, maxdtdt, & + nslope, ilaunch, zms, & + zci, zdci, zci4, zci3, zci2, & + zaz_fct, zcosang, zsinang, nwav, nazd, & + zcimin, zcimax, rimin, sc2, sc2u, ric +! + implicit none +!23456 + + integer, intent(in) :: levs ! vertical level + integer, intent(in) :: im ! horiz tiles + + real ,intent(in) :: dtp ! model time step + real ,intent(in) :: vm(im,levs) ! meridional wind + real ,intent(in) :: um(im,levs) ! zonal wind + real ,intent(in) :: qm(im,levs) ! spec. humidity + real ,intent(in) :: tm(im,levs) ! kinetic temperature + + real ,intent(in) :: prsl(im,levs) ! mid-layer pressure + real ,intent(in) :: prslk(im,levs) ! mid-layer exner function + real ,intent(in) :: zmet(im,levs) ! meters now !!!!! phil =philg/grav + real ,intent(in) :: prsi(im,levs+1) ! interface pressure + real ,intent(in) :: zmeti(im,levs+1) ! interface geopi/meters + real ,intent(in) :: xlatd(im) ! lat was in radians, now with xlat_d in degrees + real ,intent(in) :: sinlat(im) + real ,intent(in) :: coslat(im) + real ,intent(in) :: tau_ngw(im) + + integer, intent(in):: mpi_id, master, kdt +! +! +! out-gw effects +! + real ,intent(out) :: pdudt(im,levs) ! zonal momentum tendency + real ,intent(out) :: pdvdt(im,levs) ! meridional momentum tendency + real ,intent(out) :: pdtdt(im,levs) ! gw-heating (u*ax+v*ay)/cp + real ,intent(out) :: dked(im,levs) ! gw-eddy diffusion +! +! GW diagnostics => next move it to "module_gw_diag" +! + real ,intent(out) :: tauabs(im,levs) ! + real ,intent(out) :: wrms(im,levs) ! + real ,intent(out) :: trms(im,levs) ! + + real :: zwrms(nwav,nazd), wrk1(levs), wrk2(levs) + real :: atrms(nazd, levs),awrms(nazd, levs), akzw(nwav,nazd, levs+1) +! +! local =========================================================================================== + real :: taux(levs+1) ! EW component of vertical momentum flux (pa) + real :: tauy(levs+1) ! NS component of vertical momentum flux (pa) + real :: fpu(nazd, levs+1) ! az-momentum flux + real :: ui(nazd, levs+1) ! azimuthal wind + + real :: fden_bn(levs+1) ! density/brent + real :: flux_z(nwav,levs+1) + real :: flux(nwav, nazd) +! +! =============================================================================================== +! ilaunch:levs ....... MOORTHI's improvements +! all computations of GW-effects include interface layers from ilaunch+1 to levs +1 +! at k=levs+1, extrapolation of MF-state has been made, "ideally" all spectral modes should +! be absorbed; 2-options for this "ideal" requirement +! a) properly truncate GW-spectra ; b) dissipate all GW-energy in the top layers ( GW-sponge) +!===================================================================================================== +! + real :: bn(levs+1) ! interface BV-frequency + real :: bn2(levs+1) ! interface BV*BV-frequency + real :: rhoint(levs+1) ! interface density + real :: uint(levs+1) ! interface zonal wind + real :: vint(levs+1) ! meridional wind + + real :: irhodz_mid(levs), dzdt(levs+1), bnk(levs+1), rhobnk(levs+1) + + real :: v_zmet(levs+1) + real :: vueff(levs+1) + real :: dfdz_v(nazd, levs) ! axj = -df*rho/dz directional momentum deposition + + + real :: suprf(levs+1) ! RF-super linear dissipation + + real, dimension(levs) :: atm , aum, avm, aqm, aprsl, azmet + real, dimension(levs+1) :: aprsi, azmeti + + real :: wrk3(levs) + real, dimension(levs) :: uold, vold, told, unew, vnew, tnew + real, dimension(levs) :: dktur, rho, rhomid, adif, cdif + + real :: rdci(nwav), rci(nwav) + real :: wave_act(nwav, nazd) ! active waves at given vert-level + real :: ul(nazd) ! velocity in azimuthal direction at launch level + real :: bvi, bvi2, bvi3, bvi4, rcms ! BV at launch level + real :: c2f2, cf1 + + + real :: flux_norm ! norm-factor + real :: taub_src, rho_src +! +! scalars +! + real :: zthm, dtau, cgz, ucrit_maxdc + real :: vm_zflx_mode, vc_zflx_mode + real :: kzw2, kzw3, kdsat, cdf2, cdf1, wdop2,v_cdp2 + real :: ucrit_max + real :: pwrms, ptrms + real :: zu, zcin, zcin2, zcin3, zcin4, zcinc + real :: zatmp, fluxs, zdep, ze1, ze2 + +! + real :: zdelp, zdelm, taud_min + real :: tvc, tvm, ptc, ptm + real :: umfp, umfm, umfc, ucrit3 + real :: fmode, expdis, fdis + real :: v_kzi, v_kzw, v_cdp, v_wdp, tx1, fcorsat, dzcrit + real :: v_wdi, v_wdpc + real :: ugw, vgw, ek1, ek2, rdtp, rdtp2 + + integer :: j, jj, k, kk, inc, jk, jkp, jl, iaz + integer :: ksrc, km2, km1, kp1, ktop +! +! Kturb-part +! + + real :: uz, vz, shr2 , ritur, ktur + + real :: kamp, zmetk, zgrow + real :: stab, stab_dt, dtstab + integer :: nstab, ist, anstab(levs) + real :: w1, w2, w3, dtdif + + real :: dzmetm, dzmetp, dzmetf, bdif, kturp + real :: bnrh_src +!-------------------------------------------------------------------------- +! + + if (mpi_id == master .and. kdt < 2) then + print *, im, levs, dtp, kdt, ' vay-solv2-v1' + print *, minval(tm), maxval(tm), ' min-max-tm ' + print *, minval(vm), maxval(vm), ' min-max-vm ' + print *, minval(um), maxval(um), ' min-max-um ' + print *, minval(qm), maxval(qm), ' min-max-qm ' + print *, minval(prsl), maxval(prsl), ' min-max-Pmid ' + print *, minval(prsi), maxval(prsi), ' min-max-Pint ' + print *, minval(zmet), maxval(zmet), ' min-max-Zmid ' + print *, minval(zmeti), maxval(zmeti), ' min-max-Zint ' + print *, minval(prslk), maxval(prslk), ' min-max-Exner ' + print *, minval(tau_ngw), maxval(tau_ngw), ' min-max-taungw ' + print *, tau_min, ' tau_min ', tamp_mpa, ' tamp_mpa ' +! + endif + + if (idebug_gwrms == 1) then + tauabs=0.0; wrms =0.0 ; trms =0.0 + endif + +! grav2 = grav + grav +! rgrav2 = rgrav*rgrav + + rci(:) = 1./zci(:) + rdci(:) = 1./zdci(:) + + rdtp = 1./dtp + rdtp2 = 0.5*rdtp +! +! launch level control ksrc > 2 +! + + ksrc= max(ilaunch, 3) + km2 = ksrc - 2 + km1 = ksrc - 1 + kp1 = ksrc + 1 + ktop= levs+1 + + do k=1,levs + suprf(k) = kion(k) ! approximate 1-st order damping with Fast super-RF of FV3 + pdvdt(:,k) = 0.0 + pdudt(:,k) = 0.0 + pdtdt(:,k) = 0.0 + dked(: ,k) = 0.0 + enddo + +!----------------------------------------------------------- +! column-based j=1,im pjysics with 1D-arrays +!----------------------------------------------------------- + DO j=1, im + + jl =j + tx1 = omega2 * sinlat(j) *rv_kxw + cf1 = abs(tx1) + c2f2 = tx1 * tx1 + ucrit_max = max(ucrit, cf1) + ucrit3 = ucrit_max*ucrit_max*ucrit_max +! +! ngw-fluxes at all gridpoints (with tau_min at least) +! + taub_src = max(tau_ngw(jl), tau_min) + aum(km2:levs) = um(jl,km2:levs) + avm(km2:levs) = vm(jl,km2:levs) + atm(km2:levs) = tm(jl,km2:levs) + aqm(km2:levs) = qm(jl,km2:levs) + aprsl(km2:levs) = prsl(jl,km2:levs) + azmet(km2:levs) = zmet(jl,km2:levs) + aprsi(km2:levs+1) = prsi(jl,km2:levs+1) + azmeti(km2:levs+1) = zmeti(jl,km2:levs+1) + + rho_src = aprsl(ksrc)*rdi/atm(ksrc) + +! --------------------------------------------- +! interface mean flow parameters launch -> levs+1 +! --------------------------------------------- + do jk= km1,levs + tvc = atm(jk) * (1. +fv*aqm(jk)) + tvm = atm(jk-1) * (1. +fv*aqm(jk-1)) + ptc = tvc/ prslk(jl, jk) + ptm = tvm/prslk(jl,jk-1) +! + zthm = 2.0 / (tvc+tvm) +! + uint(jk) = 0.5 *(aum(jk-1)+aum(jk)) + vint(jk) = 0.5 *(avm(jk-1)+avm(jk)) + rhomid(jk) = aprsl(jk)*rdi/atm(jk) + rhoint(jk) = aprsi(jk)*rdi*zthm ! rho = p/(RTv) + zdelp = azmeti(jk+1)-azmeti(jk) ! >0 ...... dz-meters + zdelm = 1./(azmet(jk)-azmet(jk-1)) ! 1/dz ...... 1/meters + dzdt(jk) = dtp/zdelp +! +! bvf2 = grav2 * zdelm * (ptc-ptm)/ (ptc + ptm) ! N2=[g/PT]*(dPT/dz) +! + bn2(jk) = grav2cpd*zthm * (1.0+rcpdl*(tvc-tvm)*zdelm) + bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) + bn(jk) = sqrt(bn2(jk)) + bnk(jk) = bn(jk)*v_kxw + rhobnk(jk)=rhoint(jk)/bnk(jk)*v_kxw + wrk3(jk)= 1./zdelp/rhomid(jk) ! 1/rho_mid(k)/[Z_int(k+1)-Z_int(k)] + irhodz_mid(jk) = rdtp*zdelp*rhomid(jk)/rho_src + + v_zmet(jk) = 2.*zdelp ! 2*kzi*[Z_int(k+1)-Z_int(k)] +! +! +! diagnostics -Kzz above PBL +! + uz = aum(jk) - aum(jk-1) + vz = avm(jk) - avm(jk-1) + shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm + + zmetk = azmet(jk)* rh4 ! mid-layer height k_int => k_int+1 + zgrow = exp(zmetk) + ritur = bn2(jk)/shr2 + kamp = sqrt(shr2)*sc2 *zgrow + w1 = 1./(1. + 5*ritur) + ktur= min(max(kamp * w1 * w1, dked_min)+kvg(k), dked_max) + zmetk = azmet(jk)* rhp + vueff(jk) = ktur*0. + 2.e-5*exp( zmetk) + enddo + + if (idebug_gwrms == 1) then + do jk= km1,levs + wrk1(jk) = rv_kxw/rhoint(jk) + wrk2(jk)= rgrav2*zthm*zthm*bn2(jk) ! dimension [K*K]*(c2/m2) + enddo + endif + +! +! extrapolating values for ktop = levs+1 (lev-interface for prsi(levs+1) =/= 0) +! + jk = levs + + suprf(ktop) = kion(jk) + + rhoint(ktop) = aprsi(ktop)*rdi/atm(jk) + + uint(ktop) = aum(jk) + vint(ktop) = avm(jk) + + v_zmet(ktop) = v_zmet(jk) + vueff(ktop) = vueff(jk) + bn2(ktop) = bn2(jk) + bn(ktop) = bn(jk) + bnk(ktop) = bn(ktop)*v_kxw + + rhobnk(ktop) = rhoint(ktop)/bnk(ktop)*v_kxw + + bvi = bn(ksrc); bvi2 = bvi * bvi; + bvi3 = bvi2*bvi; bvi4 = bvi2 * bvi2; rcms = zms/bvi + bnrh_src = bvi/rhoint(ksrc) +! +! define intrinsic velocity (relative to ilaunch) u(z)-u(zo), and coefficinets +! ------------------------------------------------------------------------------------------ + do iaz=1, nazd + ul(iaz) = zcosang(iaz) *uint(ksrc) + zsinang(iaz) *vint(ksrc) + enddo +! + do jk=ksrc, ktop + do iaz=1, nazd + zu = zcosang(iaz)*uint(jk) + zsinang(iaz)*vint(jk) + ui(iaz, jk) = zu !- ul(iaz)*0. + enddo + enddo +! ----------------------------------------- +! set launch momentum flux spectral density +! ----------------------------------------- + + fpu(1, ksrc) =0. + do inc=1,nwav + zcin = zci(inc) + zcin4 = zci4(inc)/bvi4 +! + if(nslope == 0) then + zcin3 = zci3(inc)/bvi3 + flux(inc,1) = zcin/(1.+zcin3) + endif + + if(nslope == 1) flux(inc,1) = zcin/(1.+zcin4) + if(nslope == 2) flux(inc,1)= zcin/(1.+zcin4*zcin*rcms) + +! integrate (flux x dx) + fpu(1,ksrc) = fpu(1,ksrc) + flux(inc,1)*zdci(inc) + + do iaz=1,nazd + akzw(inc, iaz,ksrc:ktop) = bvi*rci(inc) + enddo + + enddo +! + flux_norm = taub_src / fpu(1, ksrc) +! + do iaz=1,nazd + fpu(iaz, ksrc) = taub_src + enddo + +! adjust rho/bn vertical factors for saturated fluxes (E(m) ~m^-3) + bnrh_src=bnrh_src*flux_norm + do jk=ksrc, ktop + fden_bn(jk) = bnrh_src*rhoint(jk) / bn(jk) !*bvi/rhoint(ksrc) + enddo + +! + do inc=1, nwav + flux(inc,1) = flux_norm*flux(inc,1) + enddo + + if (idebug_gwrms == 1) then + pwrms =0. + ptrms =0. + tx1 = real(nazd)/rhoint(ksrc)*rv_kxw + ze2 = wrk2(ksrc) ! (bvi*atm(ksrc)*rgrav)**2 + do inc=1, nwav + v_kzw = bvi*rci(inc) + ze1 = flux(inc,1)*zdci(inc)*tx1*v_kzw + pwrms = pwrms + ze1 + ptrms = ptrms + ze1 * ze2 + enddo + wrms(jl, ksrc) = pwrms + trms(jl, ksrc) = ptrms + endif + +! copy flux-1 into other azimuths +! -------------------------------- + do iaz=2, nazd + do inc=1,nwav + flux(inc,iaz) = flux(inc,1) + enddo + enddo + +! constant flux below ilaunch + do jk=km1, ksrc + do inc=1, nwav + flux_z(inc,jk)=flux(inc,1) + enddo + enddo + + wave_act(:,:) = 1.0 +! vertical do-loop + do jk=ksrc, levs + jkp = jk+1 +! azimuth do-loop + do iaz=1, nazd + + umfp = ui(iaz, jkp) + umfm = ui(iaz, jk) + umfc = .5*(umfm + umfp) +! wave-cin loop + do inc=1, nwav + + zcin = zci(inc) ! zcin =/0 by definition + zcinc = rci(inc) + + if(wave_act(inc,iaz) == 1.0) then +!======================================================================= +! discrete mode +! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat +! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) +!======================================================================= + + v_cdp = zcin - umfp + + if (v_cdp .le. ucrit_max) then +! +! between layer [k-1,k or jk-jkp] (Chi - Uk) -> ucrit_max ; wave's absorption +! + wave_act(inc,iaz) =0. + akzw(inc, iaz, jkp) = pi/v_zmet(jk) ! pi2/dzmet + fluxs = 0.0 !max(0., rhobnk(jkp)*ucrit3)*rdci(inc) + flux(inc,iaz) = fluxs + flux_z(inc,jkp) = fluxs +! ucrit_maxdc =0. + else + + v_wdp = v_kxw*v_cdp + wdop2 = v_wdp* v_wdp + v_cdp2=v_cdp*v_cdp +! +! rotational cut-off +! + cdf2 = v_cdp2 - c2f2 + + if (cdf2 > 0.0) then + kzw2 = (bn2(jkp)-wdop2)/Cdf2 + else + kzw2 = mkz2min + endif + + if ( kzw2 > mkz2min ) then + v_kzw = sqrt(kzw2) + akzw(inc, iaz, jkp) = v_kzw +! +!linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 +! +!kzw2 = (bn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) +! Kds = kxw*Cdf1*rhp2/kzw3 +! + v_cdp = sqrt( cdf2 ) + v_wdp = v_kxw * v_cdp + v_wdi = kzw2*vueff(jk) + supRF(jk) ! supRF - diss due to FRF-FV3dycore for "all" vars + v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) + v_kzi = v_kzw*v_wdi/v_wdpc +! + ze1 = v_kzi*v_zmet(jk) + + if (ze1 .ge. 1.e-2) then + expdis = max(exp(-ze1), 0.01) + else + expdis = 1./(1.+ ze1) + endif + +! + wave_act(inc,iaz) = 1.0 + fmode = flux(inc,iaz) + + else ! kzw2 <= mkz2min large "Lz"-reflection + + expdis = 1.0 + v_kzw = mkzmin + + v_cdp = 0. ! no effects of reflected waves + wave_act(inc,iaz) = 0.0 + akzw(inc, iaz, jkp) = v_kzw + fmode = 0. + endif + + fdis = fmode*expdis +! +! saturated flux + wave dissipation - Keddy_gwsat in UGWP-V1 +! linsatdis = 1.0 , here: u'^2 ~ linsatdis* [v_cdp*v_cdp] +! +! fluxs= fden_bn(jkp)*cdf2*zcinc + fluxs= fden_bn(jkp)*sqrt(cdf2) + +! +! S2003 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz))**2/zcin +! WM2001 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz)) +! + zdep = wave_act(inc,iaz)* (fdis-fluxs) + if(zdep > 0.0 ) then +! subs on sat-limit + flux(inc,iaz) = fluxs + flux_z(inc,jkp) = fluxs + else +! assign dis-ve flux + flux(inc,iaz) = fdis + flux_z(inc,jkp) = fdis + endif + +! cgz = bnk(jk)/max(mkz2min, kzw2) + + dtau = flux_z(inc,jk)-flux_z(inc,jkp) + if (dtau .lt. 0) flux_z(inc,jkp) = flux_z(inc,jk) + +! if (dtau .ge. ucrit_maxdc) then +! flux_z(inc,jkp) = max(flux_z(inc,jk)-ucrit_maxdc, 0.) +! ze1 = zci(inc)-umfc-ucrit_maxdc +! write(6,287) dzdt(jk)/cgz, dtau/ucrit_maxdc, flux_z(inc,jkp)*1.e3, fluxs*1.e3, jk, zci(inc), ze1 +! +! endif +! 287 format(' dtau >ucrit_max', 4(2x, F12.7), I4, 2x, 2(2x,F8.3)) +! + + endif ! coriolis or CL condition-checkif => (v_cdp .le. ucrit_max) then + endif ! only for waves w/o CL-absorption wave_act=1 + + +! + enddo ! wave-inc-loop +! +! integrate over spectral modes fpu(y, z, azimuth) wave_act(jl,inc,iaz)*flux(jl,inc,iaz)*[d("zcinc")] +! + if (idebug_gwrms == 1) then + pwrms =0. + ptrms =0. +! new arrays + + do inc=1, nwav + if (wave_act(inc,iaz) > 0.) then + v_kzw =akzw(inc, iaz, jk) + ze1 = flux(inc,iaz)*v_kzw*zdci(inc)*wrk1(jk) + pwrms = pwrms + ze1 + ptrms = ptrms + ze1*wrk2(jk) + endif + enddo + Awrms(iaz, jk) = pwrms + Atrms(iaz, jk) = ptrms + endif + + + dfdz_v(iaz, jk) = 0.0 + fpu(iaz, jkp) = 0.0 + + do inc=1, nwav + if (wave_act(inc,iaz) > 0.) then + + zcinc =zdci(inc) + vc_zflx_mode = flux(inc,iaz) + fpu(iaz, jkp) = fpu(iaz,jkp) + vc_zflx_mode*zcinc + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! (heat deposition integration over spectral mode for each azimuth +! later sum over selected azimuths as "non-negative" scalars) +! cdf1 = sqrt( (zci(inc)-umfc)**2-c2f2) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! zdelp = wrk3(jk)*cdf1 *zcinc + zdelp = wrk3(jk)*abs(zci(inc)-umfc) *zcinc + vm_zflx_mode = flux_z(inc,jk) + dfdz_v(iaz, jk) = dfdz_v(iaz,jk) +(vm_zflx_mode-vc_zflx_mode)*zdelp ! heating >0 + endif + enddo !waves inc=1,nwav + + ze1 =fpu(iaz, jk) + if (fpu(iaz, jkp) > ze1 ) fpu(iaz, jkp) = ze1 +! -------------- + enddo ! end Azimuth do-loop + +! +! extra- eddy wave dissipation to limit GW-rms +! tx1 = sum(abs(dfdz_v(jk,1:nazd)))/bn2(jk) +! ze1=max(dked_min, tx1) +! ze2=min(dked_max, ze1) +! vueff(jkp) = ze2 + vueff(jkp) +! + + + enddo ! end Vertical do-loop +! +! top-layers constant interface-fluxes and zero-heat +! + fpu(1:nazd,ktop) = fpu(1:nazd, levs) + dfdz_v(1:nazd, levs) = 0.0 + +! --------------------------------------------------------------------- +! sum contribution for total zonal and meridional fluxes + +! energy dissipation +! --------------------------------------------------- +! +!======================================================================== +! at the source level and below taux = 0 (taux_E=-taux_W by assumption) +!======================================================================== + + + + do jk=ksrc, levs + taux(jk) = 0.0 + tauy(jk) = 0.0 + do iaz=1,nazd + taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) + tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) + pdtdt(jl,jk) = pdtdt(jl,jk)+ dfdz_v(iaz,jk) + enddo + enddo + jk = ktop; taux(jk)=0.; tauy(jk)=0. + do iaz=1,nazd + taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) + tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) + enddo + + if (idebug_gwrms == 1) then + + do jk=kp1, levs + do iaz=1,nazd + wrms(jl,jk) =wrms(jl,jk) + Awrms(iaz,jk) + trms(jl,jk) =trms(jl,jk) + Atrms(iaz,jk) + tauabs(jl,jk)=tauabs(jl,jk) + fpu(iaz,jk) + enddo + enddo + + endif +! + + do jk=ksrc,levs + jkp = jk + 1 + zdelp = wrk3(jk)*gw_eff + ze1 = (taux(jkp)-taux(jk))* zdelp + ze2 = (tauy(jkp)-tauy(jk))* zdelp + + if (abs(ze1) >= maxdudt ) then + ze1 = sign(maxdudt, ze1) + endif + if (abs(ze2) >= maxdudt ) then + ze2 = sign(maxdudt, ze2) + endif + pdudt(jl,jk) = -ze1 + pdvdt(jl,jk) = -ze2 +! +! Cx =0 based Cx=/= 0. above +! +! + if (knob_ugwp_doheat == 1) then +! +! ek1 =aum(jk)*aum(jk) +avm(jk)*avm(jk) +! ugw = aum(jk)- ze1*dtp; vgw = avm(jk)- ze2*dtp +! ek2 = ugw*ugw +vgw*vgw +! pdtdt(jl,jk) = rdtp2*max(ek1-ek2, 0.0) !=ze1*um + 0.5*ze1^2*dtp +! pdtdt(jl,jk) = max(ze1*aum(jk) + ze2*avm(jk), 0.) ! gw_eff => in "ze1 and ze2" + pdtdt(jl,jk) = max(pdtdt(jl,jk) , 0.)*gw_eff + endif + + if (abs(pdtdt(jl,jk)) >= maxdtdt ) pdtdt(jl,jk) = maxdtdt + ze1 = max(dked_min, pdtdt(jl,jk)/bn2(jk)) + dked(jl,jk) = min(dked_max, ze1) + + enddo +! +! add limiters/efficiency for "unbalanced ics" if it is needed +! + do jk=ksrc,levs + pdtdt(jl,jk) = pdtdt(jl,jk)*rcpd + enddo +! + dktur(1:levs) = dked(jl,1:levs) +! + do ist= 1, 3 + do jk=ksrc,levs-1 + adif(jk) = .25*(dktur(jk-1)+ dktur(jk+1)) + .5*dktur(jk) + enddo + dktur(ksrc:levs-1) = adif(ksrc:levs-1) + enddo + +! dked(jl, ksrc:levs-1) = dktur(ksrc:levs-1) +! dked(jl, levs) =dked(jl, levs-1) + +! +! perform "diffusive" 3-point smoothing of "u-v-t" +! from the surface to the "top" +! + if (knob_ugwp_dokdis == 2) then + + uold(1:levs) = aum(1:levs)+pdudt(jl,1:levs)*dtp + vold(1:levs) = avm(1:levs)+pdvdt(jl,1:levs)*dtp + told(1:levs) = atm(1:levs)+pdtdt(jl,1:levs)*dtp + + do jk=1,levs + zmetk= azmet(jk)*rhp + ktur = kvg(k) + 2.e-5*exp( zmetk) + dktur(jk) = dked(jl,jk) + ktur + enddo + + dzmetm= azmet(ksrc)- azmet(ksrc-1) + + do jk=2,levs-1 + dzmetf = (azmeti(jk+1)- azmeti(jk))*rhomid(jk) + ktur = .5*(dktur(jk-1)+dktur(jk)) *rhoint(jk)/dzmetf + kturp = .5*(dktur(jk+1)+dktur(jk))*rhoint(jk+1)/dzmetf + + dzmetp = azmet(jk+1)-azmet(jk) + Adif(jk) = ktur/dzmetm + Cdif(jk) = kturp/dzmetp + bdif = adif(jk)+cdif(jk) + if (rdtp < bdif ) then + Anstab(jk) = nint( bdif/rdtp + 1) + else + Anstab(jk) = 1 + endif + dzmetm = dzmetp + enddo + + nstab = maxval( Anstab(ksrc:levs-1)) + if (nstab .ge. 2) print *, 'nstab ', nstab + dtdif = dtp/real(nstab) + do ist= 1, nstab + do k=ksrc,levs-1 + Bdif = nstab*rdtp-Adif(k)-Cdif(k) + unew(k) = uold(k)*Bdif+ uold(k-1)*Adif(k) + uold(k)*Cdif(k) + vnew(k) = vold(k)*Bdif+ vold(k-1)*Adif(k) + vold(k)*Cdif(k) + tnew(k) = told(k)*Bdif+ told(k-1)*Adif(k) + told(k)*Cdif(k) + enddo + uold = unew*dtdif + vold = vnew*dtdif + told = tnew*dtdif + enddo +! +! create "smoothed" tendencies by molecular + GW-eddy diffusion +! + do k=ksrc,levs-1 + pdtdt(jl,jk)= rdtp*(told(k) - tm(jl,k)) + ze2 = rdtp*(uold(k) - aum(k)) + ze1 = rdtp*(vold(k) - avm(k)) + if (abs(pdtdt(jl,jk)) >= maxdtdt ) pdtdt(jl,jk) = maxdtdt + if (abs(ze1) >= maxdudt ) then + ze1 = sign(maxdudt, ze1) + endif + if (abs(ze2) >= maxdudt ) then + ze2 = sign(maxdudt, ze2) + endif + pdudt(jl, k) = ze2 + pdvdt(jl, k) = ze1 +! +! add eddy viscosity heating +! pdtdt(jl,jk) = pdtdt(jl,jk) - max(ze1*aum(jk) + ze2*avm(jk), 0.) *rcpd +! + enddo + + + ENDIF ! dissipative IF-loop for "abrupt" tendencies + + enddo ! J-loop +! + + + RETURN + +! +! Print/Debugging ----------------------------------------------------------------------- +! + 239 continue + if (kdt ==1 .and. mpi_id == master) then +! + print *, 'ugwp-vay: nazd-nw-ilaunch=', nazd, nwav,ilaunch, maxval(kvg), ' kvg ' + print *, 'ugwp-vay: zdci(inc)=' , maxval(zdci), minval(zdci) + print *, 'ugwp-vay: zcimax=' , maxval(zci) ,' zcimin=' , minval(zci) +! print *, 'ugwp-vay: tau_ngw=' , maxval(taub_src)*1.e3, minval(taub_src)*1.e3, tau_min + + print * + + endif + + if (kdt == 1 .and. mpi_id == master) then + print *, 'vgw done nstab ', nstab +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax ugwp' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay ugwp' + print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec ugwp' + print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps ugwp' +! +! print *, ' ugwp -heating rates ' + endif + + + + return + end subroutine cires_ugwp_solv2_v1 + + +end module cires_ugwp_solv2_v1_mod diff --git a/physics/cires_ugwp_triggers_v1.F90 b/physics/cires_ugwp_triggers_v1.F90 new file mode 100644 index 000000000..058003b3b --- /dev/null +++ b/physics/cires_ugwp_triggers_v1.F90 @@ -0,0 +1,576 @@ +module cires_ugwp_triggers_v1 + + +contains + + + subroutine ugwp_triggers + implicit none + write(6,*) ' physics-based triggers for UGWP ' + end subroutine ugwp_triggers +! + SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) + use ugwp_common , only : deg_to_rad + + implicit none + integer :: nx, ny + real :: lon(nx), lat(ny) + real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) + real :: rlatc(ny-1), brcos(ny), brcos2(ny) + real :: earth_r, ra1, ra2, dx, dy, dlat + real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) + integer :: j +! +! specify common constants and +! geometric factors to compute deriv-es etc ... +! coriolis coslat tan etc... +! + earth_r = 6370.e3 + ra1 = 1.0 / earth_r + ra2 = ra1*ra1 +! + rlat = lat*deg_to_rad + rlon = lon*deg_to_rad + tanlat = atan(rlat) + cosv = cos(rlat) + dy = rlat(2)-rlat(1) + dx = rlon(2)-rlon(1) +! + do j=1, ny-1 + rlatc(j) = 0.5 * (rlat(j)+rlat(j+1)) + enddo +! + do j=2, ny-1 + brcos(j) = 1.0 / cos(rlat(j))*ra1 + enddo + + brcos(1) = brcos(2) + brcos(ny) = brcos(ny-1) + brcos2 = brcos*brcos +! + dlam1 = brcos / (dx+dx) + dlam2 = brcos2 / (dx*dx) + + dlat = ra1 / (dy+dy) + + divJp = dlat*cosv + divJM = dlat*cosv +! + do j=2, ny-1 + divJp(j) = dlat*cosv(j+1)/cosv(j) + divJM(j) = dlat*cosv(j-1)/cosv(j) + enddo + divJp(1) = divjp(2) !*divjp(1)/divjp(2) + divJp(ny) = divjp(1) + divJM(1) = divjM(2) !*divjM(1)/divjM(2) + divJM(ny) = divjM(1) +! + return + end SUBROUTINE subs_diag_geo +! + subroutine get_xy_pt(V, Vx, Vy, nx, ny, dlam1, dlat) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! compute for each Vert-column: grad(V) +! periodic in X and central diff ... +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + implicit none + integer :: nx, ny + real :: V(nx, ny), dlam1(ny), dlat + real :: Vx(nx, ny), Vy(nx, ny) + integer :: i, j + do i=2, nx-1 + Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) + enddo + Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) + Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) + + do j=2, ny-1 + Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) + enddo + Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) + Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) + + end subroutine get_xy_pt + + subroutine get_xyd_wind( V, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) +! +! compute for each Vert-column: grad(V) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + implicit none + integer :: nx, ny + real :: V(nx, ny), dlam1(ny), dlat + real :: Divjp(ny), Divjm(ny) + real :: Vx(nx, ny), Vy(nx, ny), Vyd(nx, ny) + integer :: i, j + do i=2, nx-1 + Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) + enddo + Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) + Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) + + do j=2, ny-1 + Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) + enddo + Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) + Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) +!~~~~~~~~~~~~~~~~~~~~ +! 1/cos*d(vcos)/dy +!~~~~~~~~~~~~~~~~~~~~ + do j=2, ny-1 + Vyd(:,j) = divJP(j)*V(:,j+1)-V(:, j-1)*divJM(j) + enddo + Vyd(:, 1) = Vyd(:,2) + Vyd(:,ny) = Vyd(:,ny-1) + + end subroutine get_xyd_wind + + subroutine trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS + real, dimension(nx, ny, nz) :: trig3d_fgf +! +! locals +! + real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty + integer :: k, i, j + + real, parameter :: cappa=2./7., pref=1.e5 + real, dimension(nx, ny) :: pt, w1, w2 + + real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) + real :: rlatc(ny-1), brcos(ny), brcos2(ny) + + real :: dx, dy, dlat + real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) + + + call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) + + do k=1, nz + w1(:,:) = P3d(:,:,k) + w2(:,:) = T(:,:,k) + + pt = w2*(pref/w1)**cappa + call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) + w1(:,:) = V(:,:, K) + call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) + w1(:,:) = U(:,:, K) + call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) + + trig3d_fgf(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty + + enddo + end subroutine trig3d_fjets + + subroutine trig3d_okubo( nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_okw) + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS + real, dimension(nx, ny, nz) :: trig3d_okw +! +! locals +! + real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty + integer :: k, i, j + + real, parameter :: cappa=2./7., pref=1.e5 + real, dimension(nx, ny) :: pt, w1, w2, d1 + + real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) + real :: rlatc(ny-1), brcos(ny), brcos2(ny) + + real :: dx, dy, dlat + real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) + + call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) + + do k=1, nz + w1(:,:) = P3d(:,:,k) + w2(:,:) = T(:,:,k) + + pt = w2*(pref/w1)**cappa + call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) + w1(:,:) = V(:,:, K) + call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) + w1(:,:) = U(:,:, K) + call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) + + trig3d_okw(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty + w1 = (Ux -Vy)*(Ux-Vy) + (Vx +Uy)*(Vx+Uy) ! S2 + W2 = (Vx - Uyd)*(Vx - Uyd) + D1 = Ux + Vyd + trig3d_okw(:,:,k) = W1 -W2 +! trig3d_okw(:, :, k) =S2 -W2 +! trig3d_okw(:, :, k) =D1*D1 + 4*(Vx*Uyd -Ux*Vyd) ! ocean +! trig3d_okw(:, :, k) = trig3d_okw(:,:,k) + D1*D1 + 2.*D1*sqrt(abs(W1-W2)) ! S2 =W1Ted-luk + enddo + end subroutine trig3d_okubo +! + subroutine trig3d_dconv(nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_conv, & + dcheat3d, precip2d, cld_klevs2d, scheat3d) + + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS + real, dimension(nx, ny, nz) :: trig3d_conv + + real, dimension(nx, ny, nz) :: dcheat3d, scheat3d + real, dimension(nx, ny ) :: precip2d + integer,dimension(nx, ny, 3 ):: cld_klevs2d + integer :: k + end subroutine trig3d_dconv + + subroutine cires_3d_triggers( nx, ny, nz, lon, lat, pmid, & + U, V, W, T, Q, delp, delz, p3d, PS, HS, Hyam, Hybm, Hyai, Hybi, & + trig3d_okw, trig3d_fgf, trig3d_conv, & + dcheat3d, precip2d, cld_klevs2d, scheat3d) + + implicit none + integer :: nx, ny, nz + real :: lon(nx), lat(ny) +! +! reversed ??? Hyai, Hybi , pmid +! + real, dimension(nz+2) :: Hyai, Hybi + real, dimension(nz+1) :: Hyam, Hybm +! + real, dimension(nz) :: pmid + real, dimension(nx, ny, nz) :: U, V, W, T, Q, delp, delz, p3d + real, dimension(nx, ny ) :: PS, HS + real, dimension(nx, ny, nz) :: trig3d_okw, trig3d_fgf, trig3d_conv + real, dimension(nx, ny, nz) :: dcheat3d, scheat3d + real, dimension(nx, ny ) :: precip2d + integer,dimension(nx, ny, 3 ):: cld_klevs2d + real :: dzkm, zkm + integer :: k +!================================================================================== +! fgf and OW-triggers +! read PRECIP + SH/DC conv heating + cloud-top-bot-middle from "separate" file !!! +! +!=================================================================================== + + call trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) + call trig3d_okubo( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_okw) + call trig3d_dconv(nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_conv, & + dcheat3d, precip2d, cld_klevs2d, scheat3d) +!===================================================================================================== +! output of triggers: trig3d_fgf, trig3d_okw, trig3d_conv, cheat3d, precip2d, cld_klevs2d, scheat3d +! +! Bulk momentum flux=/ 0 and levels for launches +! +!===================================================================================================== + 111 format(i6, 4(3x, F8.3), ' trigger-grid ') + + do k=1, nz-1 + zkm = -7.*alog(pmid(k)*1.e-3) + dzkm = zkm +7.*alog(pmid(k+1)*1.e-3) + write(6,111) k, hybi(k), pmid(k), zkm, dzkm !' triggers ' + enddo + + end subroutine cires_3d_triggers +!================================================================================== +! tot-flux launch 0 or 1 # of Launches +! specify time-dep bulk sources: taub, klev, if_src, nf_src +! +!================================================================================== + subroutine get_spectra_tau_convgw & + (nw, im, levs, dcheat, scheat, precip, icld, xlatd, sinlat, coslat,taub, klev, if_src, nf_src) +! +! temporarily can put GEOS-5/MERRA-2 GW-lat dependent function +! + integer :: nw, im, levs + integer,dimension(im,3) :: icld + real, dimension(im, levs) :: dcheat, scheat + real, dimension(im) :: precip, xlatd, sinlat, coslat + real, dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! +! locals + real, parameter :: precip_max = 100. ! mm/day + real, parameter :: tau_amp = 35.e-3 ! 35 mPa + + integer :: i, k, klow, ktop, kmid + real :: dtot, dmax, daver +! + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + do i=1, im + klow = icld(i,1) + ktop = icld(i,2) + kmid= icld(i,3) + if (klow == -99 .and. ktop == -99) then + cycle + else + klev(i) = ktop + k = klow + klev(i) = k + dmax = abs(dcheat(i,k) + scheat(i,k)) + do k=klow+1, ktop + dtot =abs(dcheat(i,k) + scheat(i,k)) + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo +! +! klev as max( dcheat(i,k) + scheat) +! vertical width of conv-heating +! +! counts/triiger=1 & taub(i) +! + nf_src = nf_src +1 + if_src(i) = 1 + taub(i) = tau_amp* precip(i)/precip_max*coslat(i) + endif + + enddo +! +! 100 mb launch and MERRA-2 slat-forcing +! + call Slat_geos5(im, xlatd, taub) + nf_src =im + do i=1, im + if_src(i) = 1 + klev(i) = 127-45 + enddo + +! with info on precip/clouds/dc_heat create Bulk +! taub(im), klev(im) +! +! print *, ' get_spectra_tau_convgw ' + end subroutine get_spectra_tau_convgw +! + subroutine get_spectra_tau_nstgw(nw, im, levs, trig_fgf, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) + integer :: nw, im, levs + real, dimension(im, levs) :: trig_fgf +! real, dimension(im, levs+1) :: pint + real, dimension(im) :: xlatd, sinlat, coslat + real, dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! locals + real, parameter :: tlim_fgf = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent + real, parameter :: tau_amp = 35.e-3 ! 35 mPa + real, parameter :: pmax = 750.e2, pmin = 100.e2 + integer, parameter :: klow =127-92, ktop=127-45 + integer, parameter :: kwidth = ktop-klow+1 + integer :: i, k, kex + real :: dtot, dmax, daver + real :: fnorm, tau_min + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + fnorm = 1.0 / float(kwidth) + tau_min = tau_amp*fnorm + do i=1, im +! +! only trop-c fjets so find max(trig_fgf) => klev +! use abs-values to scale tau_amp +! + + k = klow + klev(i) = k + dmax = abs(trig_fgf(i,k)) + kex = 0 + if (dmax >= tlim_fgf) kex = kex+1 + do k=klow+1, ktop + dtot = abs(trig_fgf(i,k)) + if (dtot >= tlim_fgf) kex = kex+1 + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo + + if (dmax .ge. tlim_fgf) then + nf_src = nf_src +1 + if_src(i) = 1 + taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) + endif + + enddo +! +! print *, ' get_spectra_tau_nstgw ' + call Slat_geos5(im, xlatd, taub) + nf_src =im + do i=1, im + if_src(i) = 1 + klev(i) = 127-45 + enddo +! + end subroutine get_spectra_tau_nstgw +! + subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) + integer :: nw, im, levs + real, dimension(im, levs) :: trig_okw +! real, dimension(im, levs+1) :: pint + real, dimension(im) :: xlatd, sinlat, coslat + real, dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! locals + real, parameter :: tlim_okw = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent + real, parameter :: tau_amp = 35.e-3 ! 35 mPa + real, parameter :: pmax = 750.e2, pmin = 100.e2 + integer, parameter :: klow =127-92, ktop=127-45 + integer, parameter :: kwidth = ktop-klow+1 + integer :: i, k, kex + real :: dtot, dmax, daver + real :: fnorm, tau_min + + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + fnorm = 1./float(kwidth) + tau_min = tau_amp*fnorm + print *, ' get_spectra_tau_okwgw ' + do i=1, im + k = klow + klev(i) = k + dmax = abs(trig_okw(i,k)) + kex = 0 + if (dmax >= tlim_okw) kex = kex+1 + do k=klow+1, ktop + dtot = abs(trig_okw(i,k)) + if (dtot >= tlim_fgf ) kex = kex+1 + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo +! + if (dmax >= tlim_okw) then + nf_src = nf_src + 1 + if_src(i) = 1 + taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) + endif + + enddo + print *, ' get_spectra_tau_okwgw ' + end subroutine get_spectra_tau_okw +! +! +! +!>\ingroup cires_ugwp_run +!> @{ +!! +!! + subroutine slat_geos5_tamp_v1(im, tau_amp, xlatdeg, tau_gw) +!================= +! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* +!================= + implicit none + integer :: im + real :: tau_amp, xlatdeg(im), tau_gw(im) + real :: latdeg, flat_gw, tem + integer :: i + +! +! if-lat +! + do i=1, im + latdeg = abs(xlatdeg(i)) + if (latdeg < 15.3) then + tem = (latdeg-3.0) / 8.0 + flat_gw = 0.75 * exp(-tem * tem) + if (flat_gw < 1.2 .and. latdeg <= 3.0) flat_gw = 0.75 + elseif (latdeg < 31.0 .and. latdeg >= 15.3) then + flat_gw = 0.10 + elseif (latdeg < 60.0 .and. latdeg >= 31.0) then + tem = (latdeg-60.0) / 23.0 + flat_gw = 0.50 * exp(- tem * tem) + elseif (latdeg >= 60.0) then + tem = (latdeg-60.0) / 70.0 + flat_gw = 0.50 * exp(- tem * tem) + endif + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5_tamp_v1 + + subroutine slat_geos5(im, xlatdeg, tau_gw) +!================= +! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* +!================= + implicit none + integer :: im + real :: xlatdeg(im) + real :: tau_gw(im) + real :: latdeg + real, parameter :: tau_amp = 100.e-3 + real :: trop_gw, flat_gw + integer :: i +! +! if-lat +! + trop_gw = 0.75 + do i=1, im + latdeg = xlatdeg(i) + if (-15.3 < latdeg .and. latdeg < 15.3) then + flat_gw = trop_gw*exp(-( (abs(latdeg)-3.)/8.0)**2) + if (flat_gw < 1.2 .and. abs(latdeg) <= 3.) flat_gw = trop_gw + else if (latdeg > -31. .and. latdeg <= -15.3) then + flat_gw = 0.10 + else if (latdeg < 31. .and. latdeg >= 15.3) then + flat_gw = 0.10 + else if (latdeg > -60. .and. latdeg <= -31.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) + else if (latdeg < 60. .and. latdeg >= 31.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) + else if (latdeg <= -60.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) + else if (latdeg >= 60.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) + end if + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5 + subroutine init_nazdir(naz, xaz, yaz) + use ugwp_common , only : pi2 + implicit none + integer :: naz + real, dimension(naz) :: xaz, yaz + integer :: idir + real :: phic, drad + drad = pi2/float(naz) + if (naz.ne.4) then + do idir =1, naz + Phic = drad*(float(idir)-1.0) + xaz(idir) = cos(Phic) + yaz(idir) = sin(Phic) + enddo + else +! if (naz.eq.4) then + xaz(1) = 1.0 !E + yaz(1) = 0.0 + xaz(2) = 0.0 + yaz(2) = 1.0 !N + xaz(3) =-1.0 !W + yaz(3) = 0.0 + xaz(4) = 0.0 + yaz(4) =-1.0 !S + endif + end subroutine init_nazdir + + +end module cires_ugwp_triggers_v1 + diff --git a/physics/cires_vert_orodis.F90 b/physics/cires_vert_orodis.F90 index 0d3cce194..8b3550500 100644 --- a/physics/cires_vert_orodis.F90 +++ b/physics/cires_vert_orodis.F90 @@ -1,3 +1,9 @@ +module cires_vert_orodis + + +contains + + ! subroutine ugwp_drag_mtb ! subroutine ugwp_taub_oro ! subroutine ugwp_oro_lsatdis @@ -1016,3 +1022,5 @@ subroutine ugwp_tofd1d(levs, sigflt, elvmax, zsurf, zpbl, u, v, & enddo ! end subroutine ugwp_tofd1d + +end module cires_vert_orodis diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 55ef9c268..76c2a85aa 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -186,13 +186,6 @@ end subroutine drag_suite_init !! !> \section det_drag_suite GFS Orographic GWD Scheme Detailed Algorithm !> @{ -! subroutine drag_suite_run( & -! & IM,IX,KM,A,B,C,U1,V1,T1,Q1,KPBL, & -! & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DELTIM,KDT, & -! & HPRIME,OC,OA4,CLX4,THETA,SIGMA,GAMMA,ELVMAX, & -! & DUSFC,DVSFC,G, CP, RD, RV, IMX, & -! & nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, errmsg, errflg) -! subroutine drag_suite_run( & & IM,KM,dvdt,dudt,dtdt,U1,V1,T1,Q1,KPBL, & & PRSI,DEL,PRSL,PRSLK,PHII,PHIL,DELTIM,KDT, & @@ -206,6 +199,7 @@ subroutine drag_suite_run( & & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & & slmsk,br1,hpbl, & & g, cp, rd, rv, fv, pi, imx, cdmbgwd, me, master, & + & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & & lprnt, ipr, rdxzb, dx, gwd_opt, errmsg, errflg ) ! ******************************************************************** @@ -243,6 +237,15 @@ subroutine drag_suite_run( & ! 2017-09-25 Michael Toy (from NCEP GFS model) added dissipation heating ! gsd_diss_ht_opt = 0: dissipation heating off ! gsd_diss_ht_opt = 1: dissipation heating on +! 2020-08-25 Michael Toy changed logic control for drag component selection +! for CCPP. +! Namelist options: +! do_gsl_drag_ls_bl - logical flag for large-scale GWD + blocking +! do_gsl_drag_ss - logical flag for small-scale GWD +! do_gsl_drag_tofd - logical flag for turbulent form drag +! Compile-time options (same as before): +! gwd_opt_ls = 0 or 1: large-scale GWD +! gwd_opt_bl = 0 or 1: blocking drag ! ! References: ! Hong et al. (2008), wea. and forecasting @@ -363,12 +366,16 @@ subroutine drag_suite_run( & !------------------------------------------------------------------------- ! Flags to regulate the activation of specific components of drag suite: ! Each component is tapered off automatically as a function of dx, so best to -! keep them activated (=1). - integer, parameter :: & - gwd_opt_ls = 1, & ! large-scale gravity wave drag - gwd_opt_bl = 1, & ! blocking drag - gwd_opt_ss = 1, & ! small-scale gravity wave drag (Steeneveld et al. 2008) - gwd_opt_fd = 1, & ! form drag (Beljaars et al. 2004, QJRMS) +! keep them activated (.true.). + logical, intent(in) :: & + do_gsl_drag_ls_bl, & ! large-scale gravity wave drag and blocking + do_gsl_drag_ss, & ! small-scale gravity wave drag (Steeneveld et al. 2008) + do_gsl_drag_tofd ! form drag (Beljaars et al. 2004, QJRMS) + +! Additional flags + integer, parameter :: & + gwd_opt_ls = 1, & ! large-scale gravity wave drag + gwd_opt_bl = 1, & ! blocking drag gsd_diss_ht_opt = 0 ! Parameters for bounding the scale-adaptive variability: @@ -616,7 +623,7 @@ subroutine drag_suite_run( & enddo enddo ! - if (gwd_opt == 33) then + if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then do i = its,im dusfc_ls(i) = 0.0 dvsfc_ls(i) = 0.0 @@ -759,7 +766,8 @@ subroutine drag_suite_run( & ! ! END INITIALIZATION; BEGIN GWD CALCULATIONS: ! -IF ( ((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)).and. & +IF ( (do_gsl_drag_ls_bl).and. & + ((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)).and. & (ls_taper .GT. 1.E-02) ) THEN !==== ! !--- saving richardson number in usqj for migwdi @@ -895,7 +903,7 @@ subroutine drag_suite_run( & endif enddo -ENDIF ! (gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1) +ENDIF ! (do_gsl_drag_ls_bl).and.((gwd_opt_ls .EQ. 1).or.(gwd_opt_bl .EQ. 1)) !========================================================= ! add small-scale wavedrag for stable boundary layer @@ -907,7 +915,7 @@ subroutine drag_suite_run( & utendwave=0. vtendwave=0. ! - IF ( (gwd_opt_ss .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN + IF ( (do_gsl_drag_ss).and.(ss_taper.GT.1.E-02) ) THEN ! if (me==master) print *,"in Drag Suite: Running small-scale gravity wave drag" ! ! declaring potential temperature @@ -1008,7 +1016,7 @@ subroutine drag_suite_run( & dvsfc(i) = dvsfc(i) + vtendwave(i,k) * del(i,k) enddo enddo - if (gwd_opt == 33) then + if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then do k = kts,km do i = its,im dusfc_ss(i) = dusfc_ss(i) + utendwave(i,k) * del(i,k) @@ -1019,12 +1027,12 @@ subroutine drag_suite_run( & enddo endif -ENDIF ! end if gwd_opt_ss == 1 +ENDIF ! if (do_gsl_drag_ss) !================================================================ ! Topographic Form Drag from Beljaars et al. (2004, QJRMS, equ. 16): !================================================================ -IF ( (gwd_opt_fd .EQ. 1).and.(ss_taper.GT.1.E-02) ) THEN +IF ( (do_gsl_drag_tofd).and.(ss_taper.GT.1.E-02) ) THEN ! if (me==master) print *,"in Drag Suite: Running form drag" utendform=0. @@ -1066,7 +1074,7 @@ subroutine drag_suite_run( & dvsfc(i) = dvsfc(i) + vtendform(i,k) * del(i,k) enddo enddo - if (gwd_opt == 33) then + if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then do k = kts,km do i = its,im dtaux2d_fd(i,k) = utendform(i,k) @@ -1077,10 +1085,11 @@ subroutine drag_suite_run( & enddo endif -ENDIF ! end if gwd_opt_fd == 1 +ENDIF ! if (do_gsl_drag_tofd) !======================================================= ! More for the large-scale gwd component -IF ( (gwd_opt_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN +IF ( (do_gsl_drag_ls_bl).and. & + (gwd_opt_ls .EQ. 1).and.(ls_taper.GT.1.E-02) ) THEN ! if (me==master) print *,"in Drag Suite: Running large-scale gravity wave drag" ! ! now compute vertical structure of the stress. @@ -1148,7 +1157,8 @@ subroutine drag_suite_run( & !=============================================================== !COMPUTE BLOCKING COMPONENT !=============================================================== -IF ( (gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN +IF ( (do_gsl_drag_ls_bl) .and. & + (gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN ! if (me==master) print *,"in Drag Suite: Running blocking drag" do i = its,im @@ -1194,7 +1204,8 @@ subroutine drag_suite_run( & ENDIF ! end blocking drag !=========================================================== -IF ( (gwd_opt_ls .EQ. 1 .OR. gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN +IF ( (do_gsl_drag_ls_bl) .and. & + (gwd_opt_ls .EQ. 1 .OR. gwd_opt_bl .EQ. 1) .and. (ls_taper .GT. 1.E-02) ) THEN ! ! calculate - (g)*d(tau)/d(pressure) and deceleration terms dtaux, dtauy ! @@ -1264,7 +1275,7 @@ subroutine drag_suite_run( & dvsfc(i) = (-1./g*rcs) * dvsfc(i) enddo - if (gwd_opt == 33) then + if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then do k = kts,km do i = its,im dtaux2d_ls(i,k) = taud_ls(i,k) * xn(i) @@ -1279,9 +1290,9 @@ subroutine drag_suite_run( & enddo endif -ENDIF +ENDIF ! (do_gsl_drag_ls_bl).and.(gwd_opt_ls.EQ.1 .OR. gwd_opt_bl.EQ.1) -if (gwd_opt == 33) then +if ( (gwd_opt == 33).or.(gwd_opt == 22) ) then ! Finalize dusfc and dvsfc diagnostics do i = its,im dusfc_ls(i) = (-1./g*rcs) * dusfc_ls(i) diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index dfcac8582..73a397938 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -590,6 +590,30 @@ type = integer intent = in optional = F +[do_gsl_drag_ls_bl] + standard_name = do_gsl_drag_ls_bl + long_name = flag to activate GSL drag suite - large-scale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ss] + standard_name = do_gsl_drag_ss + long_name = flag to activate GSL drag suite - small-scale GWD + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_tofd] + standard_name = do_gsl_drag_tofd + long_name = flag to activate GSL drag suite - turb orog form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 new file mode 100644 index 000000000..58872057e --- /dev/null +++ b/physics/unified_ugwp.F90 @@ -0,0 +1,686 @@ +!> \file unified_ugwp.F90 +!! This file contains the Unified Gravity Wave Physics (UGWP) scheme by Valery Yudin (University of Colorado, CIRES) +!! See Valery Yudin's presentation at 2017 NGGPS PI meeting: +!! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers +!! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics +!! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. +!! Unified Formalism: +!! 1. GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets). +!! 2. GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources. +!! 3. GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing). +!! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf + +module unified_ugwp + + use machine, only: kind_phys + + use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize + + use cires_ugwp_module_v1, only: cires_ugwp_init_v1, cires_ugwp_finalize, calendar_ugwp + + use gwdps, only: gwdps_run + + use drag_suite, only: drag_suite_run + + use cires_ugwp_orolm97_v1, only: gwdps_oro_v1 + + use cires_ugwp_triggers_v1, only: slat_geos5_tamp_v1 + + ! use cires_ugwp_ngw_utils, only: tau_limb_advance + + use cires_ugwp_solv2_v1_mod, only: cires_ugwp_solv2_v1 + + implicit none + + private + + public unified_ugwp_init, unified_ugwp_run, unified_ugwp_finalize + + logical :: is_initialized = .False. + +contains + +! ------------------------------------------------------------------------ +! CCPP entry points for CIRES Unified Gravity Wave Physics (UGWP) scheme v0 +! ------------------------------------------------------------------------ +!>@brief The subroutine initializes the CIRES UGWP +!> \section arg_table_unified_ugwp_init Argument Table +!! \htmlinclude unified_ugwp_init.html +!! +! ----------------------------------------------------------------------- +! + subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & + pa_rf_in, tau_rf_in, con_p0, do_ugwp, do_ugwp_v0, & + do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, & + do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, & + errmsg, errflg) + +!---- initialization of unified_ugwp + implicit none + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + character(len=*), intent (in) :: input_nml_file(:) + integer, intent (in) :: logunit + integer, intent(in) :: jdat(8) + integer, intent (in) :: lonr + integer, intent (in) :: levs + integer, intent (in) :: latr + real(kind=kind_phys), intent (in) :: ak(:), bk(:) + real(kind=kind_phys), intent (in) :: dtp + real(kind=kind_phys), intent (in) :: cdmbgwd(4), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes + real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in + real(kind=kind_phys), intent (in) :: con_p0 + logical, intent (in) :: do_ugwp + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, & + do_gsl_drag_tofd, do_ugwp_v1, & + do_ugwp_v1_orog_only + + character(len=*), intent (in) :: fn_nml2 + !character(len=*), parameter :: fn_nml='input.nml' + + integer :: ios + logical :: exists + real :: dxsg + integer :: k + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + + ! Test to make sure that at most only one large-scale/blocking + ! orographic drag scheme is chosen + if ( (do_ugwp_v0.and.(do_ugwp_v0_orog_only.or.do_gsl_drag_ls_bl.or. & + do_ugwp_v1.or.do_ugwp_v1_orog_only)) .or. & + (do_ugwp_v0_orog_only.and.(do_gsl_drag_ls_bl.or.do_ugwp_v1.or. & + do_ugwp_v1_orog_only)) .or. & + (do_gsl_drag_ls_bl.and.(do_ugwp_v1.or.do_ugwp_v1_orog_only)) .or. & + (do_ugwp_v1.and.do_ugwp_v1_orog_only) ) then + + write(errmsg,'(*(a))') "Logic error: Only one large-scale& + &/blocking scheme (do_ugwp_v0,do_ugwp_v0_orog_only,& + do_gsl_drag_ls_bl,do_ugwp_v1 or& + &do_ugwp_v1_orog_only) can be chosen" + errflg = 1 + return + + end if + + + if (is_initialized) return + + + if ( do_ugwp_v0 .and. (do_ugwp .or. cdmbgwd(3) > 0.0) ) then + if (do_ugwp .or. cdmbgwd(3) > 0.0) then + call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & + cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + else + write(errmsg,'(*(a))') "Logic error: cires_ugwp_init called but do_ugwp is false and cdmbgwd(3) <= 0" + errflg = 1 + return + end if + + + if ( do_ugwp_v1 ) then + call cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat, & + fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & + cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + end if + + is_initialized = .true. + + end subroutine unified_ugwp_init + + +! ----------------------------------------------------------------------- +! finalize of unified_ugwp (_finalize) +! ----------------------------------------------------------------------- + +!>@brief The subroutine finalizes the CIRES UGWP +#if 0 +!> \section arg_table_unified_ugwp_finalize Argument Table +!! \htmlinclude unified_ugwp_finalize.html +!! +#endif + subroutine unified_ugwp_finalize(errmsg, errflg) + + implicit none +! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + call cires_ugwp_finalize() + + is_initialized = .false. + + end subroutine unified_ugwp_finalize + + +! ----------------------------------------------------------------------- +! originally from ugwp_driver_v0.f +! driver of cires_ugwp (_driver) +! ----------------------------------------------------------------------- +! driver is called after pbl & before chem-parameterizations +! ----------------------------------------------------------------------- +! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re +! ----------------------------------------------------------------------- +!>@brief These subroutines and modules execute the CIRES UGWP Version 0 +!>\defgroup unified_ugwp_run Unified Gravity Wave Physics General Algorithm +!> @{ +!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and background dissipation is represented by the subroutine \ref fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). +!! +!! In UGWP-v0, the specification for the VMF function is adopted from the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran subroutine \ref slat_geos5_tamp describes the latitudinal shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) \cite molod_et_al_2015. It shows that the enhanced values of VMF in the equatorial region gives opportunity to simulate the QBO-like oscillations in the equatorial zonal winds and lead to more realistic simulations of the equatorial dynamics in GEOS-5 operational and MERRA-2 reanalysis products. For the first vertically extended version of FV3GFS in the stratosphere and mesosphere, this simplified function of VMF allows us to tune the model climate and to evaluate multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis products, along with temperature, ozone, and water vapor observations of current satellite missions. After delivery of the UGWP-code, the EMC group developed and tested approach to modulate the zonal mean NGW forcing by 3D-distributions of the total precipitation as a proxy for the excitation of NGWs by convection and the vertically-integrated (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification scores with updated NGW forcing, as reported elsewhere by EMC researchers, display noticeable improvements in the forecast scores produced by FV3GFS configuration extended into the mesosphere. +!! +!> \section arg_table_unified_ugwp_run Argument Table +!! \htmlinclude unified_ugwp_run.html +!! +!> \section gen_unified_ugwp CIRES UGWP Scheme General Algorithm +!! @{ + subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, & + lonr, oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & + do_tofd, ldiag_ugwp, cdmbgwd, jdat, xlat, xlat_d, sinlat, coslat, area, & + ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & + del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & + dudt_mtb,dudt_ogw, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & + dudt, dvdt, dtdt, rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & + rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & + ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & + ldiag3d, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & + do_ugwp_v1_orog_only, errmsg, errflg) + + implicit none + + ! interface variables + integer, intent(in) :: me, master, im, levs, ntrac, kdt, lonr, nmtvr + integer, intent(in) :: gwd_opt + integer, intent(in), dimension(im) :: kpbl + real(kind=kind_phys), intent(in), dimension(im) :: oro, oro_uf, hprime, oc, theta, sigma, gamma + real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss,oa4ss,ol4ss,dx + logical, intent(in) :: flag_for_gwd_generic_tend + ! elvmax is intent(in) for CIRES UGWP, but intent(inout) for GFS GWDPS + real(kind=kind_phys), intent(inout), dimension(im) :: elvmax + real(kind=kind_phys), intent(in), dimension(im, 4) :: clx, oa4 + real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlat_d, sinlat, coslat, area + real(kind=kind_phys), intent(in), dimension(im, levs) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil + real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi, phii + real(kind=kind_phys), intent(in), dimension(im, levs) :: q1 + real(kind=kind_phys), intent(in) :: dtp, fhzero, cdmbgwd(4) + integer, intent(in) :: jdat(8) + logical, intent(in) :: do_tofd, ldiag_ugwp + +!Output (optional): + real(kind=kind_phys), intent(out) :: & + & dusfc_ls(:),dvsfc_ls(:), & + & dusfc_bl(:),dvsfc_bl(:), & + & dusfc_ss(:),dvsfc_ss(:), & + & dusfc_fd(:),dvsfc_fd(:) + real(kind=kind_phys), intent(out) :: & + & dtaux2d_ls(:,:),dtauy2d_ls(:,:), & + & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & + & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & + & dtaux2d_fd(:,:),dtauy2d_fd(:,:) + + real(kind=kind_phys), intent(in) :: br1(im), & + & hpbl(im), & + & slmsk(im) + + real(kind=kind_phys), intent(out), dimension(im) :: dusfcg, dvsfcg + real(kind=kind_phys), intent(out), dimension(im) :: zmtb, zlwb, zogw, rdxzb + real(kind=kind_phys), intent(out), dimension(im) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw + real(kind=kind_phys), intent(out), dimension(im, levs):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis + real(kind=kind_phys), intent(out), dimension(im, levs):: dudt_mtb, dudt_ogw, dudt_tms + + ! These arrays are only allocated if ldiag=.true. + real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw + real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw + logical, intent(in) :: ldiag3d, lssav + + ! These arrays only allocated if ldiag_ugwp = .true. + real(kind=kind_phys), intent(out), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms + + real(kind=kind_phys), intent(inout), dimension(im, levs):: dudt, dvdt, dtdt + + real(kind=kind_phys), intent(in) :: con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt + + real(kind=kind_phys), intent(in), dimension(im) :: rain + + integer, intent(in) :: ntke + real(kind=kind_phys), intent(in), dimension(:,:) :: q_tke, dqdt_tke + + logical, intent(in) :: lprnt + integer, intent(in) :: ipr + + ! flags for choosing combination of GW drag schemes to run + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, & + do_gsl_drag_tofd, do_ugwp_v1, & + do_ugwp_v1_orog_only + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + integer :: i, k + real(kind=kind_phys), dimension(im) :: sgh30 + real(kind=kind_phys), dimension(im, levs) :: Pdvdt, Pdudt + real(kind=kind_phys), dimension(im, levs) :: Pdtdt, Pkdis + real(kind=kind_phys), dimension(im, levs) :: ed_dudt, ed_dvdt, ed_dtdt + ! from ugwp_driver_v0.f -> cires_ugwp_initialize.F90 -> module ugwp_wmsdis_init + real(kind=kind_phys), parameter :: tamp_mpa=30.e-3 + ! switches that activate impact of OGWs and NGWs (WL* how to deal with them? *WL) + real(kind=kind_phys), parameter :: pogw=1., pngw=1., pked=1. + real(kind=kind_phys), parameter :: fw1_tau=1.0 + + real(kind=kind_phys), dimension(:,:), allocatable :: tke + real(kind=kind_phys), dimension(:), allocatable :: turb_fac, tem + real(kind=kind_phys) :: rfac, tx1 + + real(kind=kind_phys) :: inv_g + real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers + real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces + + + ! ugwp_v1 local variables + integer :: y4, month, day, ddd_ugwp, curdate, curday + integer :: hour + real(kind=kind_phys) :: hcurdate, hcurday, fhour, fhrday + integer :: kdtrest + integer :: curday_ugwp + integer :: curday_save=20150101 + logical :: first_qbo=.true. + real :: hcurday_save =20150101.00 + save first_qbo, curday_save, hcurday_save + + + ! ugwp_v1 temporary (local) diagnostic variables from cires_ugwp_solv2_v1 + real(kind=kind_phys) :: tauabs(im,levs), wrms(im,levs), trms(im,levs) + + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! 1) ORO stationary GWs + ! ------------------ + + zlwb(:) = 0. + + ! Run the appropriate large-scale (large-scale GWD + blocking) scheme + ! Note: In case of GSL drag_suite, this includes ss and tofd + + if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then + + call drag_suite_run(im,levs,dvdt,dudt,dtdt,ugrs,vgrs,tgrs,q1, & + kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & + kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ls, & + dtauy2d_ls,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, & + dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfc, & + dvsfc,dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & + slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & + con_fvirt,con_pi,lonr, & + cdmbgwd(1:2),me,master,do_gsl_drag_ls_bl, & + do_gsl_drag_ss,do_gsl_drag_tofd,lprnt,ipr,rdxzb,dx, & + gwd_opt,errmsg,errflg) + + else if ( do_ugwp_v1.or.do_ugwp_v1_orog_only ) then + + ! Valery's TOFD + ! topo paras + ! w/ orographic effects + if(nmtvr == 14)then + ! calculate sgh30 for TOFD + sgh30 = abs(oro - oro_uf) + ! w/o orographic effects + else + sgh30 = 0. + endif + + inv_g = 1./con_g + zmeti = phii*inv_g + zmet = phil*inv_g + + call gwdps_oro_v1 (im, levs, lonr, do_tofd, & + Pdvdt, Pdudt, Pdtdt, Pkdis, & + ugrs , vgrs, tgrs, q1, KPBL, prsi,del,prsl, & + prslk, zmeti, zmet, dtp, kdt, hprime, oc, oa4, & + clx, theta, sigma, gamma, elvmax, & + sgh30, DUSFCg, DVSFCg, xlat_d, sinlat, coslat, & + spgrid,cdmbgwd(1:2), me, master, rdxzb, & + zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & + du3dt_mtb, du3dt_ogw, du3dt_tms) + + else if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then + + do k=1,levs + do i=1,im + Pdvdt(i,k) = 0.0 + Pdudt(i,k) = 0.0 + Pdtdt(i,k) = 0.0 + Pkdis(i,k) = 0.0 + enddo + enddo + + if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then + call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & + ugrs, vgrs, tgrs, q1, & + kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & + hprime, oc, oa4, clx, theta, sigma, gamma, & + elvmax, dusfcg, dvsfcg, & + con_g, con_cp, con_rd, con_rv, lonr, & + nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, & + errmsg, errflg) + if (errflg/=0) return + endif + + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 + if (ldiag_ugwp) then + du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 + end if + + + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then + do k=1,levs + do i=1,im + ldu3dt_ogw(i,k) = ldu3dt_ogw(i,k) + Pdudt(i,k)*dtp + ldv3dt_ogw(i,k) = ldv3dt_ogw(i,k) + Pdvdt(i,k)*dtp + ldt3dt_ogw(i,k) = ldt3dt_ogw(i,k) + Pdtdt(i,k)*dtp + enddo + enddo + endif + + end if + + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Begin non-stationary GW schemes + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! + ! ugwp_v0 non-stationary GW drag + ! + if (do_ugwp_v0) then + + if (cdmbgwd(3) > 0.0) then + + ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing + call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) + + if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then + if (cdmbgwd(4) > 0.0) then + allocate(turb_fac(im)) + do i=1,im + turb_fac(i) = 0.0 + enddo + if (ntke > 0) then + allocate(tke(im,levs)) + allocate(tem(im)) + tke(:,:) = q_tke(:,:) + dqdt_tke(:,:) * dtp + tem(:) = 0.0 + do k=1,(levs+levs)/3 + do i=1,im + turb_fac(i) = turb_fac(i) + del(i,k) * tke(i,k) + tem(i) = tem(i) + del(i,k) + enddo + enddo + do i=1,im + turb_fac(i) = turb_fac(i) / tem(i) + enddo + deallocate(tke) + deallocate(tem) + endif + rfac = 86400000 / dtp + do i=1,im + tx1 = cdmbgwd(4)*min(10.0, max(turb_fac(i),rain(i)*rfac)) + tau_ngw(i) = tau_ngw(i) * max(0.1, min(5.0, tx1)) + enddo + deallocate(turb_fac) + endif + do i=1,im + tau_ngw(i) = tau_ngw(i) * cdmbgwd(3) + enddo + endif + + call fv3_ugwp_solv2_v0(im, levs, dtp, tgrs, ugrs, vgrs, q1, & + prsl, prsi, phil, xlat_d, sinlat, coslat, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + tau_ngw, me, master, kdt) + + do k=1,levs + do i=1,im + gw_dtdt(i,k) = pngw*gw_dtdt(i,k)+ pogw*Pdtdt(i,k) + gw_dudt(i,k) = pngw*gw_dudt(i,k)+ pogw*Pdudt(i,k) + gw_dvdt(i,k) = pngw*gw_dvdt(i,k)+ pogw*Pdvdt(i,k) + gw_kdis(i,k) = pngw*gw_kdis(i,k)+ pogw*Pkdis(i,k) + ! accumulation of tendencies for CCPP to replicate EMC-physics updates (!! removed in latest code commit to VLAB) + !dudt(i,k) = dudt(i,k) +gw_dudt(i,k) + !dvdt(i,k) = dvdt(i,k) +gw_dvdt(i,k) + !dtdt(i,k) = dtdt(i,k) +gw_dtdt(i,k) + enddo + enddo + + else ! .not.(cdmbgwd(3) > 0.0) + + do k=1,levs + do i=1,im + gw_dtdt(i,k) = Pdtdt(i,k) + gw_dudt(i,k) = Pdudt(i,k) + gw_dvdt(i,k) = Pdvdt(i,k) + gw_kdis(i,k) = Pkdis(i,k) + enddo + enddo + + endif ! cdmbgwd(3) > 0.0 + + if (pogw == 0.0) then + tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0. + dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. + endif + +#if 0 + !============================================================================= + ! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving + ! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" + !============================================================================= + ! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies + !------------------------------------------------------------------------------ + do k=1,levs + do i=1,im + ed_dudt(i,k) = 0.0 ; ed_dvdt(i,k) = 0.0 ; ed_dtdt(i,k) = 0.0 + enddo + enddo + + call edmix_ugwp_v0(im, levs, dtp, tgrs, ugrs, vgrs, q1, & + del, prsl, prsi, phil, prslk, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & + ed_dudt, ed_dvdt, ed_dtdt, me, master, kdt) + gw_dtdt = gw_dtdt*(1.-pked) + ed_dtdt*pked + gw_dvdt = gw_dvdt*(1.-pked) + ed_dvdt*pked + gw_dudt = gw_dudt*(1.-pked) + ed_dudt*pked +#endif + + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then + do k=1,levs + do i=1,im + ldu3dt_cgw(i,k) = ldu3dt_cgw(i,k) + (gw_dudt(i,k) - Pdudt(i,k))*dtp + ldv3dt_cgw(i,k) = ldv3dt_cgw(i,k) + (gw_dvdt(i,k) - Pdvdt(i,k))*dtp + ldt3dt_cgw(i,k) = ldt3dt_cgw(i,k) + (gw_dtdt(i,k) - Pdtdt(i,k))*dtp + enddo + enddo + endif + + end if ! do_ugwp_v0 + + + ! + ! ugwp_v1 non-stationary GW drag + ! + if (do_ugwp_v1) then + +! -------- +! 2) non-stationary GWs with GEOS-5/MERRA GW-forcing +! ---------------------------------------------- +!-------- +! GMAO GEOS-5/MERRA GW-forcing lat-dep +!-------- + call slat_geos5_tamp_v1(im, tamp_mpa, xlat_d, tau_ngw) + + y4 = jdat(1); month = jdat(2); day = jdat(3) ; hour = jdat(5) + + ! fhour = float(hour)+float(jdat(6))/60. + float(jdat(7))/3600. + fhour = (kdt-1)*dtp/3600. + fhrday = fhour/24. - nint(fhour/24.) + fhour = fhrday*24. + + call calendar_ugwp(y4, month, day, ddd_ugwp) + curdate = y4*1000 + ddd_ugwp + curday = y4*10000 + month*100 + day + hcurdate = float(curdate) + fhrday + hcurday = float(curday) + fhrday +! + if (mod(fhour,fhzero) == 0 .or. first_qbo) then + + ! call tau_limb_advance(me, master, im, levs, ddd_ugwp, curdate, & + ! j1_tau, j2_tau, ddy_j1tau, ddy_j2tau, tau_sat, kdt ) + + if (first_qbo) kdtrest = kdt + first_qbo = .false. + curday_save = curday + hcurday_save= hcurday + endif + + ! tau_ngw = fw1_tau*tau_ngw + tau_sat*(1.-fw1_tau) + +! goto 111 +! if (mod(fhour,fhzero) == 0 .or. first_qbo) then + +! call tau_qbo_advance(me, master, im, levs, ddd_ugwp, curdate, & +! j1_tau, j2_tau, ddy_j1tau, ddy_j2tau, j1_qbo, j2_qbo, & +! ddy_j1qbo, ddy_j2qbo, tau_sat, tau_qbo, uqbo, ax_qbo, kdt ) + + +! if (me == master) then +! print *, ' curday_save first_qbo ', curday, curday_save, kdt +! print *, ' hcurdays ', hcurdate, float(hour)/24. +! print *, jdat(5), jdat(6), jdat(7), (kdt-1)*dtp/3600., ' calendar ' +!! print *, ' curday curday_ugwp first_qbo ', hcurday, first_qbo +!! print *, ' vay_tau-limb U' , maxval(uqbo), minval(uqbo) +!! print *, ' vay_tau-limb TS' , maxval(tau_sat), minval(tau_sat) +!! print *, ' vay_tau-limb TQ' , maxval(tau_qbo), minval(tau_qbo) +! endif + + +! if (first_qbo) kdtrest = kdt +! first_qbo = .false. +! curday_save = curday +! hcurday_save= hcurday +! endif + + + + +! if (mod(kdt, 720) == 0 .and. me == master ) then +! print *, ' vay_qbo_U' , maxval(uqbo), minval(uqbo) , kdt +! endif + +! wqbo = dtp/taurel +! do k =1, levs +!! sdexpz = wqbo*vert_qbo(k) +! sdexpz = 0.25*vert_qbo(k) +! do i=1, im +!! if (dexpy(i) > 0.0) then +! dforc = 0.25 +!! ugrs(i,k) = ugrs(i,k)*(1.-dforc) + dforc*uqbo(i,levs+1-k) +!! tgrs(i,k) = tgrs(i,k)*(1.-dforc) + dforc*tqbo(i,levs+1-k) +!! endif +! enddo +! enddo + +! 111 continue + + + call cires_ugwp_solv2_v1(im, levs, dtp, & + tgrs, ugrs, vgrs, q1, prsl, prsi, & + zmet, zmeti,prslk, xlat_d, sinlat, coslat, & + gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & + tauabs, wrms, trms, tau_ngw, me, master, kdt) + + if (me == master .and. kdt < 2) then + print * + write(6,*)'FV3GFS finished fv3_ugwp_solv2_v1 in ugwp_driver_v0 ' + write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' + print * + endif + + do k=1,levs + do i=1,im + gw_dtdt(i,k) = pngw*gw_dtdt(i,k) + pogw*Pdtdt(i,k) + gw_dudt(i,k) = pngw*gw_dudt(i,k) + pogw*Pdudt(i,k) + !+(uqbo(i,levs+1-k)-ugrs(i,k))/21600. + gw_dvdt(i,k) = pngw*gw_dvdt(i,k) + pogw*Pdvdt(i,k) + gw_kdis(i,k) = pngw*gw_kdis(i,k) ! + pogw*Pkdis(i,k) + enddo + enddo + + + + + if (pogw == 0.0) then +! zmtb = 0.; zogw =0. + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 + du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 + endif + +! return + +!============================================================================= +! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving +! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" +!============================================================================= +! +! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies +!------------------------------------------------------------------------------ + +! ed_dudt(:,:) = 0.0 ; ed_dvdt(:,:) = 0.0 ; ed_dtdt(:,:) = 0.0 + + + +! call edmix_ugwp_v1(im, levs, dtp, & +! tgrs, ugrs, vgrs, q1, del, & +! prsl, prsi, phil, prslk, & +! gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & +! ed_dudt, ed_dvdt, ed_dTdt, +! me, master, kdt ) + +! do k=1,levs +! do i=1,im +! gw_dtdt(i,k) = gw_dtdt(i,k) + ed_dtdt(i,k)*pked +! gw_dvdt(i,k) = gw_dvdt(i,k) + ed_dvdt(i,k)*pked +! gw_dudt(i,k) = gw_dudt(i,k) + ed_dudt(i,k)*pked +! enddo +! enddo + + + end if ! do_ugwp_v1 + + + end subroutine unified_ugwp_run +!! @} +!>@} +end module unified_ugwp diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta new file mode 100644 index 000000000..5c0eb458b --- /dev/null +++ b/physics/unified_ugwp.meta @@ -0,0 +1,1296 @@ +[ccpp-arg-table] + name = unified_ugwp_init + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for opening namelist file + units = none + dimensions = () + type = integer + intent = in + optional = F +[input_nml_file] + standard_name = namelist_filename_for_internal_file_reads + long_name = character string to store full namelist contents + units = none + dimensions = (number_of_lines_of_namelist_filename_for_internal_file_reads) + type = character + kind = len=* + intent = in + optional = F +[logunit] + standard_name = iounit_log + long_name = fortran unit number for writing logfile + units = none + dimensions = () + type = integer + intent = in + optional = F +[fn_nml2] + standard_name = namelist_filename + long_name = namelist filename for ugwp + units = none + dimensions = () + type = character + kind = len=* + intent = in + optional = F +[lonr] + standard_name = number_of_equatorial_longitude_points + long_name = number of global points in x-dir (i) along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[latr] + standard_name = number_of_latitude_points + long_name = number of global points in y-dir (j) along the meridian + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ak] + standard_name = a_parameter_of_the_hybrid_coordinate + long_name = a parameter for sigma pressure level calculations + units = Pa + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[bk] + standard_name = b_parameter_of_the_hybrid_coordinate + long_name = b parameter for sigma pressure level calculations + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[cdmbgwd] + standard_name = multiplication_factors_for_mountain_blocking_and_orographic_gravity_wave_drag + long_name = multiplication factors for cdmb and gwd + units = none + dimensions = (4) + type = real + kind = kind_phys + intent = in + optional = F +[jdat] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer +[cgwf] + standard_name = multiplication_factors_for_convective_gravity_wave_drag + long_name = multiplication factor for convective GWD + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[pa_rf_in] + standard_name = pressure_cutoff_for_rayleigh_damping + long_name = pressure level from which Rayleigh Damping is applied + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[tau_rf_in] + standard_name = time_scale_for_rayleigh_damping + long_name = time scale for Rayleigh damping in days + units = d + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_p0] + standard_name = standard_atmospheric_pressure + long_name = standard atmospheric pressure + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[do_ugwp] + standard_name = do_ugwp + long_name = flag to activate CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v0] + standard_name = do_ugwp_v0 + long_name = flag to activate ver 0 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v0_orog_only] + standard_name = do_ugwp_v0_orog_only + long_name = flag to activate ver 0 CIRES UGWP - orographic GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ls_bl] + standard_name = do_gsl_drag_ls_bl + long_name = flag to activate GSL drag suite - large-scale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ss] + standard_name = do_gsl_drag_ss + long_name = flag to activate GSL drag suite - small-scale GWD + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_tofd] + standard_name = do_gsl_drag_tofd + long_name = flag to activate GSL drag suite - turb orog form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1] + standard_name = do_ugwp_v1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1_orog_only] + standard_name = do_ugwp_v1_orog_only + long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = unified_ugwp_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = unified_ugwp_run + type = scheme +[do_ugwp] + standard_name = do_ugwp + long_name = flag to activate CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhzero] + standard_name = hours_between_clearing_of_diagnostic_buckets + long_name = hours between clearing of diagnostic buckets + units = h + dimensions = () + type = real + kind = kind_phys +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[lonr] + standard_name = number_of_equatorial_longitude_points + long_name = number of global points in x-dir (i) along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[oro] + standard_name = orography + long_name = orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oro_uf] + standard_name = orography_unfiltered + long_name = unfiltered orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[nmtvr] + standard_name = number_of_statistical_measures_of_subgrid_orography + long_name = number of topographic variables in GWD + units = count + dimensions = () + type = integer + intent = in + optional = F +[oc] + standard_name = convexity_of_subgrid_orography + long_name = convexity of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[theta] + standard_name = angle_from_east_of_maximum_subgrid_orographic_variations + long_name = angle with_respect to east of maximum subgrid orographic variations + units = degree + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = slope_of_subgrid_orography + long_name = slope of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gamma] + standard_name = anisotropy_of_subgrid_orography + long_name = anisotropy of subgrid orography + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[elvmax] + standard_name = maximum_subgrid_orography + long_name = maximum of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtaux2d_ls] + standard_name = x_momentum_tendency_from_large_scale_gwd + long_name = x momentum tendency from large scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_ls] + standard_name = y_momentum_tendency_from_large_scale_gwd + long_name = y momentum tendency from large scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtaux2d_bl] + standard_name = x_momentum_tendency_from_blocking_drag + long_name = x momentum tendency from blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_bl] + standard_name = y_momentum_tendency_from_blocking_drag + long_name = y momentum tendency from blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtaux2d_ss] + standard_name = x_momentum_tendency_from_small_scale_gwd + long_name = x momentum tendency from small scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_ss] + standard_name = y_momentum_tendency_from_small_scale_gwd + long_name = y momentum tendency from small scale gwd + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtaux2d_fd] + standard_name = x_momentum_tendency_from_form_drag + long_name = x momentum tendency from form drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtauy2d_fd] + standard_name = y_momentum_tendency_from_form_drag + long_name = y momentum tendency from form drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[clx] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid orography + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid orography small scale + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oc1ss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid orography small scale + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid orography small scale + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[ol4ss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[do_tofd] + standard_name = turb_oro_form_drag_flag + long_name = flag for turbulent orographic form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag_ugwp] + standard_name = diag_ugwp_flag + long_name = flag for CIRES UGWP Diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cdmbgwd] + standard_name = multiplication_factors_for_mountain_blocking_and_orographic_gravity_wave_drag + long_name = multiplication factors for cdmb and gwd + units = none + dimensions = (4) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = grid latitude + units = radian + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of the grid latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of the grid latitude + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[dusfcg] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfcg] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_ls] + standard_name = integrated_x_momentum_flux_from_large_scale_gwd + long_name = integrated x momentum flux from large scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_ls] + standard_name = integrated_y_momentum_flux_from_large_scale_gwd + long_name = integrated y momentum flux from large scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_bl] + standard_name = integrated_x_momentum_flux_from_blocking_drag + long_name = integrated x momentum flux from blocking drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_bl] + standard_name = integrated_y_momentum_flux_from_blocking_drag + long_name = integrated y momentum flux from blocking drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_ss] + standard_name = integrated_x_momentum_flux_from_small_scale_gwd + long_name = integrated x momentum flux from small scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_ss] + standard_name = integrated_y_momentum_flux_from_small_scale_gwd + long_name = integrated y momentum flux from small scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_fd] + standard_name = integrated_x_momentum_flux_from_form_drag + long_name = integrated x momentum flux from form drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_fd] + standard_name = integrated_y_momentum_flux_from_form_drag + long_name = integrated y momentum flux from form drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[br1] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gw_dudt] + standard_name = tendency_of_x_wind_due_to_ugwp + long_name = zonal wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gw_dvdt] + standard_name = tendency_of_y_wind_due_to_ugwp + long_name = meridional wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gw_dtdt] + standard_name = tendency_of_air_temperature_due_to_ugwp + long_name = air temperature tendency due to UGWP + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[gw_kdis] + standard_name = eddy_mixing_due_to_ugwp + long_name = eddy mixing due to UGWP + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_tofd] + standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = momentum flux or stress due to TOFD + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_mtb] + standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag + long_name = momentum flux or stress due to mountain blocking drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_ogw] + standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = momentum flux or stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_ngw] + standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave + long_name = momentum flux or stress due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zmtb] + standard_name = height_of_mountain_blocking + long_name = height of mountain blocking drag + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zlwb] + standard_name = height_of_low_level_wave_breaking + long_name = height of low level wave breaking + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[zogw] + standard_name = height_of_launch_level_of_orographic_gravity_wave + long_name = height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_mtb] + standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag + long_name = instantaneous change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_ogw] + standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = instantaneous change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_tms] + standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = instantaneous change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[du3dt_mtb] + standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag + long_name = time integral of change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ogw] + standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = time integral of change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_tms] + standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = time integral of change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rdxzb] + standard_name = level_of_dividing_streamline + long_name = level of the dividing streamline + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat !of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rain] + standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total rain at this time step + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ntke] + standard_name = index_for_turbulent_kinetic_energy + long_name = tracer index for turbulent kinetic energy + units = index + dimensions = () + type = integer + intent = in + optional = F +[q_tke] + standard_name = turbulent_kinetic_energy + long_name = turbulent kinetic energy + units = J + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dqdt_tke] + standard_name = tendency_of_turbulent_kinetic_energy_due_to_model_physics + long_name = turbulent kinetic energy tendency due to model physics + units = J s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[ldu3dt_ogw] + standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in x wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldv3dt_ogw] + standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in y wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldt3dt_ogw] + standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag + long_name = cumulative change in temperature due to orographic gravity wave drag + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldu3dt_cgw] + standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag + long_name = cumulative change in x wind due to convective gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldv3dt_cgw] + standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag + long_name = cumulative change in y wind due to convective gravity wave drag + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldt3dt_cgw] + standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag + long_name = cumulative change in temperature due to convective gravity wave drag + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_for_gwd_generic_tend] + standard_name = flag_for_generic_gravity_wave_drag_tendency + long_name = true if GFS_GWD_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v0] + standard_name = do_ugwp_v0 + long_name = flag to activate ver 0 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v0_orog_only] + standard_name = do_ugwp_v0_orog_only + long_name = flag to activate ver 0 CIRES UGWP - orographic GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ls_bl] + standard_name = do_gsl_drag_ls_bl + long_name = flag to activate GSL drag suite - large-scale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ss] + standard_name = do_gsl_drag_ss + long_name = flag to activate GSL drag suite - small-scale GWD + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_tofd] + standard_name = do_gsl_drag_tofd + long_name = flag to activate GSL drag suite - turb orog form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1] + standard_name = do_ugwp_v1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1_orog_only] + standard_name = do_ugwp_v1_orog_only + long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/unified_ugwp_post.F90 b/physics/unified_ugwp_post.F90 new file mode 100644 index 000000000..ac11b4eb1 --- /dev/null +++ b/physics/unified_ugwp_post.F90 @@ -0,0 +1,83 @@ +!> \file unified_ugwp_post.F90 +!! This file contains +module unified_ugwp_post + +contains + +!>\defgroup unified_ugwp_post CIRES UGWP Scheme Post +!! @{ +!> \section arg_table_unified_ugwp_post_init Argument Table +!! + subroutine unified_ugwp_post_init () + end subroutine unified_ugwp_post_init + +!>@brief The subroutine initializes the CIRES UGWP +#if 0 +!> \section arg_table_unified_ugwp_post_run Argument Table +!! \htmlinclude unified_ugwp_post_run.html +!! +#endif + + + subroutine unified_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & + gw_dtdt, gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & + tau_ngw, zmtb, zlwb, zogw, dudt_mtb, dudt_ogw, dudt_tms, & + tot_zmtb, tot_zlwb, tot_zogw, & + tot_tofd, tot_mtb, tot_ogw, tot_ngw, & + du3dt_mtb,du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw, & + dtdt, dudt, dvdt, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! Interface variables + integer, intent(in) :: im, levs + real(kind=kind_phys), intent(in) :: dtf + logical, intent(in) :: ldiag_ugwp !< flag for CIRES UGWP Diagnostics + + real(kind=kind_phys), intent(in), dimension(:) :: zmtb, zlwb, zogw + real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms + real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (ldiag_ugwp) then + tot_zmtb = tot_zmtb + dtf *zmtb + tot_zlwb = tot_zlwb + dtf *zlwb + tot_zogw = tot_zogw + dtf *zogw + + tot_tofd = tot_tofd + dtf *tau_tofd + tot_mtb = tot_mtb + dtf *tau_mtb + tot_ogw = tot_ogw + dtf *tau_ogw + tot_ngw = tot_ngw + dtf *tau_ngw + + du3dt_mtb = du3dt_mtb + dtf *dudt_mtb + du3dt_tms = du3dt_tms + dtf *dudt_tms + du3dt_ogw = du3dt_ogw + dtf *dudt_ogw + du3dt_ngw = du3dt_ngw + dtf *gw_dudt + dv3dt_ngw = dv3dt_ngw + dtf *gw_dvdt + endif + + dtdt = dtdt + gw_dtdt + dudt = dudt + gw_dudt + dvdt = dvdt + gw_dvdt + + end subroutine unified_ugwp_post_run + +!> \section arg_table_unified_ugwp_post_finalize Argument Table +!! + subroutine unified_ugwp_post_finalize () + end subroutine unified_ugwp_post_finalize + +!! @} +end module unified_ugwp_post diff --git a/physics/unified_ugwp_post.meta b/physics/unified_ugwp_post.meta new file mode 100644 index 000000000..807584e94 --- /dev/null +++ b/physics/unified_ugwp_post.meta @@ -0,0 +1,315 @@ +[ccpp-arg-table] + name = unified_ugwp_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = unified_ugwp_post_run + type = scheme +[ldiag_ugwp] + standard_name = diag_ugwp_flag + long_name = flag for CIRES UGWP Diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[gw_dtdt] + standard_name = tendency_of_air_temperature_due_to_ugwp + long_name = air temperature tendency due to UGWP + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gw_dudt] + standard_name = tendency_of_x_wind_due_to_ugwp + long_name = zonal wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gw_dvdt] + standard_name = tendency_of_y_wind_due_to_ugwp + long_name = meridional wind tendency due to UGWP + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_tofd] + standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = momentum flux or stress due to TOFD + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_mtb] + standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag + long_name = momentum flux or stress due to mountain blocking drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_ogw] + standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = momentum flux or stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_ngw] + standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave + long_name = momentum flux or stress due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zmtb] + standard_name = height_of_mountain_blocking + long_name = height of mountain blocking drag + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zlwb] + standard_name = height_of_low_level_wave_breaking + long_name = height of low level wave breaking + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zogw] + standard_name = height_of_launch_level_of_orographic_gravity_wave + long_name = height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_mtb] + standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag + long_name = instantaneous change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_ogw] + standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = instantaneous change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_tms] + standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = instantaneous change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tot_zmtb] + standard_name = time_integral_of_height_of_mountain_blocking + long_name = time integral of height of mountain blocking drag + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_zlwb] + standard_name = time_integral_of_height_of_low_level_wave_breaking + long_name = time integral of height of drag due to low level wave breaking + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_zogw] + standard_name = time_integral_of_height_of_launch_level_of_orographic_gravity_wave + long_name = time integral of height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_tofd] + standard_name = time_integral_of_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = time integral of momentum flux due to TOFD + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_mtb] + standard_name = time_integral_of_momentum_flux_due_to_mountain_blocking_drag + long_name = time integral of momentum flux due to mountain blocking drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_ogw] + standard_name = time_integral_of_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = time integral of momentum flux due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_ngw] + standard_name = time_integral_of_momentum_flux_due_to_nonstationary_gravity_wave + long_name = time integral of momentum flux due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_mtb] + standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag + long_name = time integral of change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ogw] + standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = time integral of change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_tms] + standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = time integral of change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ngw] + standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave + long_name = time integral of change in x wind due to NGW + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt_ngw] + standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave + long_name = time integral of change in y wind due to NGW + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = unified_ugwp_post_finalize + type = scheme From 3a727b952107b6d27d4ebf129dcd75a0b627c189 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Fri, 4 Sep 2020 03:02:17 +0000 Subject: [PATCH 046/274] 2nd try -- Sept. 3 -- two scheme test --- physics/cires_orowam2017.F90 | 28 +- physics/cires_ugwp_initialize_v1.F90 | 54 +- physics/cires_ugwp_module_v1.F90 | 22 +- physics/cires_ugwp_orolm97_v1.F90 | 21 +- physics/cires_ugwp_solv2_v1_mod.F90 | 8 +- physics/cires_ugwp_triggers_v1.F90 | 4 +- physics/cires_vert_orodis.F90 | 8 - physics/cires_vert_orodis_v1.F90 | 1026 ++++++++++++++++++++++++++ physics/unified_ugwp.F90 | 12 +- 9 files changed, 1105 insertions(+), 78 deletions(-) create mode 100644 physics/cires_vert_orodis_v1.F90 diff --git a/physics/cires_orowam2017.F90 b/physics/cires_orowam2017.F90 index 752c6f84e..d5568bb9d 100644 --- a/physics/cires_orowam2017.F90 +++ b/physics/cires_orowam2017.F90 @@ -4,13 +4,13 @@ module cires_orowam2017 contains - subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, - & dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, - & del, sigma, hprime, gamma, theta, + subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, & + & dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, & + & del, sigma, hprime, gamma, theta, & & sinlat, xlatd, taup, taud, pkdis) ! USE MACHINE , ONLY : kind_phys - use ugwp_common , only : grav, omega2 + use ugwp_common_v1 , only : grav, omega2 ! implicit none @@ -22,12 +22,12 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, real(kind=kind_phys), intent(in) :: taub(im) real(kind=kind_phys), intent(in) :: sinlat(im), xlatd(im) - real(kind=kind_phys), intent(in), dimension(im) :: sigma, + real(kind=kind_phys), intent(in), dimension(im) :: sigma, & & hprime, gamma, theta real(kind=kind_phys), intent(in), dimension(im) :: xn, yn - real(kind=kind_phys), intent(in), dimension(im, levs) :: + real(kind=kind_phys), intent(in), dimension(im, levs) :: & & u1, v1, t1, bn2, rho, prsl, del real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi @@ -102,8 +102,8 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, if (kdt == 1) then 771 format( 'vay-oro19 ', 3(2x,F8.3)) - write(6,771) - & maxval(tau_kx)*maxval(taub)*1.e3, + write(6,771) & + & maxval(tau_kx)*maxval(taub)*1.e3, & & minval(tau_kx), maxval(tau_kx) endif ! @@ -127,9 +127,9 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, taub_kx(1:nw) = tau_kx(1:nw) * taub(i) wkdis(:,:) = kedmin - call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), - & prsi(j,:), prsL(j,:), del(j,:), rho(i,:), - & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, + call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), & + & prsi(j,:), prsL(j,:), del(j,:), rho(i,:), & + & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, & & xn(i), yn(i)) fcor2 = (omega2*sinlat(j))*(omega2*sinlat(j))*fc_flag @@ -242,7 +242,7 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, wrms(iw,k) = etwk tauk = etwk*kxw/kzw tau_sp(iw,k) = tauk *rhoint - if ( tau_sp(iw,k) > tau_sp(iw,k-1)) + if ( tau_sp(iw,k) > tau_sp(iw,k-1)) & & tau_sp(iw,k) = tau_sp(iw,k-1) ENDIF ! upward @@ -281,10 +281,10 @@ end subroutine oro_wam_2017 ! define mean flow and dissipation for OGW-kx spectrum ! !------------------------------------------------------------- - subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, + subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) - use ugwp_common , only : grav, rgrav, rdi, velmin, dw2min + use ugwp_common_v1 , only : grav, rgrav, rdi, velmin, dw2min implicit none integer :: nz, nzi diff --git a/physics/cires_ugwp_initialize_v1.F90 b/physics/cires_ugwp_initialize_v1.F90 index eef5cc04e..174a871d1 100644 --- a/physics/cires_ugwp_initialize_v1.F90 +++ b/physics/cires_ugwp_initialize_v1.F90 @@ -10,7 +10,7 @@ ! ! - module ugwp_common + module ugwp_common_v1 ! ! use machine, only : kind_phys ! use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & @@ -46,7 +46,7 @@ module ugwp_common real, parameter :: mkzmin = pi2/80.0e3, mkz2min = mkzmin*mkzmin real, parameter :: mkzmax = pi2/500., mkz2max = mkzmax*mkzmax real, parameter :: cdmin = 2.e-2/mkzmax - end module ugwp_common + end module ugwp_common_v1 ! ! !=================================================== @@ -56,7 +56,7 @@ end module ugwp_common !=================================================== subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) - use ugwp_common, only : pih + use ugwp_common_v1, only : pih implicit none @@ -178,13 +178,13 @@ end subroutine rf_damp_init ! wave sources ! ======================================================================== ! -! ugwp_oro_init +! ugwp_oro_init_v1 ! !========================================================================= - module ugwp_oro_init + module ugwp_oro_init_v1 - use ugwp_common, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi - use ugwp_common, only : mkzmin, mkz2min + use ugwp_common_v1, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi + use ugwp_common_v1, only : mkzmin, mkz2min implicit none ! ! constants and "crirtical" values to run oro-mtb_gw physics @@ -281,7 +281,7 @@ subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & real, parameter :: lonr_refmb = 4.0 * 192.0 real, parameter :: lonr_refgw = 192.0 -! copy to "ugwp_oro_init" => nwaves, nazdir, nstoch +! copy to "ugwp_oro_init_v1" => nwaves, nazdir, nstoch nworo = nwaves nazoro = nazdir @@ -306,13 +306,13 @@ subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & end subroutine init_oro_gws ! - end module ugwp_oro_init + end module ugwp_oro_init_v1 ! ========================================================================= ! -! ugwp_conv_init +! ugwp_conv_init_v1 ! !========================================================================= - module ugwp_conv_init + module ugwp_conv_init_v1 implicit none real :: eff_con ! scale factors for conv GWs @@ -336,7 +336,7 @@ module ugwp_conv_init ! subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & lonr, kxw, cgwf) - use ugwp_common, only : pi2, arad + use ugwp_common_v1, only : pi2, arad implicit none integer :: nwaves, nazdir, nstoch @@ -382,14 +382,14 @@ subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & end subroutine init_conv_gws - end module ugwp_conv_init + end module ugwp_conv_init_v1 !========================================================================= ! -! ugwp_fjet_init +! ugwp_fjet_init_v1 ! !========================================================================= - module ugwp_fjet_init + module ugwp_fjet_init_v1 implicit none real :: eff_fj ! scale factors for conv GWs integer :: nwfj ! number of waves @@ -406,7 +406,7 @@ module ugwp_fjet_init real, allocatable :: xaz_fjet(:), yaz_fjet(:) contains subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) - use ugwp_common, only : pi2, arad + use ugwp_common_v1, only : pi2, arad implicit none integer :: nwaves, nazdir, nstoch @@ -435,12 +435,12 @@ subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) end subroutine init_fjet_gws - end module ugwp_fjet_init + end module ugwp_fjet_init_v1 ! !========================================================================= ! ! - module ugwp_okw_init + module ugwp_okw_init_v1 !========================================================================= implicit none @@ -461,7 +461,7 @@ module ugwp_okw_init ! subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) - use ugwp_common, only : pi2, arad + use ugwp_common_v1, only : pi2, arad implicit none integer :: nwaves, nazdir, nstoch @@ -490,7 +490,7 @@ subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) end subroutine init_okw_gws - end module ugwp_okw_init + end module ugwp_okw_init_v1 !=============================== end of GW sources ! @@ -501,7 +501,7 @@ end module ugwp_okw_init ! Part -3 init wave solvers !=============================== - module ugwp_lsatdis_init + module ugwp_lsatdis_init_v1 implicit none integer :: nwav, nazd @@ -543,14 +543,14 @@ subroutine initsolv_lsatdis(me, master, nwaves, nazdir, nstoch, effac, do_physb ! end subroutine initsolv_lsatdis ! - end module ugwp_lsatdis_init + end module ugwp_lsatdis_init_v1 ! ! - module ugwp_wmsdis_init + module ugwp_wmsdis_init_v1 - use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, omega2 - use ugwp_common, only : bnv2max, bnv2min, minvel - use ugwp_common, only : mkzmin, mkz2min, mkzmax, mkz2max, cdmin + use ugwp_common_v1, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, omega2 + use ugwp_common_v1, only : bnv2max, bnv2min, minvel + use ugwp_common_v1, only : mkzmin, mkz2min, mkzmax, mkz2max, cdmin implicit none real, parameter :: maxdudt = 250.e-5, maxdtdt=15.e-2 @@ -782,7 +782,7 @@ end subroutine initsolv_wmsdis ! make a list of all-initilized parameters needed for "gw_solver_wmsdis" ! - end module ugwp_wmsdis_init + end module ugwp_wmsdis_init_v1 !========================================================================= ! ! work TODO for 2-extra WAM-solvers: diff --git a/physics/cires_ugwp_module_v1.F90 b/physics/cires_ugwp_module_v1.F90 index ecc00ecfb..dc586c6bd 100644 --- a/physics/cires_ugwp_module_v1.F90 +++ b/physics/cires_ugwp_module_v1.F90 @@ -9,7 +9,7 @@ module cires_ugwp_module_v1 !................................................................................... ! ! - use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4 + use ugwp_common_v1, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4 implicit none logical :: module_is_initialized !logical :: do_ugwp = .false. ! control => true - ugwp false old gws + rayeleigh friction @@ -176,18 +176,18 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & ! ! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 ! - ! use netcdf - use ugwp_oro_init, only : init_oro_gws - use ugwp_conv_init, only : init_conv_gws - use ugwp_fjet_init, only : init_fjet_gws - use ugwp_okw_init, only : init_okw_gws - use ugwp_wmsdis_init, only : initsolv_wmsdis + use netcdf + use ugwp_oro_init_v1, only : init_oro_gws + use ugwp_conv_init_v1, only : init_conv_gws + use ugwp_fjet_init_v1, only : init_fjet_gws + use ugwp_okw_init_v1, only : init_okw_gws + use ugwp_wmsdis_init_v1, only : initsolv_wmsdis - use ugwp_lsatdis_init, only : initsolv_lsatdis + use ugwp_lsatdis_init_v1, only : initsolv_lsatdis - use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar - use ugwp_wmsdis_init, only : tau_min, tamp_mpa + use ugwp_wmsdis_init_v1, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar + use ugwp_wmsdis_init_v1, only : tau_min, tamp_mpa implicit none integer, intent (in) :: me @@ -322,7 +322,7 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & IF (do_physb_gwsrcs) THEN - if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init ' + if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init_v1 ' if (knob_ugwp_wvspec(4) > 0) then ! okw call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & diff --git a/physics/cires_ugwp_orolm97_v1.F90 b/physics/cires_ugwp_orolm97_v1.F90 index 1a6cedcb3..e6c3a1ea0 100644 --- a/physics/cires_ugwp_orolm97_v1.F90 +++ b/physics/cires_ugwp_orolm97_v1.F90 @@ -8,7 +8,7 @@ module cires_ugwp_orolm97_v1 subroutine gwdps_oro_v1(im, km, imx, do_tofd, & pdvdt, pdudt, pdtdt, pkdis, u1,v1,t1,q1,kpbl, & prsi,del,prsl,prslk, zmeti, zmet, dtp, kdt, hprime, & - oc, oa4, clx4, theta, sigma, gamma, elvmaxd, sgh30, & + oc, oa4, clx4, theta, sigmad, gammad, elvmaxd, sgh30, & dusfc, dvsfc, xlatd, sinlat, coslat, sparea, & cdmbgwd, me, master, rdxzb, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & @@ -23,12 +23,12 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & !---------------------------------------- use machine , only : kind_phys - use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2, & + use ugwp_common_v1, only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2, & pi, rad_to_deg, deg_to_rad, pi2, & rdi, gor, grcp, gocp, fv, gr2, & bnv2min, dw2min, velmin, arad - use ugwp_oro_init, only : rimin, ric, efmin, efmax , & + use ugwp_oro_init_v1, only : rimin, ric, efmin, efmax , & hpmax, hpmin, sigfaci => sigfac , & dpmin, minwnd, hminmt, hncrit , & rlolev, gmax, veleps, factop , & @@ -37,11 +37,11 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & cdmb, cleff, fcrit_gfs, fcrit_mtb, & n_tofd, ze_tofd, ztop_tofd - use cires_ugwp_module, only : kxw, max_kdis, max_axyz + use cires_ugwp_module_v1, only : kxw, max_kdis, max_axyz use cires_orowam2017, only : oro_wam_2017 - use cires_vert_orodis, only : ugwp_tofd1d + use cires_vert_orodis_v1, only : ugwp_tofd1d ! use sso_coorde, only : pgwd, pgwd4 @@ -67,8 +67,8 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & real(kind=kind_phys), intent(in) :: cdmbgwd(2) real(kind=kind_phys), intent(in) :: hprime(im), oc(im), oa4(im,4), & - clx4(im,4), theta(im), sigma(im), & - gamma(im), elvmaxd(im) + clx4(im,4), theta(im), sigmad(im), & + gammad(im), elvmaxd(im) real(kind=kind_phys), intent(in) :: sgh30(im) real(kind=kind_phys), intent(in), dimension(im,km) :: & @@ -118,7 +118,8 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & real(kind=kind_phys), dimension(im,km) :: ri_n, bnv2, ro real(kind=kind_phys), dimension(im,km) :: vtk, vtj, velco !mtb - real(kind=kind_phys), dimension(im) :: oa, clx , elvmax, wk + real(kind=kind_phys), dimension(im) :: oa, clx , sigma, gamma, & + elvmax, wk real(kind=kind_phys), dimension(im) :: pe, ek, up real(kind=kind_phys), dimension(im,km) :: db, ang, uds @@ -174,6 +175,10 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & integer :: k_mtb, k_zlow, ktrial, klevm1 integer :: i, j, k ! +! initialize gamma and sigma + gamma(:) = gammad(:) + sigma(:) = sigmad(:) +! rcpdt = 1.0 / (cpd*dtp) grav2 = grav + grav ! diff --git a/physics/cires_ugwp_solv2_v1_mod.F90 b/physics/cires_ugwp_solv2_v1_mod.F90 index ec2ec7bf2..c84028199 100644 --- a/physics/cires_ugwp_solv2_v1_mod.F90 +++ b/physics/cires_ugwp_solv2_v1_mod.F90 @@ -26,18 +26,18 @@ subroutine cires_ugwp_solv2_v1(im, levs, dtp , & use machine, only : kind_phys - use cires_ugwp_module,only : krad, kvg, kion, ktg + use cires_ugwp_module_v1,only : krad, kvg, kion, ktg - use cires_ugwp_module,only : knob_ugwp_doheat, knob_ugwp_dokdis, idebug_gwrms + use cires_ugwp_module_v1,only : knob_ugwp_doheat, knob_ugwp_dokdis, idebug_gwrms - use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpdl, grav2cpd, & + use ugwp_common_v1 , only : rgrav, grav, cpd, rd, rv, rcpdl, grav2cpd, & omega2, rcpd, rcpd2, pi, pi2, fv, & rad_to_deg, deg_to_rad, & rdi, gor, grcp, gocp, & bnv2min, bnv2max, dw2min, velmin, gr2, & hpscale, rhp, rh4, grav2, rgrav2, mkzmin, mkz2min ! - use ugwp_wmsdis_init, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & + use ugwp_wmsdis_init_v1, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & maxdudt, gw_eff, dked_min, dked_max, maxdtdt, & nslope, ilaunch, zms, & zci, zdci, zci4, zci3, zci2, & diff --git a/physics/cires_ugwp_triggers_v1.F90 b/physics/cires_ugwp_triggers_v1.F90 index 058003b3b..44911e1d5 100644 --- a/physics/cires_ugwp_triggers_v1.F90 +++ b/physics/cires_ugwp_triggers_v1.F90 @@ -11,7 +11,7 @@ end subroutine ugwp_triggers ! SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - use ugwp_common , only : deg_to_rad + use ugwp_common_v1 , only : deg_to_rad implicit none integer :: nx, ny @@ -545,7 +545,7 @@ subroutine slat_geos5(im, xlatdeg, tau_gw) ! end subroutine slat_geos5 subroutine init_nazdir(naz, xaz, yaz) - use ugwp_common , only : pi2 + use ugwp_common_v1 , only : pi2 implicit none integer :: naz real, dimension(naz) :: xaz, yaz diff --git a/physics/cires_vert_orodis.F90 b/physics/cires_vert_orodis.F90 index 8b3550500..0d3cce194 100644 --- a/physics/cires_vert_orodis.F90 +++ b/physics/cires_vert_orodis.F90 @@ -1,9 +1,3 @@ -module cires_vert_orodis - - -contains - - ! subroutine ugwp_drag_mtb ! subroutine ugwp_taub_oro ! subroutine ugwp_oro_lsatdis @@ -1022,5 +1016,3 @@ subroutine ugwp_tofd1d(levs, sigflt, elvmax, zsurf, zpbl, u, v, & enddo ! end subroutine ugwp_tofd1d - -end module cires_vert_orodis diff --git a/physics/cires_vert_orodis_v1.F90 b/physics/cires_vert_orodis_v1.F90 new file mode 100644 index 000000000..c328a3fb6 --- /dev/null +++ b/physics/cires_vert_orodis_v1.F90 @@ -0,0 +1,1026 @@ +module cires_vert_orodis_v1 + + +contains + + +! subroutine ugwp_drag_mtb +! subroutine ugwp_taub_oro +! subroutine ugwp_oro_lsatdis +! + subroutine ugwp_drag_mtb( iemax, nz, & + elvpd, elvp, hprime , sigma, theta, oc, oa4, clx4, gam, zpbl, & + up, vp, tp, qp, dp, zpm, zpi, pmid, pint, idxzb, drmtb,taumtb) + + use ugwp_common_v1, only : bnv2min, grav, grcp, fv, rad_to_deg, dw2min, velmin, rdi + use ugwp_oro_init_v1, only : nridge, cdmb, fcrit_mtb, frmax, frmin, strver + + implicit none +!======================== +! several versions for drmtb => high froude mountain blocking +! version 1 => vay_2018 ; +! version 2 => kdn_2005 ; Kim & Doyle in NRL-2005 +! version 3 => ncep/gfs-2017 -gfs_2017 with lm1997 +!======================== +! real, parameter :: Fcrit_mtb = 0.7 + + integer, intent(in) :: nz + integer, intent(in) :: iemax ! standard ktop z=elvpd + 4 * hprime + real , intent(out) :: taumtb + + integer , intent(out) :: idxzb + real, dimension(nz), intent(out) :: drmtb + + real, intent(in) :: elvp, elvpd !elvp = min (elvpd + sigfac * hprime(j), hncrit=10000meters) + real, intent(in) :: hprime , sigma, theta, oc, oa4(4), clx4(4), gam + real, intent(in) :: zpbl + + real, dimension(nz), intent(in) :: up, vp, tp, qp, dp, zpm, pmid + real, dimension(nz+1), intent(in) :: zpi, pint +! + real, dimension(nz+1) :: zpi_zero + real, dimension(nz) :: zpm_zero + real :: vtj, rhok, bnv2, rdz, vtkp, vtk, dzp + + real, dimension(nz) :: bn2, uds, umf, cosang, sinang + + integer :: k, klow, ktop, kpbl + real :: uhm, vhm, bn2hm, rhohm, & + mtb_fix, umag, bnmag, frd_src, & + zblk, who_iz_normal, rlm97, & + phiang, ang, pe, ek, & + cang, sang, ss2, cs2, zlen, dbtmp, & + hamp, bgamm, cgamm + +!================================================== +! +! elvp + hprime <=>elvp + nridge*hprime, ns =2 +! ns = sigfac +! tau_parel & tau_normal along major "axes" +! +! options to block the "flow", choices for [klow, ktop] +! +! 1-directional (normal) & 2-directional "blocking" +! +!================================================== +! no - blocking: drmtb(1:nz) = 0.0 +!================= + idxzb = -1 + drmtb(1:nz) = 0.0 + taumtb = 0.0 + klow = 2 + + ktop = iemax + hamp = nridge*hprime + +! reminder: cdmb = 4.0 * 192.0/float(imx)*cdmbgwd(1) Lellipse= a/2=sigma/hprime + + mtb_fix = cdmb*sigma/hamp !hamp ~ 2*hprime and 1/sigfac = 0.25 is inside 1/hamp + + if (mtb_fix == 0.) then + print *, cdmb, sigma, hamp + print *, ' MTB == 0' + stop + endif + + if (strver == 'vay_2018') then + + zpm_zero = zpm - zpi(1) + zpi_zero = zpi - zpi(1) + + do k=1, nz-1 + if (hamp .le. zpi_zero(k+1) .and. (hamp .gt. zpi_zero(k) ) ) then + ktop = k+1 !......simply k+1 next interface level + exit + endif + enddo +! print *, klow, ktop, ' klow-ktop ' + call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + bn2, uhm, vhm, bn2hm, rhohm) + + umag = max(sqrt(uhm*uhm + vhm*vhm), velmin) !velmin=dw2min =1.0 m/s + if (bn2hm .le. 0.0) then + print *, ' unstable MF for MTB -RETURN ' + RETURN ! unstable PBL + endif + bnmag =sqrt(bn2hm) + + frd_src = min(hamp*bnmag/umag, frmax) ! frmax =10. + +! print *, frd_src, Fcrit_mtb/frd_src, ' no-Blocking > 1 ' +! + if ( frd_src .le. Fcrit_mtb) RETURN ! no-blocking, although on small ridges with weak winds can be blocking +! +! zblk > 0 +! Fcrit_mtb > Fcrit_ogw h_clip = Fr_mtb*U/N ! h_hill minus h_clip = zblk +! + zblk = hamp*(1. - Fcrit_mtb/frd_src) + idxzb =1 + do k = 2, ktop + + if ( zblk < zpm_zero(k) .and. zblk >= zpm_zero(k-1)) then + idxzb = k + exit + endif + enddo +! + if (idxzb == 1) RETURN ! first surface level block is not "important" + + if (idxzb > 1) then ! let start with idxzb = 2....and up with LM1997 +! +! several options to compute MTB-drag: a) IFS_1997 ; b) WRF_KD05 ; c) SJM_2000 +! + bgamm = 1.0 - 0.18*gam -0.04*gam*gam + cgamm = 0.48*gam +0.3*gam*gam + + do k = 1, idxzb-1 + zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) + + umag = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) + + phiang = atan(vp(k)/umag) +! theta -90/90 + ang = theta - phiang + cang = cos(ang) ; sang = sin(ang) + + who_iz_normal = max(cang, gam*sang ) !gfs-2018 + + cs2 = cang* cang ; ss2 = 1.-cs2 + + rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! ... (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it +! + if (rlm97 > 2.0 ) rlm97 = 2.0 ! zero mtb-friction at this level +! + + who_iz_normal = bgamm*cs2 + cgamm*ss2 ! LM1997/IFS + + dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal + if (dbtmp < 0) dbtmp = 0.0 +! +! several approximation can be made to implement MTB-drag +! as a "nonlinear level dependent"-drag or "constant"-drag +! uds(k) == umag = const between the 1-layer and idxzb +! + + drmtb(k) = dbtmp * abs(umag) ! full mtb-drag = -drmtb(k) * uds = -kr*u + taumtb = taumtb - drmtb(k)*umag *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) +! +! 2-wave appr for anisotropic drmtb_Bellipse(k) and drmtb_Aell(k) can be used +! with Umag-projections on A & B ellipse axes +! mtb_fix =0.25*cdmb*sigma/hprime, +! in SM-2000 mtb_fix~ 1/8*[cdmb_A, cdmb_B]*sigma/hprimesum ( A+B) = 1/4. +! +!333 format(i4, 7(2x, F10.3)) +! write(6,333) , k, zpm_zero(k), zblk, hamp*Fcrit_mtb/frd_src, taumtb*1.e3, drmtb(k) , -drmtb(k)*up(k)*1.e5 + enddo +! + endif + endif ! strver=='vay_2018' +! +! +! + if (strver == 'kdn_2005' .or. strver == 'wrf_2018' ) then + + print *, ' kdn_2005 with # of hills ' +! +! compute flow-blocking stress based on WRF 'gwdo2d' +! + endif +! +! + if (strver == 'gfs_2018') then + + ktop = iemax; klow = 2 + + call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + bn2, uhm, vhm, bn2hm, rhohm) + if (bn2hm <= 0.0) RETURN ! unstable PBL +!--------------------------------------------- +! +!'gfs_2018' .... does not rely on Fr_crit +! and Fr-regimes +!----gfs17 for mtn ignores "averaging of the flow" +! for MTB-part it is only works with "angles" +! no projections on [uhm, vhm] -direction +! kpbl can be used for getting high values of iemax-hill +!----------------------------------------------------------- + zpm_zero = zpm - zpi(1) + zpi_zero = zpi - zpi(1) + do k=1, nz-1 + if (zpbl .le. zpm_zero(k+1) .and. (zpbl .ge. zpm_zero(k) ) ) then + kpbl = k+1 + exit + endif + enddo + + do k = iemax, 1, -1 + + uds(k) = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) + phiang = atan(vp(k)/uds(k)) + ang = theta - phiang + cosang(k) = cos(ang) + sinang(k) = sin(ang) + + if (idxzb == 0) then + pe = pe + bn2(k) * (elvp - zpm(k)) *(zpi(k+1) - zpi(k)) + umf(k) = uds(k) * cosang(k) ! normal to main axis + ek = 0.5 * umf(k) * umf(k) +! +! --- dividing stream lime is found when pe =>exceeds ek first from the "top" +! + if (pe >= ek) idxzb = k + exit + endif + enddo + +! idxzb = min(kpbl, idxzb) +! +! +! +! last: mtb-drag +! + if (idxzb > 1) then + zblk = zpm(idxzb) + print *, zpm(idxzb)*1.e-3, ' mtb-gfs18 block-lev km ', idxzb, iemax, int(elvp) + do k = idxzb-1, 1, -1 +! + zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) + cs2 = cosang(k)* cosang(k) + ss2 = 1.-cs2 + rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it + + who_iz_normal = max(cosang(k), gam*sinang(k)) +! +! high res-n higher mtb 0.125 => 3.5 ; (negative of db -- see sign at tendency) +! + dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal + + drmtb(k) = dbtmp * abs(uds(k)) ! full mtb-drag = -drmtb(k) * uds = -kr*u +! + taumtb = taumtb - drmtb(k) * uds(k) *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) +! + enddo + endif + endif ! strver=='gfs17' +! +! + end subroutine ugwp_drag_mtb +! +! +! ugwp_taub_oro - Computes [taulin, taufrb, drlee(levs) ] +! +! + subroutine ugwp_taub_oro(levs, izb, kxw, tau_izb, fcor, & + hprime , sigma, theta, oc, oa4, clx4, gamm, & + elvp, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, xn, yn, umag, & + tautot, tauogw, taulee, drlee, tau_src, kxridge, kdswj, krefj, kotr) +! + use ugwp_common_v1, only : bnv2min, grav, pi, pi2, dw2min, velmin + use ugwp_common_v1, only : mkz2min, mkzmin + use cires_ugwp_module_v1, only : frcrit, ricrit, linsat + use ugwp_oro_init_v1, only : hpmax, cleff, frmax + use ugwp_oro_init_v1, only : nwdir, mdir, fdir + use ugwp_oro_init_v1, only : efmin, efmax , gmax, cg, ceofrc + use ugwp_oro_init_v1, only : fcrit_sm, fcrit_gfs, frmin, frmax + use ugwp_oro_init_v1, only : coro, nridge, odmin, odmax + use ugwp_oro_init_v1, only : strver +! + use ugwp_oro_init_v1, only : zbr_pi +! --- +! +! define oro-GW fluxes: taulin, taufrb amd if kdswj > 0 (LWB-lee wave breaking) +! approximate for drlee-momentum tendency +! --- + implicit none +! + integer, intent(in) :: levs, izb + real , intent(in) :: tau_izb ! integrated (1:izb) drag -Kr_mtb*U, or Zero + integer, intent(out) :: kdswj, krefj, kotr + integer :: klwb + real, intent(in) :: kxw, fcor + real, intent(in) :: hprime, sigma, theta, oc, gamm, elvp + +! + real, intent(in) :: oa4(4), clx4(4) + + real, dimension(levs), intent(in) :: up, vp, tp, qp, dp + real, dimension(levs+1), intent(in) :: zpi, pint + real, dimension(levs ), intent(in) :: zpm, pmid +! + real,dimension(levs), intent(out) :: drlee + real,dimension(levs+1), intent(out) :: tau_src +! + real, intent(out) :: tauogw, tautot, taulee + real :: taulin, tauhcr, taumtb + real, intent(out) :: xn, yn, umag, kxridge +! +! +! locals +! four possible versions to compute "taubase as a function of Fr-number" +! character :: strver='smc_2000' ! 'kd_2005', 'gfs_2017', 'vay_2018' +! + real, dimension(levs+1) :: zpi_zero + + real :: oa, clx, odir, cl4p(4), clxp + + real :: uhm, vhm, bn2hm, rhohm, bnv + + real :: elvpMTB, wdir + real :: tem, efact, coefm, kxlinv, gfobnv + + real :: fr, frlin, frlin2, frlin3, frlocal, dfr + real :: betamax, betaf, frlwb, frmtb + integer :: klow, ktop, kph + + integer :: i, j, k, nwd, ind4, idir + + real :: sg_ridge, kx2, umd2 + real :: mkz, mkz2, zbr_mkz, mkzi + + real :: hamp ! clipped hprime*elvmax/elv_clip > hprime + real :: hogw ! hprime or hamp for free-prop OGWs z > z(krefj) + real :: hdsw ! empirical like DNS amplitudes for Lee-dsw trapped waves + real :: hcrit + real :: hblk ! blocking div-stream height + + real :: coef_h2, frnorm + + + real, dimension(levs) :: bn2 + real :: rho(levs) + real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi + real, dimension(levs+1) :: umd, phmkz + real :: c2f2, umag2, dzwidth, udir + real :: hogwi, hdswi, hogwz, hdswz ! height*height wave-amp + real :: uogwi, udswi, uogwz, udswz ! wind2 wave-rms + real, dimension(levs+1) :: dtrans, deff + real :: pdtrans + logical :: do_klwb_phase = .false. ! phase-crireria for LLWB of SM00 + logical :: do_dtrans = .true. ! dissipative saturation to deposit momentum + ! between ZMTB => ZHILL +!----------------------------------------------------------------------------- +! +! downslope/lee/GW wave regimes kdswj: between ZMTB and ZOGW(krefj) +! ZMTB < ZOGW = ns*HPRIME < ELVP +! define krefj as a level for OGWs above ZMTB and "2-3-4*hprime" + ZMTB +! we rely on the concept of the "CLIPPED-SG" mountain above ZMTB & new +! inverse Froude number for the "mean flow" averaged from ZMTB to ZOGW +! here we can use "elvp" as only for hprime adjustment ...elvp/elvp_MTB +! +!"empirical" specification of tauwave = taulee+tauogw in [ZMTB : ns*HPRIME] +! can be based on numerical runs like WRF-model +! for Frc < Fr< [Frc : 2.5-3 Frc] +! see suggestions proposed in SM-2000 and Eckermann et al. (2010) +!----------------------------------------------------------------------------- + tautot = 0. ; taulin = 0. ; taulee = 0. ; drlee(1:levs) = 0. ; tau_src = 0.0 + krefj = 1 ; kotr = levs+1; kdswj = 1 + xn = 1.0 ; yn = 0. ; umag = velmin; kxridge = kxw + + dtrans = 0. ; deff =0. + klow = 2 + elvpMTB = elvp +! +! clipped mountain H-zmtb for estimating wave-regimes new Fr and MF above ZMTB +! + if (izb > 0 ) then + klow = izb + elvpMTB = max(elvp - zpi(izb), 0.0) + endif + if (elvpMTB <=0 ) print *, ' blocked flow ' + if (elvpMTB <=0 ) return ! "blocked flow" from the surface to elvMAX + + zpi_zero(:) = zpi(:) - zpi(1) + hblk = zpi_zero(klow) + + sg_ridge = max( nridge*hprime * (elvp/elvpMTB), hblk+hprime*0.333) + +! +! enhance sg_ridge by elvp/elvpMTB >1 and H_clip = H-hiilnew - zblk later for hamp +! + sg_ridge = min(sg_ridge, hpmax) + +! print *, 'sg_ridge ', sg_ridge + + do k=1, levs + if (sg_ridge .gt. zpi_zero(k) .and. ( sg_ridge .le. zpi_zero(k+1) ) ) then + ktop = k+1 + exit + endif + enddo + + krefj = ktop ! the mountain top index for sg_ridge = ns*hprime + +! if ( izb > 0 .and. krefj .le. izb) then +! print *, izb, krefj, sg_ridge, zpi_zero(izb), ' izb >ktop ' +! endif + +! +! here ktop displays sg_ridge-position not elvP !!!! klow =2 to avoid for 127-126L +! instability due to extreme "thin" layer...128L-model needs cruder vertical resolution +! + call um_flow(levs, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + bn2, uhm, vhm, bn2hm, rhohm) + + call get_unit_vector(uhm, vhm, xn, yn, umag) + + if (bn2hm <= 0.0) RETURN ! "unstable/neutral" hill need different treatment + bnv = sqrt(bn2hm) + hamp = sg_ridge-zpi_zero(klow) ! hamp >= nridge*hprime due higher SG-elevations - zblk or first layer + hogw = hamp + hdsw = hamp + + + fr = bnv * hamp /umag + fr = min(fr, frmax) + kxridge = max(sigma/hamp, kxw) ! to get rid from "SSO-errors" kxw-provides max-value for kx + kx2 = kxridge*kxridge + umag = max( umag, velmin) + c2f2 = fcor*fcor/kx2 + umag2 = umag*umag - c2f2 + + if (umag2 <= 0.0) RETURN ! Coriolis cut-off at high-mid latitudes for low kx + + mkz2 = bn2hm/umag2 - kx2 ! we add Coriolis corrections for crude model resolutions "low-kx" + ! and non-stationary waves coro, fcor for small umag + ! bn2hm/[(coro-umag)^2 -fc2/kx2] - kx2, cf = fc/kx => 2 m/s to 11 m/s for 60deg + IF (mkz2 < mkz2min .or. krefj <= 2 ) THEN +! +! case then no effects of wave-orography +! + krefj = 1 ; kdswj = 1; kotr = levs ; klwb = 1 + tautot = 0. + tauogw = 0. + taulee = 0. + drlee = 0. ; tau_src(1:levs+1) = 0. + return + ENDIF +!========================================================================= +! find orographic asymmetry and convexity :'oa/clx' for clipped SG-hill +! nwd 1 2 3 4 5 6 7 8 +! wd w s sw nw e n ne se +! make sure that SM_00 and KD_05 oro-characteristics can match each other +! OD-KDO5 = Gamma=a/b [0:2] ; hsg = 2.*hprime +! OC-KD05 mount sharpness sigma^4 "height to half-width"[0:1] +! alph-SM00 fraction of h2d contributed to hprime [0:1] +! +! OA-KDO5 OA > dwstream OA=0 sym OA < 0 upstram [-1. 0. 1] +! delt-SM00 dw/up asymmetry -1 < delta < 1 +! Gamma-LM97 anisotropy of the orography g2 =(dh/dx)^2/(dh/dy)^2 +!.. +!A parametrization of low-level wave breaking which includes a dependence on +!the degree of 2-dimensionality of SG; it is active over a finite range of Fr +!========================================================================= + wdir = atan2(uhm,vhm) + pi + idir = mod( int(fdir*wdir),mdir) + 1 + + nwd = nwdir(idir) + ind4 = mod(nwd-1,4) + 1 + if (ind4 < 1 ) ind4 = 1 + if (ind4 > 4 ) ind4 = 4 + + oa = ( 1-2*int( (nwd-1)/4 )) * oa4(ind4) + clx = clx4(ind4) + cl4p(1) = clx4(2) + cl4p(2) = clx4(1) + cl4p(3) = clx4(4) + cl4p(4) = clx4(3) + clxp = cl4p(ind4) + + odir = clxp/max(clx, 1.e-5) ! WRF-based definition for "odir" + + odir = min(odmax, odir) + odir = max(odmin, odir) + + + if (strver == 'smc_2000' .or. strver == 'vay_2018') then +!========================================================================= +! +! thrree-piece def-n for tautot(Fr): 0-Fr_lin - Fr_lee -Fr_mtb +! taulin/tauogw taulee taumtb +! here tau_src(levs+1): approximate wave flux from surface to LLWB +! Following attempts of Scinocca +McFarlane, 2000 & Eckermann etal.(2010) +!========================================================================= +! +! if (mkz2 < 0)... mkzi = sqrt(-mkz2) trapped wave regime don't a case in UGWP-V1 +! wave flux ~ rho_src*kx_src/mkz_src*wind_rms +! bn2, uhm, vhm, bn2hm, rhohm +! +! IF (mkz2.ge. mkz2min .and. krefj > 2 ) THEN +! +! wave regimes +! + mkz = sqrt(mkz2) + frlwb = fcrit_sm ! should be higher than LOGW to get zblk < zlwb + frlin = fcrit_sm + frlin2 = 1.5*fcrit_sm + frlin3 = 3.0*fcrit_sm + + hcrit = fcrit_sm*umag/bnv + hogw = min(hamp, hcrit) + hdsw = min(hamp, frlwb*umag/bnv) ! no trapped-wave solution + + coef_h2 = kxridge * rhohm * bnv * umag + + taulin = coef_h2 * hamp*hamp + tauhcr = coef_h2 * hcrit*hcrit + + IF (fr < frlin ) then + tauogw = taulin + taulee = 0.0 + taumtb = 0.0 + else if (fr .ge. frlin ) then + tauogw = tauhcr + taulin = coef_h2 * hamp*hamp + taumtb = tau_izb ! integrated form MTB +! +! SM-2000 approach for taulee, shall we put limits on BetaMax_max ~ 20 or Betaf ?? +! + frnorm = fr/fcrit_sm ! frnorm below [1.0 to 3.0] + BetaMax = 1.0 + 2.0*OC ! alpha of SM00 or OC-mountain sharphess KD05 OC=[10, 0] + + if ( fr <= frlin2 ) then + Betaf= 2.*BetaMax*(frNorm-1.0) + taulee = (1. + Betaf )*taulin - tauhcr + else if ( (fr > frlin2).and.(fr <= frlin3))then + Betaf=-1.+ 1./frnorm/frnorm + & + (BetaMax + 0.555556)*(2.0 - 0.666*frnorm)* (2.0 - 0.666*frnorm) + taulee = (1. + Betaf )*taulin - tauhcr +!============== +! Eck-2010 WRF-alternatve through Dp_surf = P'*grad(h(x,y)) +! 1 < Fr < 2.5 tauwave = taulee+tauogw = tau_dp*(fr)**(-0.9) +! Fr > 2.5 tauwave = tau_dp*(2.5)**(-0.9) +! to apply it need tabulated Dp(fr, Dlin) Dp=function(Dlin, U, N, h) +! +!============== + else + taulee = 0.0 + hdsw = 0.0 + endif + ENDIF + + tautot = tauogw + taulee + taumtb*0. + + IF (taulee > 0.0 ) THEN + + hdsw = sqrt(tautot/coef_h2) ! averaged value for hdsw - mixture of lee+ogw with mkz/kxridge +! +! compute vertical profile "drlee" with the low-level wave breaking & "locally" trapped waves +! make "empirical" height above elvp that may represent DSW-wave breaking & trapping +! here we will assign tau_sso(z) profile between: zblk(zsurf) - zlwb - ztop_sso = ns*sridge +! + call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) + + kph = max(izb, 2) ! kph marks the low-level of wave solutions + klwb = kph ! klwb above blocking marks wave-breaking + kotr = levs+1 ! kotr marks mkz2(z) <= 0., reflection level + + if (do_dtrans) pdtrans = log(tautot/tauogw)/(zpi(krefj) - zpi(kph)) + + udir = max(ui(krefj)*xn +vi(krefj)*yn, velmin) + hogwi = hogw*hogw* rhohm/rhoi(krefj) * umag/udir * bnv/bvi(krefj) + umd(krefj) = udir + + udir = max(ui(kph)*xn +vi(kph)*yn, velmin) + hdswi = hdsw*hdsw* rhohm/rhoi(kph) * umag/udir * bnv/bvi(kph) + umd(kph) = udir + ! what we can put between k =[kph:krefj] + phmkz(:) = 0.0 ! + phmkz(kph-1) = fr ! initial Phase of the low-level wave +! +! now transfer tau_layer => tau_level assuming tau_layer = tau_level +! kx*rho_layer*bn_layer*u_layer* HL*HL = kx*rho_top*bn_top*u_top * HT*HT +! apply it for both hdsw & hogw with linear saturation-solver for Cx =0 +! + loop_lwb_otr: do k=kph+1, krefj ! levs + + umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) + umd2 =(coro- umd(k))*(coro- umd(k)) + umd2 = max(umd2, dw2min) -c2f2 + + + if (umd2 <= 0.0) then +! +! critical layer +! + klwb = k + kotr = k + exit loop_lwb_otr + endif + + mkz2 = bn2i(k)/umd2 - kx2 + + if ( mkz2 >= mkz2min ) then +! +! find klwb having some "kinematic" phase "break-down" crireria SM00 or LM97 +! at finest vertical resolution we can meet "abrupt" mkz +! mkzmax = 6.28/(2*dz), mkzmin = 6.28/ztrop=18km +! to regularize SG-solution mkz = max(mkzmax, min(mkz,in, mkz)) +! + mkz = sqrt(mkz2) + hdswz = hdswi* rhoi(k-1)/rhoi(k) * umd(k-1)/umd(k) * bvi(k-1)/bvi(k) + udswz = hdswz *bn2i(k) +!=========================================================================================== +!linsat wave ampl.: mkz*sqrt(hdswz) <= 1.0 or udswz <= linsat2*umd2 +! +! tautot = tausat = rhoi(k) *udswz_sat * kxridge/mkz +! by k = krefj tautot = tauogw(krefj) +!=========================================================================================== + if (do_klwb_phase) then + phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) + if( ( phmkz(k) .ge. zbr_pi).and.(klwb == kph)) then + klwb = min(k, krefj) + exit loop_lwb_otr + endif + endif + else ! mkz2 < mkz2min + kotr = k ! trapped/reflected waves / + exit loop_lwb_otr + endif + enddo loop_lwb_otr +! +! define tau_src(1:zblk:klwb) = sum(tau_oro+tau_dsw+tau_ogw) and define drlee +! tau_trapped ??? +! + if (do_klwb_phase) then + do k=kph, kotr-1 + + if (klwb > kph .and. k < klwb) then + drlee(k) = (tautot -tauogw)/(zpi(kph) - zpi(klwb)) ! negative Ax*rho + tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) + drlee(k) = drlee(k)/rho(k) + else if ( k >= klwb .and. k < kotr) then + tau_src(k) = tauogw + drlee(k) = 0.0 + endif + enddo + kdswj = klwb ! assign to the "low-level" wave breaking + endif +! +! simplest exponential transmittance d(tau)/dz = - pdtrans *tau(z) +! more complicated is dissipative saturation pdtrans =/= constant +! + if (do_dtrans) then + do k=kph, krefj + tau_src(k)= tautot*exp(-pdtrans*(zpi(k)-zpi(kph))) + drlee(k) = -tau_src(k)/rho(k) * pdtrans + enddo + endif + + + ENDIF !taulee > 0.0 + + + endif !strver +! + +!========================================================================= + if (strver == 'gfs_2018' .or. strver == 'kd_2005') then +!========================================================================= +! +! orowaves: OGW+DSW/Lee +! + efact = (oa + 2.0) ** (ceofrc*fr) + efact = min( max(efact,efmin), efmax ) + coefm = (1. + clx) ** (oa+1.) + + kxlinv = min (kxw, coefm * cleff) ! does not exceed 42km ~4*dx + kxlinv = coefm * cleff + tem = fr * fr * oc + gfobnv = gmax * tem / ((tem + cg)*bnv) ! g/n0 +!========================================================================= +! source fluxes: taulin, taufrb +!========================================================================= + tautot = kxlinv * rhohm * umag * umag *umag* gfobnv * efact + + coef_h2 = kxlinv *rhohm * bnv*umag + taulin = coef_h2 *hamp*hamp + hcrit = fcrit_gfs*umag/bnv + tauhcr = coef_h2 *hcrit*hcrit + + IF (fr <= fcrit_gfs) then + tauogw = taulin + tautot = taulin + taulee = 0. + drlee(:) = 0. + ELSE !fr > fcrit_gfs + tauogw = tauhcr + taulee = max(tautot - tauogw, 0.0) + if (taulee > 0.0 ) hdsw = sqrt(taulee/coef_h2) +! approximate drlee(k) between [izb, klwb] +! find klwb and decrease taulee(izb) => taulee(klwb) = 0. +! above izb tau + if (mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0) then + + mkz = sqrt(mkz2) + call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) + + kph = max(izb, 2) + phmkz(:) = 0.0 + klwb = max(izb, 1) + kotr = levs+1 + phmkz(kph-1) = fr ! initial Phase of the Lee-OGW + + loop_lwb_gfs18: do k=kph, levs + + umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) + umd2 =(coro- umd(k))*(coro- umd(k)) + umd2 = max(umd2, velmin*velmin) + mkz2 = bn2i(k)/umd2 - kx2 + if ( mkz2 > mkz2min ) then + mkz = sqrt(mkz2) + frlocal = max(hdsw*bvi(k)/umd(k), frlwb) + phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) + if( ( phmkz(k) >= zbr_pi ) .and. (frlocal > frlin)) klwb = k + else + kotr = k + exit loop_lwb_gfs18 + endif + enddo loop_lwb_gfs18 +! +! + do k=kph, kotr-1 + + if (klwb > kph .and. k < klwb) then + drlee(k) = -(tautot -tauogw)/(zpi(kph) - zpi(klwb)) + tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) + drlee(k) = drlee(k)/rho(k) + else if ( k >= klwb .and. k < kotr) then + tau_src(k) = tauogw + drlee(k) = 0.0 + endif + enddo + kdswj = klwb ! assign to the "low-level" wave breaking + endif ! mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0 + ENDIF !fr > fcrit_gfs + + + ENDIF !strbase='gfs2017' .or. strbase='kd_2005' + + +! output : taulin, taufrb, taulee, xn, yn, umag, kxw/kxridge +! print *, krefj, levs, tauogw, tautot , ' ugwp_taub_oro ' +! + end subroutine ugwp_taub_oro +! +!-------------------------------------- +! +! call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, kxw, & +! fcor(j), c2f2(j), up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, & +! xn, yn, umag, drtau, kdis_oro) + + subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & + kxw, fcor, kxridge, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & + xn, yn, umag, drtau, kdis) + + use ugwp_common_v1, only : bnv2min, grav, pi, pi2, dw2min, velmin, rgrav + use cires_ugwp_module_v1, only : frcrit, ricrit, linsat, hps, rhp1, rhp2 + use cires_ugwp_module_v1, only : kvg, ktg, krad, kion + use ugwp_oro_init_v1, only : coro , fcrit_sm , fcrit_sm2 + implicit none +! + integer, intent(in) :: krefj, levs + real , intent(in) :: tauogw, tautot, kxw + real , intent(in) :: fcor + + real , dimension(levs+1) :: tau_src + + real, dimension(levs) , intent(in) :: up, vp, tp, qp, dp, zpm + real, dimension(levs+1), intent(in) :: zpi, pmid, pint + real , intent(in) :: xn, yn, umag + real , intent(in) :: kxridge + + + real, dimension(levs), intent(out) :: drtau, kdis +! +! locals +! + real :: uref, udir, uf2, ufd, uf2p + real, dimension(levs+1) :: tauz + real, dimension(levs) :: rho + real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi + + integer :: i, j, k, kcrit, kref + real :: kx2, kx2w, kxs + real :: mkzm, mkz, dkz, mkz2, ch, kzw3 + real :: wfdM, wfdT, wfiM, wfiT + real :: fdis, mkzi, keff_m, keff_t + real :: betadis, betam, betat, cdfm, cdft + real :: fsat, hsat, hsat2, kds , c2f2 + + drtau(1:levs) = 0.0 + kdis (1:levs) = 0.0 + + ch = coro + + kx2w = kxw*kxw + kx2 = kxridge*kxridge + if( kx2 < kx2w ) kx2 = kx2w + kxs = sqrt(kx2) + c2f2 = fcor*fcor/kx2 +! +! non-hydrostatic LinSatDis for Ch = 0 (with set of horizontal wavenumber kxw) +! +! print *, krefj, levs, tauogw, tautot , ' orolsatdis ' + call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) +!=============================================================================== +! for stationary oro-GWs only "single"-azimuth cd = 0 -(-Udir) = Udir > 0 +! rotational/non-hyrostatic effects are important only for high-res runs +! Udir = 0, Udir < 0 are not +! future"revisions" shear effects for d mkz /dt = -kxw*dU/dz +! horizontal wavelength spectra mkz2 = l2 -kxw(n)*kxw(n) +! stochastic "tauogw'-setup+ sigma_tau ; +! 3D-wave effects 1+ (k/l)^2 and NS vs EW orowaves +! target is to get "multiple"-saturation levels for OGWs +!=============================================================================== + tauz(1:krefj) = tauogw ! constant flux for OGW-packet or single mode + ! sign of tauz > 0...and its attenuate with Z + k = krefj + uref = ui(k)*xn +vi(k)*yn - ch ! stationary waves + uf2 = uref*uref - c2f2 + if (uf2 > 0) then + mkz2 = bn2i(k)/uf2 -kx2 + if (mkz2.gt.0) then + mkzm = sqrt(mkz2) + else + return ! wave reflection mkz2 <=0. + endif + else + return ! wave absorption uf2 <= 0. + endif +! +! upward solver for single "mode" with tauz(levs+1) =0. at the top +! + kds = 0.1* kvg(krefj) ! eddy wave diffusion from the previous layer + kcrit = levs + do k= krefj+1, levs +! +! 2D-wave propagation along reference-wind direction +! udir = 0 critical wind for coro =0 +! cdop = -uref .... upwind waves travel against MF +! + udir = ui(k)*xn +vi(k)*yn + uf2 = udir*udir - c2f2 + + + if (uf2 < dw2min .or. udir <= 0.0) then + kcrit =K + tauz(kcrit:levs) = 0. + exit ! vert-level loop + endif +! +! wave-based solution +! + mkz2 = bn2i(k)/uf2 -kx2 + if (mkz2 > 0) then + mkzm = sqrt(mkz2) +! +! do dissipative flux vs saturation: kvg, ktg, krad, kion +! + kzw3 = mkzm*mkz2 +! + keff_m = kvg(k)*mkz2 + kion(k) +! keff_t = kturb(k)*iPr_turb + kmol(k)*iPr_mol + keff_t = ktg(k)*mkz2 + krad(k) +! +! + uf2p = uf2 + 2.0*c2f2 + betadis = uf2/uf2p + betaM = 1.0 / (1.0+betadis) ! if c2f2 = 0. betaM = betaT =0.5 ekw = epw + betaT = 1.0- BetaM + +! +!imaginary frequencies of momentum and heat with "kds at (k-1) level" +! + wfiM = kds*mkz2 + keff_m + wfiT = kds*mkz2 + keff_t +! + cdfm = sqrt(uf2)*kxs + cdft = abs(udir)*kxs + wfdM = wfiM/cdfm *BetaM + wfdT = wfiT/Cdft *BetaT + mkzi = 2.0*mkzm*(wfdM+wfdT) + + fdis = tauz(k-1)*exp(-mkzi*(zpi(k)-zpi(k-1)) ) + tauz(k) = fdis + hsat2 = fcrit_sm2 * uf2 *bn2i(k) + fsat = rhoi(k)* hsat2 * sqrt(uf2) * bvi(k) + if (fdis > fsat) then + tauz(k) = min(fsat, tauz(k-1)) +!================================================================= +! two definitions for eddy mixing of MF: +! a) wave damping-Lindzen : Ked ~ kx/(2H)*(u-c)^4/N^3 +! b) heat-based turbulence: 4/3 Richardson Ked ~eps^1/3 *Lt^4/3 +!================================================================= + kds = rhp2*kxs*uf2*uf2/bn2i(k)/bvi(k) + kdis(k) = kds + endif + else + tauz(k:levs) = 0. ! wave is reflected above + kds = 0. + endif + enddo + + do k=krefj+1, kcrit + drtau(k) = rgrav*(tauz(k+1)-tauz(k))/dp(k) + enddo +! +! + end subroutine ugwp_oro_lsatdis +! +! + subroutine ugwp_tofd(im, levs, sigflt, elvmax, zpbl, u, v, zmid, & + utofd, vtofd, epstofd, krf_tofd) + use machine , only : kind_phys + use ugwp_common_v1 , only : rcpd2 + use ugwp_oro_init_v1, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd +! + implicit none +! + integer :: im, levs + real(kind_phys), dimension(im, levs) :: u, v, zmid + real(kind_phys), dimension(im) :: sigflt, elvmax, zpbl + real(kind_phys), dimension(im, levs) :: utofd, vtofd, epstofd, krf_tofd +! +! locals +! + integer :: i, k + real :: sgh = 30. + real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, zexp, krf +! + utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 +! + + do i=1, im + + zdec = max(n_tofd*sigflt(i), zpbl(i)) + zdec = min(ze_tofd, zdec) + rzdec = 1.0/zdec + sgh2 = max(sigflt(i)*sigflt(i), sgh*sgh) + + do k=1, levs + zmet = zmid(i,k) + if (zmet > ztop_tofd) cycle + ekin = u(i,k)*u(i,k) + v(i,k)*v(i,k) + umag = sqrt(ekin) + zarg = zmet*rzdec + zexp = exp(-zarg*sqrt(zarg)) + krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *zexp + utofd(i,k) = -krf*u(i,k) + vtofd(i,k) = -krf*v(i,k) + epstofd(i,k)= rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" + ! to update momentum and temp-re + krf_tofd(i,k) = krf + enddo + enddo +! + end subroutine ugwp_tofd +! +! + subroutine ugwp_tofd1d(levs, sigflt, elvmax, zsurf, zpbl, u, v, & + zmid, utofd, vtofd, epstofd, krf_tofd) + use machine , only : kind_phys + use ugwp_common_v1 , only : rcpd2 + use ugwp_oro_init_v1, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd +! + implicit none + integer :: levs + real(kind_phys), dimension(levs) :: u, v, zmid + real(kind_phys) :: sigflt, elvmax, zpbl, zsurf + real(kind_phys), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd +! +! locals +! + integer :: i, k + real :: sghmax = 5. + real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, ztexp, krf +! + utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 +! + zdec = max(n_tofd*sigflt, zpbl) ! ntimes*sgh_turb or Zpbl + zdec = min(ze_tofd, zdec) ! cannot exceed 18 km + rzdec = 1.0/zdec + sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! 25 meters dz-of the first layer + + do k=1, levs + zmet = zmid(k)-zsurf + if (zmet > ztop_tofd) cycle + ekin = u(k)*u(k) + v(k)*v(k) + umag = sqrt(ekin) + zarg = zmet*rzdec + ztexp = exp(-zarg*sqrt(zarg)) + krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *ztexp + + utofd(k) = -krf*u(k) + vtofd(k) = -krf*v(k) + epstofd(k) = rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" + ! to update momentum and temp-re; epstofd(k) can be skipped + krf_tofd(k) = krf + enddo +! + end subroutine ugwp_tofd1d + + +end module cires_vert_orodis_v1 diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 58872057e..de1b147a9 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -122,6 +122,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + end if else write(errmsg,'(*(a))') "Logic error: cires_ugwp_init called but do_ugwp is false and cdmbgwd(3) <= 0" errflg = 1 @@ -192,6 +193,9 @@ end subroutine unified_ugwp_finalize !! @{ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, & lonr, oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & + varss,oc1ss,oa4ss,ol4ss,dx,dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl,dusfc_ss, & + dvsfc_ss,dusfc_fd,dvsfc_fd,dtaux2d_ls,dtauy2d_ls,dtaux2d_bl,dtauy2d_bl, & + dtaux2d_ss,dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,br1,hpbl,slmsk, & do_tofd, ldiag_ugwp, cdmbgwd, jdat, xlat, xlat_d, sinlat, coslat, area, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & @@ -202,7 +206,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & ldiag3d, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & - do_ugwp_v1_orog_only, errmsg, errflg) + do_ugwp_v1_orog_only, gwd_opt, errmsg, errflg) implicit none @@ -331,8 +335,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & ol4ss,theta,sigma,gamma,elvmax,dtaux2d_ls, & dtauy2d_ls,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss, & - dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfc, & - dvsfc,dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + dtauy2d_ss,dtaux2d_fd,dtauy2d_fd,dusfcg, & + dvsfcg,dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fvirt,con_pi,lonr, & @@ -363,7 +367,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, prslk, zmeti, zmet, dtp, kdt, hprime, oc, oa4, & clx, theta, sigma, gamma, elvmax, & sgh30, DUSFCg, DVSFCg, xlat_d, sinlat, coslat, & - spgrid,cdmbgwd(1:2), me, master, rdxzb, & + area,cdmbgwd(1:2), me, master, rdxzb, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & du3dt_mtb, du3dt_ogw, du3dt_tms) From 088fcd4a5436adde3bf6297568f2904b8e65dc71 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Wed, 9 Sep 2020 14:48:45 +0000 Subject: [PATCH 047/274] 1st success -- Sept. 9 --- physics/cires_ugwp_initialize_v1.F90 | 16 +- physics/cires_ugwp_module_v1.F90 | 6 +- physics/unified_ugwp.meta | 332 +++++++++++++-------------- 3 files changed, 177 insertions(+), 177 deletions(-) diff --git a/physics/cires_ugwp_initialize_v1.F90 b/physics/cires_ugwp_initialize_v1.F90 index 174a871d1..ef6c2c7d1 100644 --- a/physics/cires_ugwp_initialize_v1.F90 +++ b/physics/cires_ugwp_initialize_v1.F90 @@ -54,7 +54,7 @@ end module ugwp_common_v1 !Part-1 init => wave dissipation + RFriction ! !=================================================== - subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) + subroutine init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) use ugwp_common_v1, only : pih @@ -139,10 +139,10 @@ subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf ! 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) - end subroutine init_global_gwdis + end subroutine init_global_gwdis_v1 ! ! - subroutine rf_damp_init(levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) + subroutine rf_damp_init_v1(levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) implicit none integer :: levs @@ -172,7 +172,7 @@ subroutine rf_damp_init(levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) endif enddo - end subroutine rf_damp_init + end subroutine rf_damp_init_v1 ! ======================================================================== ! Part 2 - sources ! wave sources @@ -789,11 +789,11 @@ end module ugwp_wmsdis_init_v1 ! DSPDIS (Hines)+ADODIS (Alexander-Dunkerton-Ortland) ! !========================================================================= - subroutine init_dspdis + subroutine init_dspdis_v1 implicit none - end subroutine init_dspdis + end subroutine init_dspdis_v1 - subroutine init_adodis + subroutine init_adodis_v1 implicit none - end subroutine init_adodis + end subroutine init_adodis_v1 diff --git a/physics/cires_ugwp_module_v1.F90 b/physics/cires_ugwp_module_v1.F90 index dc586c6bd..a25854097 100644 --- a/physics/cires_ugwp_module_v1.F90 +++ b/physics/cires_ugwp_module_v1.F90 @@ -302,10 +302,10 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & launch_level = max(k-1, 5) ! above 5-layers from the surface ! -! Part-1 :init_global_gwdis +! Part-1 :init_global_gwdis_v1 ! - call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) - call rf_damp_init (levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) + call init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) + call rf_damp_init_v1 (levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) ! ! Part-2 :init_SOURCES_gws ! diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 5c0eb458b..e45625e9e 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -51,6 +51,12 @@ kind = len=* intent = in optional = F +[jdat] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer [lonr] standard_name = number_of_equatorial_longitude_points long_name = number of global points in x-dir (i) along the equator @@ -111,12 +117,6 @@ kind = kind_phys intent = in optional = F -[jdat] - standard_name = forecast_date_and_time - long_name = current forecast date and time - units = none - dimensions = (8) - type = integer [cgwf] standard_name = multiplication_factors_for_convective_gravity_wave_drag long_name = multiplication factor for convective GWD @@ -261,14 +261,6 @@ [ccpp-arg-table] name = unified_ugwp_run type = scheme -[do_ugwp] - standard_name = do_ugwp - long_name = flag to activate CIRES UGWP - units = flag - dimensions = () - type = logical - intent = in - optional = F [me] standard_name = mpi_rank long_name = MPI rank of current process @@ -421,6 +413,141 @@ kind = kind_phys intent = inout optional = F +[clx] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid orography + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid orography small scale + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oc1ss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid orography small scale + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid orography small scale + units = none + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[ol4ss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale + units = frac + dimensions = (horizontal_dimension,4) + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dusfc_ls] + standard_name = integrated_x_momentum_flux_from_large_scale_gwd + long_name = integrated x momentum flux from large scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_ls] + standard_name = integrated_y_momentum_flux_from_large_scale_gwd + long_name = integrated y momentum flux from large scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_bl] + standard_name = integrated_x_momentum_flux_from_blocking_drag + long_name = integrated x momentum flux from blocking drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_bl] + standard_name = integrated_y_momentum_flux_from_blocking_drag + long_name = integrated y momentum flux from blocking drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_ss] + standard_name = integrated_x_momentum_flux_from_small_scale_gwd + long_name = integrated x momentum flux from small scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_ss] + standard_name = integrated_y_momentum_flux_from_small_scale_gwd + long_name = integrated y momentum flux from small scale gwd + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dusfc_fd] + standard_name = integrated_x_momentum_flux_from_form_drag + long_name = integrated x momentum flux from form drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc_fd] + standard_name = integrated_y_momentum_flux_from_form_drag + long_name = integrated y momentum flux from form drag + units = Pa s + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [dtaux2d_ls] standard_name = x_momentum_tendency_from_large_scale_gwd long_name = x momentum tendency from large scale gwd @@ -493,60 +620,33 @@ kind = kind_phys intent = out optional = F -[clx] - standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height - long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height - units = frac - dimensions = (horizontal_dimension,4) - type = real - kind = kind_phys - intent = in - optional = F -[oa4] - standard_name = asymmetry_of_subgrid_orography - long_name = asymmetry of subgrid orography +[br1] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[varss] - standard_name = standard_deviation_of_subgrid_orography_small_scale - long_name = standard deviation of subgrid orography small scale +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness units = m dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[oc1ss] - standard_name = convexity_of_subgrid_orography_small_scale - long_name = convexity of subgrid orography small scale - units = none +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[oa4ss] - standard_name = asymmetry_of_subgrid_orography_small_scale - long_name = asymmetry of subgrid orography small scale - units = none - dimensions = (horizontal_dimension,4) - type = real - kind = kind_phys - intent = in - optional = F -[ol4ss] - standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale - long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale - units = frac - dimensions = (horizontal_dimension,4) - type = real - kind = kind_phys - intent = in - optional = F [do_tofd] standard_name = turb_oro_form_drag_flag long_name = flag for turbulent orographic form drag @@ -572,6 +672,12 @@ kind = kind_phys intent = in optional = F +[jdat] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer [xlat] standard_name = latitude long_name = grid latitude @@ -733,105 +839,8 @@ kind = kind_phys intent = out optional = F -[dusfc_ls] - standard_name = integrated_x_momentum_flux_from_large_scale_gwd - long_name = integrated x momentum flux from large scale gwd - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dvsfc_ls] - standard_name = integrated_y_momentum_flux_from_large_scale_gwd - long_name = integrated y momentum flux from large scale gwd - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dusfc_bl] - standard_name = integrated_x_momentum_flux_from_blocking_drag - long_name = integrated x momentum flux from blocking drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dvsfc_bl] - standard_name = integrated_y_momentum_flux_from_blocking_drag - long_name = integrated y momentum flux from blocking drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dusfc_ss] - standard_name = integrated_x_momentum_flux_from_small_scale_gwd - long_name = integrated x momentum flux from small scale gwd - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dvsfc_ss] - standard_name = integrated_y_momentum_flux_from_small_scale_gwd - long_name = integrated y momentum flux from small scale gwd - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dusfc_fd] - standard_name = integrated_x_momentum_flux_from_form_drag - long_name = integrated x momentum flux from form drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dvsfc_fd] - standard_name = integrated_y_momentum_flux_from_form_drag - long_name = integrated y momentum flux from form drag - units = Pa s - dimensions = (horizontal_dimension) - type = real - kind = kind_phys intent = out optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[br1] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface - units = none - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[hpbl] - standard_name = atmosphere_boundary_layer_thickness - long_name = PBL thickness - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [gw_dudt] standard_name = tendency_of_x_wind_due_to_ugwp long_name = zonal wind tendency due to UGWP @@ -1021,23 +1030,6 @@ kind = kind_phys intent = out optional = F -[dx] - standard_name = cell_size - long_name = size of the grid cell - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[gwd_opt] - standard_name = gwd_opt - long_name = flag to choose gwd scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -1277,6 +1269,14 @@ type = logical intent = in optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 8396ef71276cead582f31c8002a730d2024d9600 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Wed, 9 Sep 2020 11:45:06 -0600 Subject: [PATCH 048/274] change horizontal_dimension to horizontal_loop_extent in _run section of meta files in ccpp-physics --- physics/GFS_DCNV_generic.meta | 70 ++-- physics/GFS_GWD_generic.meta | 56 ++-- physics/GFS_MP_generic.meta | 128 ++++---- physics/GFS_PBL_generic.meta | 152 ++++----- physics/GFS_SCNV_generic.meta | 60 ++-- physics/GFS_cloud_diagnostics.meta | 22 +- physics/GFS_debug.meta | 36 +- physics/GFS_rrtmg_post.meta | 16 +- physics/GFS_rrtmg_pre.meta | 92 +++--- physics/GFS_rrtmgp_gfdlmp_pre.meta | 46 +-- physics/GFS_rrtmgp_lw_post.meta | 40 +-- physics/GFS_rrtmgp_pre.meta | 34 +- physics/GFS_rrtmgp_sw_post.meta | 70 ++-- physics/GFS_rrtmgp_sw_pre.meta | 64 ++-- physics/GFS_rrtmgp_zhaocarr_pre.meta | 52 +-- physics/GFS_stochastics.meta | 62 ++-- physics/GFS_suite_interstitial.meta | 208 ++++++------ physics/GFS_surface_composites.meta | 364 ++++++++++----------- physics/GFS_surface_generic.meta | 258 +++++++-------- physics/GFS_surface_loop_control.meta | 16 +- physics/cires_ugwp.meta | 116 +++---- physics/cires_ugwp_post.meta | 56 ++-- physics/cnvc90.meta | 20 +- physics/cs_conv.meta | 80 ++--- physics/cs_conv_aw_adj.meta | 20 +- physics/cu_gf_driver.meta | 78 ++--- physics/cu_gf_driver_post.meta | 12 +- physics/cu_gf_driver_pre.meta | 16 +- physics/cu_ntiedtke.meta | 54 +-- physics/cu_ntiedtke_post.meta | 8 +- physics/cu_ntiedtke_pre.meta | 12 +- physics/dcyc2.meta | 96 +++--- physics/drag_suite.meta | 98 +++--- physics/flake_driver.meta | 54 +-- physics/gcm_shoc.meta | 34 +- physics/get_prs_fv3.meta | 26 +- physics/gfdl_cloud_microphys.meta | 58 ++-- physics/gmtb_scm_sfc_flux_spec.meta | 52 +-- physics/gscond.meta | 28 +- physics/gwdc.meta | 78 ++--- physics/gwdps.meta | 50 +-- physics/h2ophys.meta | 6 +- physics/lsm_ruc_sfc_sice_interstitial.meta | 20 +- physics/m_micro.meta | 108 +++--- physics/m_micro_interstitial.meta | 76 ++--- physics/maximum_hourly_diagnostics.meta | 34 +- physics/module_MYJPBL_wrapper.meta | 100 +++--- physics/module_MYJSFC_wrapper.meta | 144 ++++---- physics/module_MYNNPBL_wrapper.meta | 216 ++++++------ physics/module_MYNNSFC_wrapper.meta | 178 +++++----- physics/module_SGSCloud_RadPost.meta | 8 +- physics/module_SGSCloud_RadPre.meta | 56 ++-- physics/moninedmf.meta | 88 ++--- physics/moninedmf_hafs.meta | 80 ++--- physics/moninshoc.meta | 72 ++-- physics/mp_fer_hires.meta | 36 +- physics/mp_thompson.meta | 54 +-- physics/mp_thompson_post.meta | 6 +- physics/mp_thompson_pre.meta | 4 +- physics/ozphys.meta | 18 +- physics/ozphys_2015.meta | 18 +- physics/phys_tend.meta | 70 ++-- physics/precpd.meta | 20 +- physics/radlw_main.meta | 74 ++--- physics/radsw_main.meta | 86 ++--- physics/rascnv.meta | 68 ++-- physics/rayleigh_damp.meta | 20 +- physics/rrtmg_lw_post.meta | 6 +- physics/rrtmg_lw_pre.meta | 4 +- physics/rrtmg_sw_post.meta | 14 +- physics/rrtmg_sw_pre.meta | 16 +- physics/rrtmgp_lw_aerosol_optics.meta | 22 +- physics/rrtmgp_lw_cloud_optics.meta | 28 +- physics/rrtmgp_lw_cloud_sampling.meta | 10 +- physics/rrtmgp_lw_gas_optics.meta | 10 +- physics/rrtmgp_lw_pre.meta | 20 +- physics/rrtmgp_lw_rte.meta | 22 +- physics/rrtmgp_sw_aerosol_optics.meta | 24 +- physics/rrtmgp_sw_cloud_optics.meta | 24 +- physics/rrtmgp_sw_cloud_sampling.meta | 12 +- physics/rrtmgp_sw_gas_optics.meta | 12 +- physics/rrtmgp_sw_rte.meta | 30 +- physics/samfdeepcnv.meta | 68 ++-- physics/samfshalcnv.meta | 42 +-- physics/sascnvn.meta | 64 ++-- physics/satmedmfvdif.meta | 84 ++--- physics/satmedmfvdifq.meta | 88 ++--- physics/sfc_cice.meta | 44 +-- physics/sfc_diag.meta | 36 +- physics/sfc_diag_post.meta | 32 +- physics/sfc_diff.meta | 120 +++---- physics/sfc_drv.meta | 118 +++---- physics/sfc_drv_ruc.meta | 152 ++++----- physics/sfc_noahmp_drv.meta | 204 ++++++------ physics/sfc_nst.meta | 146 ++++----- physics/sfc_ocean.meta | 38 +-- physics/sfc_sice.meta | 70 ++-- physics/shalcnv.meta | 46 +-- physics/shinhongvdif.meta | 64 ++-- physics/ysuvdif.meta | 68 ++-- 100 files changed, 3145 insertions(+), 3145 deletions(-) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 507643661..c3388c44b 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -59,7 +59,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -68,7 +68,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -77,7 +77,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -86,7 +86,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -95,7 +95,7 @@ standard_name = x_wind_save long_name = x-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -104,7 +104,7 @@ standard_name = y_wind_save long_name = y-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -113,7 +113,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -122,7 +122,7 @@ standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -131,7 +131,7 @@ standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection long_name = instantaneous moisture tendency due to convection units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -233,7 +233,7 @@ standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -251,7 +251,7 @@ standard_name = cloud_work_function long_name = cloud work function units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -260,7 +260,7 @@ standard_name = x_wind_save long_name = x-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -269,7 +269,7 @@ standard_name = y_wind_save long_name = y-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -278,7 +278,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -287,7 +287,7 @@ standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -296,7 +296,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -305,7 +305,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -314,7 +314,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -323,7 +323,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -332,7 +332,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -341,7 +341,7 @@ standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -350,7 +350,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -392,7 +392,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -401,7 +401,7 @@ standard_name = cumulative_cloud_work_function long_name = cumulative cloud work function (valid only with sas) units = m2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -410,7 +410,7 @@ standard_name = cumulative_change_in_temperature_due_to_deep_convection long_name = cumulative change in temperature due to deep conv. units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -419,7 +419,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection long_name = cumulative change in water vapor specific humidity due to deep conv. units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -428,7 +428,7 @@ standard_name = cumulative_change_in_x_wind_due_to_deep_convection long_name = cumulative change in x wind due to deep convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -437,7 +437,7 @@ standard_name = cumulative_change_in_y_wind_due_to_deep_convection long_name = cumulative change in y wind due to deep convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -446,7 +446,7 @@ standard_name = cumulative_atmosphere_updraft_convective_mass_flux long_name = cumulative updraft mass flux units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -455,7 +455,7 @@ standard_name = cumulative_atmosphere_downdraft_convective_mass_flux long_name = cumulative downdraft mass flux units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -464,7 +464,7 @@ standard_name = cumulative_atmosphere_detrainment_convective_mass_flux long_name = cumulative detrainment mass flux units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -473,7 +473,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -482,7 +482,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -491,7 +491,7 @@ standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d long_name = convective cloud water mixing ratio in the phy_f3d array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -500,7 +500,7 @@ standard_name = convective_cloud_cover_in_phy_f3d long_name = convective cloud cover in the phy_f3d array units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_GWD_generic.meta b/physics/GFS_GWD_generic.meta index ed7cd9629..dc7ed7a70 100644 --- a/physics/GFS_GWD_generic.meta +++ b/physics/GFS_GWD_generic.meta @@ -35,7 +35,7 @@ standard_name = statistical_measures_of_subgrid_orography long_name = array of statistical measures of subgrid orography units = various - dimensions = (horizontal_dimension,number_of_statistical_measures_of_subgrid_orography) + dimensions = (horizontal_loop_extent,number_of_statistical_measures_of_subgrid_orography) type = real kind = kind_phys intent = in @@ -44,7 +44,7 @@ standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -53,7 +53,7 @@ standard_name = asymmetry_of_subgrid_orography long_name = asymmetry of subgrid orography units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = out @@ -62,7 +62,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = out @@ -71,7 +71,7 @@ standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with_respect to east of maximum subgrid orographic variations units = degree - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -80,7 +80,7 @@ standard_name = standard_deviation_of_subgrid_orography_small_scale long_name = standard deviation of subgrid orography small scale units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -89,7 +89,7 @@ standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid orography small scale units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -98,7 +98,7 @@ standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid orography small scale units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = out @@ -107,7 +107,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = out @@ -116,7 +116,7 @@ standard_name = slope_of_subgrid_orography long_name = slope of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -125,7 +125,7 @@ standard_name = anisotropy_of_subgrid_orography long_name = anisotropy of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -134,7 +134,7 @@ standard_name = maximum_subgrid_orography long_name = maximum of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -159,7 +159,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -168,7 +168,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -177,7 +177,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -186,7 +186,7 @@ standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in x wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -195,7 +195,7 @@ standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in y wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -204,7 +204,7 @@ standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag long_name = cumulative change in temperature due to orographic gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -283,7 +283,7 @@ standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -292,7 +292,7 @@ standard_name = instantaneous_y_stress_due_to_gravity_wave_drag long_name = meridional surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -301,7 +301,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -310,7 +310,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -319,7 +319,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -328,7 +328,7 @@ standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag long_name = integral over time of zonal stress due to gravity wave drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -337,7 +337,7 @@ standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag long_name = integral over time of meridional stress due to gravity wave drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -346,7 +346,7 @@ standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in zonal wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -355,7 +355,7 @@ standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in meridional wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -364,7 +364,7 @@ standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag long_name = cumulative change in temperature due to orographic gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 1850a6759..981f5478d 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -75,7 +75,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -84,7 +84,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -93,7 +93,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -102,7 +102,7 @@ standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -111,7 +111,7 @@ standard_name = tracer_concentration_save long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -327,7 +327,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -336,7 +336,7 @@ standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -345,7 +345,7 @@ standard_name = random_number_array long_name = random number array (0-1) units = none - dimensions = (horizontal_dimension,array_dimension_of_random_number) + dimensions = (horizontal_loop_extent,array_dimension_of_random_number) type = real kind = kind_phys intent = in @@ -354,7 +354,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -363,7 +363,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -372,7 +372,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -381,7 +381,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -390,7 +390,7 @@ standard_name = air_pressure long_name = layer mean pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -399,7 +399,7 @@ standard_name = air_pressure_at_interface long_name = pressure at layer interface units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -408,7 +408,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -417,7 +417,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -426,7 +426,7 @@ standard_name = lwe_thickness_of_ice_amount_on_dynamics_timestep long_name = ice fall at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -435,7 +435,7 @@ standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep long_name = snow fall at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -444,7 +444,7 @@ standard_name = lwe_thickness_of_graupel_amount_on_dynamics_timestep long_name = graupel fall at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -453,7 +453,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -462,7 +462,7 @@ standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -471,7 +471,7 @@ standard_name = lwe_thickness_of_explicit_rain_amount long_name = explicit rain on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -480,7 +480,7 @@ standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -489,7 +489,7 @@ standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -498,7 +498,7 @@ standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -507,7 +507,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between midlayers units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -516,7 +516,7 @@ standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -525,7 +525,7 @@ standard_name = dominant_rain_type long_name = dominant rain type units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -534,7 +534,7 @@ standard_name = dominant_freezing_rain_type long_name = dominant freezing rain type units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -543,7 +543,7 @@ standard_name = dominant_sleet_type long_name = dominant sleet type units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -552,7 +552,7 @@ standard_name = dominant_snow_type long_name = dominant snow type units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -561,7 +561,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total precipitation amount in each time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -570,7 +570,7 @@ standard_name = flag_for_precipitation_type long_name = snow/rain flag for precipitation units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -579,7 +579,7 @@ standard_name = ratio_of_snowfall_to_rainfall long_name = snow ratio: ratio of snow to total precipitation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -588,7 +588,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount long_name = cumulative convective precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -597,7 +597,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount long_name = accumulated total precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -606,7 +606,7 @@ standard_name = accumulated_lwe_thickness_of_ice_amount long_name = accumulated ice precipitation units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -615,7 +615,7 @@ standard_name = accumulated_lwe_thickness_of_snow_amount long_name = accumulated snow precipitation units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -624,7 +624,7 @@ standard_name = accumulated_lwe_thickness_of_graupel_amount long_name = accumulated graupel precipitation units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -633,7 +633,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket long_name = cumulative convective precipitation in bucket units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -642,7 +642,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket long_name = accumulated total precipitation in bucket units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -651,7 +651,7 @@ standard_name = accumulated_lwe_thickness_of_ice_amount_in_bucket long_name = accumulated ice precipitation in bucket units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -660,7 +660,7 @@ standard_name = accumulated_lwe_thickness_of_snow_amount_in_bucket long_name = accumulated snow precipitation in bucket units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -669,7 +669,7 @@ standard_name = accumulated_lwe_thickness_of_graupel_amount_in_bucket long_name = accumulated graupel precipitation in bucket units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -678,7 +678,7 @@ standard_name = cumulative_change_in_temperature_due_to_microphysics long_name = cumulative change in temperature due to microphysics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -687,7 +687,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_microphysics long_name = cumulative change in water vapor specific humidity due to microphysics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -696,7 +696,7 @@ standard_name = lwe_thickness_of_precipitation_amount_for_coupling long_name = total rain precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -705,7 +705,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_for_coupling long_name = total convective precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -714,7 +714,7 @@ standard_name = lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -723,7 +723,7 @@ standard_name = column_precipitable_water long_name = precipitable water units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -748,7 +748,7 @@ standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -757,7 +757,7 @@ standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky long_name = clear sky radiative (shortwave + longwave) heating rate at current time units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -766,7 +766,7 @@ standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling long_name = change in rain_cpl (coupling_type) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -775,7 +775,7 @@ standard_name = tendency_of_lwe_thickness_of_snow_amount_for_coupling long_name = change in show_cpl (coupling_type) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -808,7 +808,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep long_name = convective_precipitation_amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -817,7 +817,7 @@ standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep long_name = explicit rainfall from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -826,7 +826,7 @@ standard_name = lwe_thickness_of_ice_amount_from_previous_timestep long_name = ice amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -835,7 +835,7 @@ standard_name = lwe_thickness_of_snow_amount_from_previous_timestep long_name = snow amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -844,7 +844,7 @@ standard_name = lwe_thickness_of_graupel_amount_from_previous_timestep long_name = graupel amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -853,7 +853,7 @@ standard_name = convective_precipitation_rate_from_previous_timestep long_name = convective precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -862,7 +862,7 @@ standard_name = explicit_rainfall_rate_from_previous_timestep long_name = explicit rainfall rate previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -871,7 +871,7 @@ standard_name = ice_precipitation_rate_from_previous_timestep long_name = ice precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -880,7 +880,7 @@ standard_name = snow_precipitation_rate_from_previous_timestep long_name = snow precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -889,7 +889,7 @@ standard_name = graupel_precipitation_rate_from_previous_timestep long_name = graupel precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 972af4859..5e83b8ad4 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -299,7 +299,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -308,7 +308,7 @@ standard_name = vertically_diffused_tracer_concentration long_name = tracer concentration diffused by PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -317,7 +317,7 @@ standard_name = x_wind_save long_name = x-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -326,7 +326,7 @@ standard_name = y_wind_save long_name = y-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -335,7 +335,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -344,7 +344,7 @@ standard_name = tracer_concentration_save long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = out @@ -377,7 +377,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -386,7 +386,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -395,7 +395,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -784,7 +784,7 @@ standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = in @@ -793,7 +793,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = surface momentum flux in the x-direction valid for current call units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -802,7 +802,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = surface momentum flux in the y-direction valid for current call units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -811,7 +811,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux valid for current call units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -820,7 +820,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux valid for current call units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -838,7 +838,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -847,7 +847,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -856,7 +856,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -865,7 +865,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -874,7 +874,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -883,7 +883,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -892,7 +892,7 @@ standard_name = tendency_of_tracers_due_to_model_physics long_name = updated tendency of the tracers due to model physics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -901,7 +901,7 @@ standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc u momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -910,7 +910,7 @@ standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc v momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -919,7 +919,7 @@ standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -928,7 +928,7 @@ standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -937,7 +937,7 @@ standard_name = instantaneous_surface_x_momentum_flux_for_coupling long_name = instantaneous sfc u momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -946,7 +946,7 @@ standard_name = instantaneous_surface_y_momentum_flux_for_coupling long_name = instantaneous sfc v momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -955,7 +955,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux_for_coupling long_name = instantaneous sfc sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -964,7 +964,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -973,7 +973,7 @@ standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc x momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -982,7 +982,7 @@ standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc y momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -991,7 +991,7 @@ standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1000,7 +1000,7 @@ standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1009,7 +1009,7 @@ standard_name = instantaneous_surface_x_momentum_flux_for_diag long_name = instantaneous sfc x momentum flux multiplied by timestep units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1018,7 +1018,7 @@ standard_name = instantaneous_surface_y_momentum_flux_for_diag long_name = instantaneous sfc y momentum flux multiplied by timestep units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1027,7 +1027,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag long_name = instantaneous sfc sensible heat flux multiplied by timestep units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1036,7 +1036,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux_for_diag long_name = instantaneous sfc latent heat flux multiplied by timestep units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1045,7 +1045,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1054,7 +1054,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1063,7 +1063,7 @@ standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in x wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1072,7 +1072,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1081,7 +1081,7 @@ standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in y wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1090,7 +1090,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1099,7 +1099,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1144,7 +1144,7 @@ standard_name = air_temperature_at_lowest_model_layer_for_diag long_name = layer 1 temperature for diag units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1153,7 +1153,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer_for_diag long_name = layer 1 specific humidity for diag units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1162,7 +1162,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1171,7 +1171,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1180,7 +1180,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux_for_chemistry_coupling long_name = instantaneous upward sensible heat flux for chemistry coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1189,7 +1189,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1198,7 +1198,7 @@ standard_name = flag_for_cice long_name = flag for cice units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -1206,7 +1206,7 @@ standard_name = surface_x_momentum_flux_for_coupling long_name = sfc x momentum flux for coupling units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1215,7 +1215,7 @@ standard_name = surface_y_momentum_flux_for_coupling long_name = sfc y momentum flux for coupling units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1224,7 +1224,7 @@ standard_name = surface_upward_sensible_heat_flux_for_coupling long_name = sfc sensible heat flux for coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1233,7 +1233,7 @@ standard_name = surface_upward_latent_heat_flux_for_coupling long_name = sfc latent heat flux for coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1242,7 +1242,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -1250,7 +1250,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -1258,7 +1258,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -1266,7 +1266,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1275,7 +1275,7 @@ standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1284,7 +1284,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1293,7 +1293,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1302,7 +1302,7 @@ standard_name = x_wind_at_lowest_model_layer long_name = zonal wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1311,7 +1311,7 @@ standard_name = y_wind_at_lowest_model_layer long_name = meridional wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1320,7 +1320,7 @@ standard_name = instantaneous_atmosphere_heat_diffusivity long_name = instantaneous atmospheric heat diffusivity units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1329,7 +1329,7 @@ standard_name = atmosphere_heat_diffusivity long_name = diffusivity for heat units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) type = real kind = kind_phys intent = in @@ -1338,7 +1338,7 @@ standard_name = surface_upward_latent_heat_flux_reduction_factor long_name = surface upward latent heat flux reduction factor from canopy heat storage units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1347,7 +1347,7 @@ standard_name = surface_upward_sensible_heat_flux_reduction_factor long_name = surface upward sensible heat flux reduction factor from canopy heat storage units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1356,7 +1356,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1365,7 +1365,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1374,7 +1374,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1383,7 +1383,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -1392,7 +1392,7 @@ standard_name = x_wind_save long_name = x-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1401,7 +1401,7 @@ standard_name = y_wind_save long_name = y-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1410,7 +1410,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1419,7 +1419,7 @@ standard_name = tracer_concentration_save long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in diff --git a/physics/GFS_SCNV_generic.meta b/physics/GFS_SCNV_generic.meta index 47fd151af..a3122da71 100644 --- a/physics/GFS_SCNV_generic.meta +++ b/physics/GFS_SCNV_generic.meta @@ -43,7 +43,7 @@ standard_name = x_wind_updated_by_physics long_name = updated x-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -52,7 +52,7 @@ standard_name = y_wind_updated_by_physics long_name = updated y-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -61,7 +61,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -70,7 +70,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -79,7 +79,7 @@ standard_name = x_wind_save long_name = x-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -88,7 +88,7 @@ standard_name = y_wind_save long_name = y-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -97,7 +97,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -106,7 +106,7 @@ standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -216,7 +216,7 @@ standard_name = x_wind_updated_by_physics long_name = updated x-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -225,7 +225,7 @@ standard_name = y_wind_updated_by_physics long_name = updated y-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -234,7 +234,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -243,7 +243,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = x_wind_save long_name = x-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -261,7 +261,7 @@ standard_name = y_wind_save long_name = y-wind before entering a physics scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -270,7 +270,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -279,7 +279,7 @@ standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -288,7 +288,7 @@ standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection long_name = instantaneous moisture tendency due to convection units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -297,7 +297,7 @@ standard_name = cumulative_change_in_x_wind_due_to_shallow_convection long_name = cumulative change in x wind due to shallow convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -306,7 +306,7 @@ standard_name = cumulative_change_in_y_wind_due_to_shallow_convection long_name = cumulative change in y wind due to shallow convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -315,7 +315,7 @@ standard_name = cumulative_change_in_temperature_due_to_shallow_convection long_name = cumulative change in temperature due to shal conv. units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -324,7 +324,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shallow_convection long_name = cumulative change in water vapor specific humidity due to shal conv. units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -333,7 +333,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout @@ -350,7 +350,7 @@ standard_name = lwe_thickness_of_shallow_convective_precipitation_amount long_name = shallow convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -383,7 +383,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -392,7 +392,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -401,7 +401,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -410,7 +410,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount long_name = cumulative convective precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -419,7 +419,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket long_name = cumulative convective precipitation in bucket units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -428,7 +428,7 @@ standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d long_name = convective cloud water mixing ratio in the phy_f3d array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -437,7 +437,7 @@ standard_name = convective_cloud_cover_in_phy_f3d long_name = convective cloud cover in the phy_f3d array units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_cloud_diagnostics.meta b/physics/GFS_cloud_diagnostics.meta index 3778d6036..840b3b21a 100644 --- a/physics/GFS_cloud_diagnostics.meta +++ b/physics/GFS_cloud_diagnostics.meta @@ -42,7 +42,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real intent = in kind = kind_phys @@ -51,7 +51,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -60,7 +60,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -69,7 +69,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -78,7 +78,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = out optional = F @@ -86,7 +86,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = out optional = F @@ -94,7 +94,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -103,7 +103,7 @@ standard_name = layer_thickness long_name = layer_thickness units = m - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -112,7 +112,7 @@ standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -121,7 +121,7 @@ standard_name = precip_overlap_param long_name = precipitation overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -139,7 +139,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = out diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta index d93e22328..2595da086 100644 --- a/physics/GFS_debug.meta +++ b/physics/GFS_debug.meta @@ -367,7 +367,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -375,7 +375,7 @@ standard_name = flag_for_guess_run long_name = flag for guess run units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -423,7 +423,7 @@ standard_name = soil_type_classification_real long_name = soil type for lsm units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -432,7 +432,7 @@ standard_name = vegetation_type_classification_real long_name = vegetation type for lsm units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -441,7 +441,7 @@ standard_name = surface_slope_classification_real long_name = sfc slope type for lsm units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -450,7 +450,7 @@ standard_name = soil_type_classification long_name = soil type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -458,7 +458,7 @@ standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -466,7 +466,7 @@ standard_name = surface_slope_classification long_name = surface slope type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -474,7 +474,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -482,7 +482,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -490,7 +490,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -498,7 +498,7 @@ standard_name = flag_nonzero_lake_surface_fraction long_name = flag indicating some lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -506,7 +506,7 @@ standard_name = flag_nonzero_ocean_surface_fraction long_name = flag indicating some ocean surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -514,7 +514,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -523,7 +523,7 @@ standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -532,7 +532,7 @@ standard_name = lake_area_fraction long_name = fraction of horizontal grid area occupied by lake units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -541,7 +541,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -550,7 +550,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F diff --git a/physics/GFS_rrtmg_post.meta b/physics/GFS_rrtmg_post.meta index 43c25ae2e..44cd22d5c 100644 --- a/physics/GFS_rrtmg_post.meta +++ b/physics/GFS_rrtmg_post.meta @@ -59,7 +59,7 @@ standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = in optional = F @@ -124,7 +124,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = in @@ -133,7 +133,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = in @@ -142,7 +142,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -150,7 +150,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -158,7 +158,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = cloud_optical_depth_layers_at_10mu_band long_name = approx 10mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = cloud_optical_depth_layers_at_0p55mu_band long_name = approx .55mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index dd1825e08..30b219aaf 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -75,7 +75,7 @@ standard_name = fraction_of_ice_water_cloud long_name = fraction of ice water cloud units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -84,7 +84,7 @@ standard_name = fraction_of_rain_water_cloud long_name = fraction of rain water cloud units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -93,7 +93,7 @@ standard_name = rime_factor long_name = rime factor units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -111,7 +111,7 @@ standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics long_name = total cloud condensate mixing ratio (except water vapor) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -185,7 +185,7 @@ standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness on radiation levels units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -194,7 +194,7 @@ standard_name = layer_thickness_for_radiation long_name = layer thickness on radiation levels units = km - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -203,7 +203,7 @@ standard_name = air_pressure_at_interface_for_radiation_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -212,7 +212,7 @@ standard_name = air_pressure_at_layer_for_radiation_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -221,7 +221,7 @@ standard_name = air_temperature_at_interface_for_radiation long_name = air temperature at vertical interface for radiation calculation units = K - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -230,7 +230,7 @@ standard_name = air_temperature_at_layer_for_radiation long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -239,7 +239,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -248,7 +248,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -257,7 +257,7 @@ standard_name = water_vapor_specific_humidity_at_layer_for_radiation long_name = water vapor specific humidity at vertical layer for radiation calculation units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -266,7 +266,7 @@ standard_name = ozone_concentration_at_layer_for_radiation long_name = ozone concentration units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -291,7 +291,7 @@ standard_name = volume_mixing_ratio_co2 long_name = CO2 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -300,7 +300,7 @@ standard_name = volume_mixing_ratio_n2o long_name = N2O volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -309,7 +309,7 @@ standard_name = volume_mixing_ratio_ch4 long_name = CH4 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -318,7 +318,7 @@ standard_name = volume_mixing_ratio_o2 long_name = O2 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -327,7 +327,7 @@ standard_name = volume_mixing_ratio_co long_name = CO volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -336,7 +336,7 @@ standard_name = volume_mixing_ratio_cfc11 long_name = CFC11 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -345,7 +345,7 @@ standard_name = volume_mixing_ratio_cfc12 long_name = CFC12 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -354,7 +354,7 @@ standard_name = volume_mixing_ratio_cfc22 long_name = CFC22 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -363,7 +363,7 @@ standard_name = volume_mixing_ratio_ccl4 long_name = CCL4 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -372,7 +372,7 @@ standard_name = volume_mixing_ratio_cfc113 long_name = CFC113 volume mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -381,7 +381,7 @@ standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 long_name = aerosol optical depth for shortwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = out @@ -390,7 +390,7 @@ standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 long_name = aerosol single scattering albedo for shortwave bands 01-16 units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = out @@ -399,7 +399,7 @@ standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 long_name = aerosol asymmetry parameter for shortwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = out @@ -408,7 +408,7 @@ standard_name = aerosol_optical_depth_for_longwave_bands_01_16 long_name = aerosol optical depth for longwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = out @@ -417,7 +417,7 @@ standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 long_name = aerosol single scattering albedo for longwave bands 01-16 units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = out @@ -426,7 +426,7 @@ standard_name = aerosol_asymmetry_parameter_for_longwave_bands_01_16 long_name = aerosol asymmetry parameter for longwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = out @@ -435,7 +435,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = out @@ -444,7 +444,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -453,7 +453,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -462,7 +462,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -471,7 +471,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -480,7 +480,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -489,7 +489,7 @@ standard_name = cloud_rain_water_path long_name = cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -498,7 +498,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -507,7 +507,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -516,7 +516,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -525,7 +525,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle,high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = out @@ -534,7 +534,7 @@ standard_name = instantaneous_3d_cloud_fraction long_name = instantaneous 3D cloud fraction for all MPs units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -543,7 +543,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = out optional = F @@ -551,7 +551,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = out optional = F @@ -559,7 +559,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -568,7 +568,7 @@ standard_name = surface_albedo_perturbation long_name = surface albedo perturbation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 7e0797538..7720bdc1d 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -115,7 +115,7 @@ standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -124,7 +124,7 @@ standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -133,7 +133,7 @@ standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um long_name = effective radius of cloud rain particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -142,7 +142,7 @@ standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -168,7 +168,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real intent = in kind = kind_phys @@ -177,7 +177,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -186,7 +186,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -195,7 +195,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -204,7 +204,7 @@ standard_name = chemical_tracers long_name = chemical tracers units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -249,7 +249,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -258,7 +258,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -267,7 +267,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -276,7 +276,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -285,7 +285,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -294,7 +294,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -303,7 +303,7 @@ standard_name = cloud_snow_water_path long_name = layer cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -312,7 +312,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -321,7 +321,7 @@ standard_name = cloud_rain_water_path long_name = layer cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -330,7 +330,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -339,7 +339,7 @@ standard_name = precipitation_fraction_by_layer long_name = precipitation fraction in each layer units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -348,7 +348,7 @@ standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -357,7 +357,7 @@ standard_name = precip_overlap_param long_name = precipitation overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -366,7 +366,7 @@ standard_name = layer_thickness long_name = layer_thickness units = m - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index a786da2e8..51a6c4c41 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -60,7 +60,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -69,7 +69,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -78,7 +78,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -87,7 +87,7 @@ standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -96,7 +96,7 @@ standard_name = RRTMGP_lw_flux_profile_downward_allsky long_name = RRTMGP downward longwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -105,7 +105,7 @@ standard_name = RRTMGP_lw_flux_profile_upward_clrsky long_name = RRTMGP upward longwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -114,7 +114,7 @@ standard_name = RRTMGP_lw_flux_profile_downward_clrsky long_name = RRTMGP downward longwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -132,7 +132,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = in @@ -141,7 +141,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = in @@ -150,7 +150,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -158,7 +158,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -166,7 +166,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -175,7 +175,7 @@ standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band long_name = approx 10mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -184,7 +184,7 @@ standard_name = surface_downwelling_longwave_flux_on_radiation_time_step long_name = total sky sfc downward lw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -193,7 +193,7 @@ standard_name = lw_fluxes_sfc long_name = lw radiation fluxes at sfc units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcflw_type intent = out optional = F @@ -201,7 +201,7 @@ standard_name = surface_midlayer_air_temperature_in_longwave_radiation long_name = surface air temp during lw calculation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -210,7 +210,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -219,7 +219,7 @@ standard_name = lw_fluxes_top_atmosphere long_name = lw radiation fluxes at top units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = topflw_type intent = out optional = F @@ -227,7 +227,7 @@ standard_name = RRTMGP_lw_fluxes long_name = lw fluxes total sky / csk and up / down at levels units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = proflw_type intent = out optional = T @@ -235,7 +235,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = longwave clear sky heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 2e27f46ac..7fa69c0f6 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -134,7 +134,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -143,7 +143,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -152,7 +152,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -161,7 +161,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -170,7 +170,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -179,7 +179,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -188,7 +188,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -197,7 +197,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -260,7 +260,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -269,7 +269,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -278,7 +278,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -287,7 +287,7 @@ standard_name = air_temperature_at_interface_for_RRTMGP long_name = air temperature at vertical interface for radiation calculation units = K - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -296,7 +296,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -305,7 +305,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -314,7 +314,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -323,7 +323,7 @@ standard_name = relative_humidity long_name = layer relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -332,7 +332,7 @@ standard_name = chemical_tracers long_name = chemical tracers units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 128e66fac..0610537fd 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -36,7 +36,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -77,7 +77,7 @@ standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -86,7 +86,7 @@ standard_name = daytime_mean_cosz_over_rad_call_period long_name = daytime mean cosz over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -95,7 +95,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -104,7 +104,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -113,7 +113,7 @@ standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -122,7 +122,7 @@ standard_name = surface_albedo_nearIR_diffuse long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -131,7 +131,7 @@ standard_name = surface_albedo_uvvis_dir long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -140,7 +140,7 @@ standard_name = surface_albedo_uvvis_dif long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -149,7 +149,7 @@ standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -158,7 +158,7 @@ standard_name = RRTMGP_sw_flux_profile_downward_allsky long_name = RRTMGP downward shortwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = RRTMGP_sw_flux_profile_upward_clrsky long_name = RRTMGP upward shortwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = RRTMGP_sw_flux_profile_downward_clrsky long_name = RRTMGP downward shortwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = in @@ -212,7 +212,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -220,7 +220,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = in optional = F @@ -228,7 +228,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -237,7 +237,7 @@ standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band long_name = approx .55mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -254,7 +254,7 @@ standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir beam sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -263,7 +263,7 @@ standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir diff sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -272,7 +272,7 @@ standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis beam sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -281,7 +281,7 @@ standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis diff sw downward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -290,7 +290,7 @@ standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir beam sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -299,7 +299,7 @@ standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = sfc nir diff sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -308,7 +308,7 @@ standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis beam sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -317,7 +317,7 @@ standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = sfc uv+vis diff sw upward flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -326,7 +326,7 @@ standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky sfc netsw flx into ground units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -335,7 +335,7 @@ standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -344,7 +344,7 @@ standard_name = sw_fluxes_sfc long_name = sw radiation fluxes at sfc units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcfsw_type intent = out optional = F @@ -352,7 +352,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -361,7 +361,7 @@ standard_name = sw_fluxes_top_atmosphere long_name = sw radiation fluxes at toa units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = topfsw_type intent = out optional = F @@ -369,7 +369,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky sw heating rates units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -378,7 +378,7 @@ standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = in optional = T @@ -386,7 +386,7 @@ standard_name = RRTMGP_sw_fluxes long_name = sw fluxes total sky / csk and up / down at levels units = W m-2 - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_plus_one) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_plus_one) type = profsw_type intent = out optional = T diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 81ed3137e..91e875c00 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -86,7 +86,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -95,7 +95,7 @@ standard_name = cosine_of_latitude long_name = cosine of latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -104,7 +104,7 @@ standard_name = sine_of_latitude long_name = sine of latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -113,7 +113,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -122,7 +122,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -131,7 +131,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -140,7 +140,7 @@ standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -149,7 +149,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -158,7 +158,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = mean_vis_albedo_with_strong_cosz_dependency long_name = mean vis albedo with strong cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = mean_nir_albedo_with_strong_cosz_dependency long_name = mean nir albedo with strong cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = mean_vis_albedo_with_weak_cosz_dependency long_name = mean vis albedo with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = mean_nir_albedo_with_weak_cosz_dependency long_name = mean nir albedo with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -212,7 +212,7 @@ standard_name =fractional_coverage_with_strong_cosz_dependency long_name = fractional coverage with strong cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -221,7 +221,7 @@ standard_name = fractional_coverage_with_weak_cosz_dependency long_name = fractional coverage with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -230,7 +230,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -239,7 +239,7 @@ standard_name = sea_ice_temperature long_name = sea ice surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -248,7 +248,7 @@ standard_name = weights_for_stochastic_surface_physics_perturbation long_name = weights for stochastic surface physics perturbation units = none - dimensions = (horizontal_dimension,number_of_surface_perturbations) + dimensions = (horizontal_loop_extent,number_of_surface_perturbations) type = real kind = kind_phys intent = in @@ -257,7 +257,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -266,7 +266,7 @@ standard_name = relative_humidity long_name = layer relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -275,7 +275,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -284,7 +284,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -301,7 +301,7 @@ standard_name = surface_albedo_perturbation long_name = surface albedo perturbation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -310,7 +310,7 @@ standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -319,7 +319,7 @@ standard_name = surface_albedo_nearIR_diffuse long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -328,7 +328,7 @@ standard_name = surface_albedo_uvvis_dir long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -337,7 +337,7 @@ standard_name = surface_albedo_uvvis_dif long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -354,7 +354,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -362,7 +362,7 @@ standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -371,7 +371,7 @@ standard_name = daytime_mean_cosz_over_rad_call_period long_name = daytime mean cosz over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -380,7 +380,7 @@ standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused sw albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta index 11aac8437..06bff5eb1 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.meta +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -91,7 +91,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real intent = in kind = kind_phys @@ -99,7 +99,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -108,7 +108,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -117,7 +117,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -126,7 +126,7 @@ standard_name = relative_humidity long_name = layer relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -135,7 +135,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature at vertical layer for radiation calculation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -144,7 +144,7 @@ standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -153,7 +153,7 @@ standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -162,7 +162,7 @@ standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um long_name = effective radius of cloud rain particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -171,7 +171,7 @@ standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -180,7 +180,7 @@ standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -189,7 +189,7 @@ standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d long_name = convective cloud water mixing ratio in the phy_f3d array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -198,7 +198,7 @@ standard_name = chemical_tracers long_name = chemical tracers units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -207,7 +207,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -288,7 +288,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -297,7 +297,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -306,7 +306,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -315,7 +315,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -324,7 +324,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -333,7 +333,7 @@ standard_name = cloud_snow_water_path long_name = layer cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -342,7 +342,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -351,7 +351,7 @@ standard_name = cloud_rain_water_path long_name = layer cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -360,7 +360,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -369,7 +369,7 @@ standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -378,7 +378,7 @@ standard_name = layer_thickness long_name = layer_thickness units = m - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -387,7 +387,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index c729a3980..43c7b2d42 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -83,7 +83,7 @@ standard_name = cellular_automata_global_pattern long_name = cellular automata global pattern units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -110,7 +110,7 @@ standard_name = level_of_dividing_streamline long_name = level of the dividing streamline units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -119,7 +119,7 @@ standard_name = weights_for_stochastic_sppt_perturbation long_name = weights for stochastic sppt perturbation units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -128,7 +128,7 @@ standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind long_name = weights for stochastic skeb perturbation of x wind units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind long_name = weights for stochastic skeb perturbation of y wind units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -146,7 +146,7 @@ standard_name = weights_for_stochastic_shum_perturbation long_name = weights for stochastic shum perturbation units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -155,7 +155,7 @@ standard_name = weights_for_stochastic_sppt_perturbation_flipped long_name = weights for stochastic sppt perturbation, flipped units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -164,7 +164,7 @@ standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind_flipped long_name = weights for stochastic skeb perturbation of x wind, flipped units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -173,7 +173,7 @@ standard_name = weights_for_stochastic_skeb_perturbation_of_y_wind_flipped long_name = weights for stochastic skeb perturbation of y wind, flipped units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -182,7 +182,7 @@ standard_name = weights_for_stochastic_shum_perturbation_flipped long_name = weights for stochastic shum perturbation, flipped units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -191,7 +191,7 @@ standard_name = dissipation_estimate_of_air_temperature_at_model_layers long_name = dissipation estimate model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -200,7 +200,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -209,7 +209,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -218,7 +218,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -227,7 +227,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -236,7 +236,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -245,7 +245,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -254,7 +254,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -263,7 +263,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -272,7 +272,7 @@ standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -281,7 +281,7 @@ standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -290,7 +290,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -299,7 +299,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total precipitation amount in each time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -308,7 +308,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount long_name = accumulated total precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -317,7 +317,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount long_name = cumulative convective precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -326,7 +326,7 @@ standard_name = accumulated_lwe_thickness_of_precipitation_amount_in_bucket long_name = accumulated total precipitation in bucket units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -335,7 +335,7 @@ standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_in_bucket long_name = cumulative convective precipitation in bucket units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -352,7 +352,7 @@ standard_name = lwe_thickness_of_precipitation_amount_for_coupling long_name = total rain precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -361,7 +361,7 @@ standard_name = lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -370,7 +370,7 @@ standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling long_name = change in rain_cpl (coupling_type) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -379,7 +379,7 @@ standard_name = tendency_of_lwe_thickness_of_snow_amount_for_coupling long_name = change in show_cpl (coupling_type) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 823874a0d..1e8849251 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -141,7 +141,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -150,7 +150,7 @@ standard_name = cell_area long_name = area of the grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -177,7 +177,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -186,7 +186,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -194,7 +194,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes long_name = grid size related coefficient used in scale-sensitive schemes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -203,7 +203,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement long_name = complement to work1 units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -212,7 +212,7 @@ standard_name = surface_air_pressure_diag long_name = surface air pressure diagnostic units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -221,7 +221,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -230,7 +230,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -239,7 +239,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -248,7 +248,7 @@ standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky long_name = clear sky radiative (shortwave + longwave) heating rate at current time units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -257,7 +257,7 @@ standard_name = tendency_of_tracers_due_to_model_physics long_name = updated tendency of the tracers units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = out @@ -342,7 +342,7 @@ standard_name = flag_for_cice long_name = flag for cice units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -407,7 +407,7 @@ standard_name = instantaneous_cosine_of_zenith_angle long_name = cosine of zenith angle at current time units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -416,7 +416,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -425,7 +425,7 @@ standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -434,7 +434,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -443,7 +443,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -452,7 +452,7 @@ standard_name = surface_upwelling_longwave_flux_for_coupling long_name = surface upwelling longwave flux for coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -461,7 +461,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_for_idea long_name = idea sky lw heating rates units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension,6) + dimensions = (horizontal_loop_extent,vertical_dimension,6) type = real kind = kind_phys intent = in @@ -470,7 +470,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -479,7 +479,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -488,7 +488,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave fluxes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -506,7 +506,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes long_name = grid size related coefficient used in scale-sensitive schemes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -515,7 +515,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement long_name = complement to work1 units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -524,7 +524,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -533,7 +533,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -542,7 +542,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -551,7 +551,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -560,7 +560,7 @@ standard_name = cloud_condensed_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -587,7 +587,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -596,7 +596,7 @@ standard_name = duration_of_sunshine long_name = sunshine duration time units = s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -605,7 +605,7 @@ standard_name = surface_upwelling_longwave_flux long_name = surface upwelling longwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -614,7 +614,7 @@ standard_name = surface_upwelling_longwave_flux_over_land_interstitial long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -623,7 +623,7 @@ standard_name = surface_upwelling_longwave_flux_over_ice_interstitial long_name = surface upwelling longwave flux at current time over ice (temporary use as interstitial) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -632,7 +632,7 @@ standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -641,7 +641,7 @@ standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep long_name = cumulative surface downwelling LW flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -650,7 +650,7 @@ standard_name = cumulative_surface_upwelling_longwave_flux_multiplied_by_timestep long_name = cumulative surface upwelling LW flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -659,7 +659,7 @@ standard_name = cumulative_surface_pressure_multiplied_by_timestep long_name = cumulative surface pressure multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -668,7 +668,7 @@ standard_name = cumulative_change_in_temperature_due_to_longwave_radiation long_name = cumulative change in temperature due to longwave radiation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -677,7 +677,7 @@ standard_name = cumulative_change_in_temperature_due_to_shortwave_radiation long_name = cumulative change in temperature due to shortwave radiation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -686,7 +686,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -695,7 +695,7 @@ standard_name = cumulative_change_in_temperature_due_to_deep_convection long_name = cumulative change in temperature due to deep conv. units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -704,7 +704,7 @@ standard_name = cumulative_change_in_temperature_due_to_shallow_convection long_name = cumulative change in temperature due to shal conv. units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -713,7 +713,7 @@ standard_name = cumulative_change_in_temperature_due_to_microphysics long_name = cumulative change in temperature due to microphysics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -722,7 +722,7 @@ standard_name = grid_sensitive_critical_cloud_top_entrainment_instability_criteria long_name = grid sensitive critical cloud top entrainment instability criteria units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -731,7 +731,7 @@ standard_name = cloud_top_entrainment_instability_value long_name = cloud top entrainment instability value units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -740,7 +740,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -748,7 +748,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -756,7 +756,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -764,7 +764,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -772,7 +772,7 @@ standard_name = land_area_fraction_for_microphysics long_name = land area fraction used in microphysics schemes units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -798,7 +798,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = air temperature at lowest model layer units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -807,7 +807,7 @@ standard_name = surface_skin_temperature_at_previous_time_step long_name = surface skin temperature at previous time step units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -816,7 +816,7 @@ standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -825,7 +825,7 @@ standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward long_name = RRTMGP Jacobian upward longwave flux profile units = W m-2 K-1 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -886,7 +886,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -895,7 +895,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -904,7 +904,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -913,7 +913,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -922,7 +922,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -931,7 +931,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -940,7 +940,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -949,7 +949,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = out @@ -1019,7 +1019,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1028,7 +1028,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1037,7 +1037,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1046,7 +1046,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -1055,7 +1055,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1064,7 +1064,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1073,7 +1073,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1082,7 +1082,7 @@ standard_name = tendency_of_tracers_due_to_model_physics long_name = updated tendency of the tracers units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -1091,7 +1091,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1100,7 +1100,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1109,7 +1109,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1118,7 +1118,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = out @@ -1299,7 +1299,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1308,7 +1308,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1317,7 +1317,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1326,7 +1326,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -1399,7 +1399,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -1408,7 +1408,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1417,7 +1417,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1462,7 +1462,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -1470,7 +1470,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes long_name = grid size related coefficient used in scale-sensitive schemes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1479,7 +1479,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement long_name = complement to work1 units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1488,7 +1488,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -1496,7 +1496,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -1520,7 +1520,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout @@ -1529,7 +1529,7 @@ standard_name = critical_relative_humidity long_name = critical relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1538,7 +1538,7 @@ standard_name = cloud_condensed_water_mixing_ratio_save long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1547,7 +1547,7 @@ standard_name = ice_water_mixing_ratio_save long_name = cloud ice water mixing ratio before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1556,7 +1556,7 @@ standard_name = air_temperature_save_from_convective_parameterization long_name = air temperature after cumulus parameterization units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1786,7 +1786,7 @@ standard_name = cloud_condensed_water_mixing_ratio_save long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1795,7 +1795,7 @@ standard_name = ice_water_mixing_ratio_save long_name = cloud ice water mixing ratio before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1813,7 +1813,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -1822,7 +1822,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout @@ -1831,7 +1831,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1840,7 +1840,7 @@ standard_name = air_temperature_save_from_convective_parameterization long_name = air temperature after cumulus parameterization units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1858,7 +1858,7 @@ standard_name = water_friendly_aerosol_number_concentration long_name = number concentration of water-friendly aerosols units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1867,7 +1867,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1876,7 +1876,7 @@ standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection long_name = instantaneous moisture tendency due to convection units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1961,7 +1961,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -1970,7 +1970,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index e3c46d20e..71765b9a2 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -35,7 +35,7 @@ standard_name = flag_for_cice long_name = flag for cice units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -59,7 +59,7 @@ standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -68,7 +68,7 @@ standard_name = lake_area_fraction long_name = fraction of horizontal grid area occupied by lake units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -77,7 +77,7 @@ standard_name = lake_depth long_name = lake depth units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -86,7 +86,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -95,7 +95,7 @@ standard_name = land_area_fraction_for_microphysics long_name = land area fraction used in microphysics schemes units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -104,7 +104,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -112,7 +112,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -120,7 +120,7 @@ standard_name = flag_nonzero_lake_surface_fraction long_name = flag indicating presence of some lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -128,7 +128,7 @@ standard_name = flag_nonzero_ocean_surface_fraction long_name = flag indicating presence of some ocean surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -136,7 +136,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -144,7 +144,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -162,7 +162,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -171,7 +171,7 @@ standard_name = surface_roughness_length_over_ocean long_name = surface roughness length over ocean units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -180,7 +180,7 @@ standard_name = surface_roughness_length_over_land long_name = surface roughness length over land units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -189,7 +189,7 @@ standard_name = surface_roughness_length_over_ice long_name = surface roughness length over ice units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -198,7 +198,7 @@ standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -207,7 +207,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -216,7 +216,7 @@ standard_name = surface_roughness_length_over_ice_interstitial long_name = surface roughness length over ice (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -225,7 +225,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -234,7 +234,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -243,7 +243,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -252,7 +252,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -261,7 +261,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total precipitation amount in each time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -270,7 +270,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean long_name = total precipitation amount in each time step over ocean units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -279,7 +279,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land long_name = total precipitation amount in each time step over land units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -288,7 +288,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice long_name = total precipitation amount in each time step over ice units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -297,7 +297,7 @@ standard_name = surface_friction_velocity long_name = boundary layer parameter units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -306,7 +306,7 @@ standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -315,7 +315,7 @@ standard_name = surface_friction_velocity_over_land long_name = surface friction velocity over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -324,7 +324,7 @@ standard_name = surface_friction_velocity_over_ice long_name = surface friction velocity over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -333,7 +333,7 @@ standard_name = water_equivalent_accumulated_snow_depth long_name = water equiv of acc snow depth over land and sea ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -342,7 +342,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_ocean long_name = water equiv of acc snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -351,7 +351,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -360,7 +360,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_ice long_name = water equiv of acc snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -369,7 +369,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_ice long_name = surface upward potential latent heat flux over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -378,7 +378,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -387,7 +387,7 @@ standard_name = sea_surface_temperature long_name = sea surface temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -396,7 +396,7 @@ standard_name = surface_skin_temperature_over_land long_name = surface skin temperature over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -405,7 +405,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -414,7 +414,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -423,7 +423,7 @@ standard_name = surface_skin_temperature_over_ice_interstitial long_name = surface skin temperature over ice (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -432,7 +432,7 @@ standard_name = sea_ice_temperature long_name = sea ice surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -441,7 +441,7 @@ standard_name = sea_ice_temperature_interstitial long_name = sea ice surface skin temperature use as interstitial units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -450,7 +450,7 @@ standard_name = surface_skin_temperature_after_iteration long_name = surface skin temperature after iteration units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -459,7 +459,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -468,7 +468,7 @@ standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -477,7 +477,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ice long_name = surface skin temperature after iteration over ice units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -486,7 +486,7 @@ standard_name = upward_heat_flux_in_soil_over_ice long_name = soil heat flux over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -504,7 +504,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -512,7 +512,7 @@ standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -521,7 +521,7 @@ standard_name = surface_longwave_emissivity_over_ocean_interstitial long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -530,7 +530,7 @@ standard_name = surface_longwave_emissivity_over_land_interstitial long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -539,7 +539,7 @@ standard_name = surface_longwave_emissivity_over_ice_interstitial long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -548,7 +548,7 @@ standard_name = surface_specific_humidity long_name = surface air saturation specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -557,7 +557,7 @@ standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -566,7 +566,7 @@ standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -575,7 +575,7 @@ standard_name = surface_specific_humidity_over_ice long_name = surface air saturation specific humidity over ice units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -584,7 +584,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -593,7 +593,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -602,7 +602,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -611,7 +611,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice long_name = kinematic surface upward sensible heat flux over ice units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -674,7 +674,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -682,7 +682,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -690,7 +690,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -698,7 +698,7 @@ standard_name = surface_longwave_emissivity_over_ocean_interstitial long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -707,7 +707,7 @@ standard_name = surface_longwave_emissivity_over_land_interstitial long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -716,7 +716,7 @@ standard_name = surface_longwave_emissivity_over_ice_interstitial long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -725,7 +725,7 @@ standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -734,7 +734,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land long_name = total sky surface downward longwave flux absorbed by the ground over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -743,7 +743,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ice long_name = total sky surface downward longwave flux absorbed by the ground over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -752,7 +752,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ocean long_name = total sky surface downward longwave flux absorbed by the ground over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -761,7 +761,7 @@ standard_name = surface_upwelling_shortwave_flux long_name = surface upwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -770,7 +770,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -779,7 +779,7 @@ standard_name = surface_net_downwelling_shortwave_flux long_name = surface net downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -864,7 +864,7 @@ standard_name = flag_for_cice long_name = flag for cice units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -872,7 +872,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -880,7 +880,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -888,7 +888,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -896,7 +896,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -904,7 +904,7 @@ standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -913,7 +913,7 @@ standard_name = lake_area_fraction long_name = fraction of horizontal grid area occupied by lake units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -922,7 +922,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -931,7 +931,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -940,7 +940,7 @@ standard_name = surface_roughness_length_over_ocean long_name = surface roughness length over ocean units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -949,7 +949,7 @@ standard_name = surface_roughness_length_over_land long_name = surface roughness length over land units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -958,7 +958,7 @@ standard_name = surface_roughness_length_over_ice long_name = surface roughness length over ice units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -967,7 +967,7 @@ standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -976,7 +976,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -985,7 +985,7 @@ standard_name = surface_roughness_length_over_ice_interstitial long_name = surface roughness length over ice (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -994,7 +994,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air long_name = surface exchange coeff for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1003,7 +1003,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1012,7 +1012,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1021,7 +1021,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice long_name = surface exchange coeff for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1030,7 +1030,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air long_name = surface exchange coeff heat & moisture units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1039,7 +1039,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1048,7 +1048,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1057,7 +1057,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice long_name = surface exchange coeff heat & moisture over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1066,7 +1066,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1075,7 +1075,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1084,7 +1084,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_land long_name = bulk Richardson number at the surface over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1093,7 +1093,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ice long_name = bulk Richardson number at the surface over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1102,7 +1102,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1111,7 +1111,7 @@ standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1120,7 +1120,7 @@ standard_name = surface_wind_stress_over_land long_name = surface wind stress over land units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1129,7 +1129,7 @@ standard_name = surface_wind_stress_over_ice long_name = surface wind stress over ice units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1138,7 +1138,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1147,7 +1147,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity function for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1156,7 +1156,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land long_name = Monin-Obukhov similarity function for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1165,7 +1165,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice long_name = Monin-Obukhov similarity function for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1174,7 +1174,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1183,7 +1183,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1192,7 +1192,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_land long_name = Monin-Obukhov similarity function for heat over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1201,7 +1201,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice long_name = Monin-Obukhov similarity function for heat over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1210,7 +1210,7 @@ standard_name = surface_friction_velocity long_name = boundary layer parameter units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1219,7 +1219,7 @@ standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1228,7 +1228,7 @@ standard_name = surface_friction_velocity_over_land long_name = surface friction velocity over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1237,7 +1237,7 @@ standard_name = surface_friction_velocity_over_ice long_name = surface friction velocity over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1246,7 +1246,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m long_name = Monin-Obukhov similarity parameter for momentum at 10m units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1255,7 +1255,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1264,7 +1264,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land long_name = Monin-Obukhov similarity parameter for momentum at 10m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1273,7 +1273,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1282,7 +1282,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m long_name = Monin-Obukhov similarity parameter for heat at 2m units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1291,7 +1291,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1300,7 +1300,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land long_name = Monin-Obukhov similarity parameter for heat at 2m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1309,7 +1309,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice long_name = Monin-Obukhov similarity parameter for heat at 2m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1318,7 +1318,7 @@ standard_name = surface_skin_temperature_after_iteration long_name = surface skin temperature after iteration units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1327,7 +1327,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1336,7 +1336,7 @@ standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1345,7 +1345,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ice long_name = surface skin temperature after iteration over ice units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1354,7 +1354,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air long_name = momentum exchange coefficient units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1363,7 +1363,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean long_name = momentum exchange coefficient over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1372,7 +1372,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land long_name = momentum exchange coefficient over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1381,7 +1381,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice long_name = momentum exchange coefficient over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1390,7 +1390,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air long_name = thermal exchange coefficient units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1399,7 +1399,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean long_name = thermal exchange coefficient over ocean units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1408,7 +1408,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land long_name = thermal exchange coefficient over land units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1417,7 +1417,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice long_name = thermal exchange coefficient over ice units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1426,7 +1426,7 @@ standard_name = upward_heat_flux_in_soil long_name = soil heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1435,7 +1435,7 @@ standard_name = upward_heat_flux_in_soil_over_ocean long_name = soil heat flux over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1444,7 +1444,7 @@ standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1453,7 +1453,7 @@ standard_name = upward_heat_flux_in_soil_over_ice long_name = soil heat flux over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1462,7 +1462,7 @@ standard_name = surface_upward_potential_latent_heat_flux long_name = surface upward potential latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1471,7 +1471,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_ocean long_name = surface upward potential latent heat flux over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1480,7 +1480,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_land long_name = surface upward potential latent heat flux over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1489,7 +1489,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_ice long_name = surface upward potential latent heat flux over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1498,7 +1498,7 @@ standard_name = water_equivalent_accumulated_snow_depth long_name = water equiv of acc snow depth over land and sea ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1507,7 +1507,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_ocean long_name = water equiv of acc snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1516,7 +1516,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1525,7 +1525,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_ice long_name = water equiv of acc snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1534,7 +1534,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1543,7 +1543,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1552,7 +1552,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1561,7 +1561,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1570,7 +1570,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total precipitation amount in each time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1579,7 +1579,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean long_name = total precipitation amount in each time step over ocean units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1588,7 +1588,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land long_name = total precipitation amount in each time step over land units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1597,7 +1597,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice long_name = total precipitation amount in each time step over ice units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1606,7 +1606,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1615,7 +1615,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1624,7 +1624,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward latent heat flux over land units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1633,7 +1633,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ice long_name = kinematic surface upward latent heat flux over ice units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1642,7 +1642,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1651,7 +1651,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1660,7 +1660,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1669,7 +1669,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice long_name = kinematic surface upward sensible heat flux over ice units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1678,7 +1678,7 @@ standard_name = surface_specific_humidity long_name = surface air saturation specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1687,7 +1687,7 @@ standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1696,7 +1696,7 @@ standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1705,7 +1705,7 @@ standard_name = surface_specific_humidity_over_ice long_name = surface air saturation specific humidity over ice units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1714,7 +1714,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1723,7 +1723,7 @@ standard_name = sea_surface_temperature long_name = sea surface temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1732,7 +1732,7 @@ standard_name = surface_skin_temperature_over_land long_name = surface skin temperature over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1741,7 +1741,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1750,7 +1750,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1759,7 +1759,7 @@ standard_name = surface_skin_temperature_over_ice_interstitial long_name = surface skin temperature over ice (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1768,7 +1768,7 @@ standard_name = sea_ice_temperature long_name = sea ice surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1777,7 +1777,7 @@ standard_name = sea_ice_temperature_interstitial long_name = sea ice surface skin temperature use as interstitial units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1786,7 +1786,7 @@ standard_name = sea_ice_thickness long_name = sea ice thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1795,7 +1795,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1812,7 +1812,7 @@ standard_name = internal_ice_temperature long_name = sea ice internal temperature units = K - dimensions = (horizontal_dimension,ice_vertical_dimension) + dimensions = (horizontal_loop_extent,ice_vertical_dimension) type = real kind = kind_phys intent = inout @@ -1821,7 +1821,7 @@ standard_name = soil_temperature long_name = soil temperature units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index f5c73db13..68713ab19 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -27,7 +27,7 @@ standard_name = vegetation_area_fraction long_name = areal fractional cover of green vegetation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -60,7 +60,7 @@ standard_name = soil_type_classification_real long_name = soil type for lsm units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -69,7 +69,7 @@ standard_name = vegetation_type_classification_real long_name = vegetation type for lsm units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -78,7 +78,7 @@ standard_name = surface_slope_classification_real long_name = sfc slope type for lsm units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -87,7 +87,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at lowest model interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -96,7 +96,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_layer long_name = dimensionless Exner function at lowest model layer units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -105,7 +105,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -114,7 +114,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -132,7 +132,7 @@ standard_name = bounded_vegetation_area_fraction long_name = areal fractional cover of green vegetation bounded on the bottom units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -141,7 +141,7 @@ standard_name = soil_type_classification long_name = soil type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -149,7 +149,7 @@ standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -157,7 +157,7 @@ standard_name = surface_slope_classification long_name = surface slope type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -165,7 +165,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -174,7 +174,7 @@ standard_name = surface_skin_temperature_after_iteration long_name = surface skin temperature after iteration units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -183,7 +183,7 @@ standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -208,7 +208,7 @@ standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -217,7 +217,7 @@ standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling long_name = change in rain_cpl (coupling_type) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -226,7 +226,7 @@ standard_name = tendency_of_lwe_thickness_of_snow_amount_for_coupling long_name = change in show_cpl (coupling_type) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -235,7 +235,7 @@ standard_name = lwe_thickness_of_precipitation_amount_for_coupling long_name = total rain precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -244,7 +244,7 @@ standard_name = lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -269,7 +269,7 @@ standard_name = weights_for_stochastic_surface_physics_perturbation long_name = weights for stochastic surface physics perturbation units = none - dimensions = (horizontal_dimension,number_of_land_surface_variables_perturbed) + dimensions = (horizontal_loop_extent,number_of_land_surface_variables_perturbed) type = real kind = kind_phys intent = in @@ -296,7 +296,7 @@ standard_name = perturbation_of_momentum_roughness_length long_name = perturbation of momentum roughness length units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -305,7 +305,7 @@ standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio long_name = perturbation of heat to momentum roughness length ratio units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -314,7 +314,7 @@ standard_name = perturbation_of_soil_type_b_parameter long_name = perturbation of soil type "b" parameter units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -323,7 +323,7 @@ standard_name = perturbation_of_leaf_area_index long_name = perturbation of leaf area index units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -332,7 +332,7 @@ standard_name = perturbation_of_vegetation_fraction long_name = perturbation of vegetation fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -358,7 +358,7 @@ standard_name = flag_for_cice long_name = flag for cice units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -366,7 +366,7 @@ standard_name = sea_land_ice_mask_cice long_name = sea/land/ice mask cice (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -374,7 +374,7 @@ standard_name = sea_land_ice_mask_in long_name = sea/land/ice mask input (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -383,7 +383,7 @@ standard_name = sea_ice_temperature long_name = sea-ice surface temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -392,7 +392,7 @@ standard_name = sea_surface_temperature long_name = sea surface temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -401,7 +401,7 @@ standard_name = sea_ice_concentration long_name = sea-ice concentration [0,1] units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -410,7 +410,7 @@ standard_name = sea_ice_thickness long_name = sea-ice thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -419,7 +419,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -428,7 +428,7 @@ standard_name = x_wind_at_lowest_model_layer long_name = zonal wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -437,7 +437,7 @@ standard_name = y_wind_at_lowest_model_layer long_name = meridional wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -446,7 +446,7 @@ standard_name = surface_wind_enhancement_due_to_convection long_name = surface wind enhancement due to convection units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -455,7 +455,7 @@ standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point long_name = wilting point (volumetric) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -464,7 +464,7 @@ standard_name = threshold_volume_fraction_of_condensed_water_in_soil long_name = soil moisture threshold (volumetric) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -533,7 +533,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -541,7 +541,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -558,7 +558,7 @@ standard_name = surface_upward_potential_latent_heat_flux long_name = surface upward potential latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -567,7 +567,7 @@ standard_name = upward_heat_flux_in_soil long_name = upward soil heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -576,7 +576,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = mean temperature at lowest model layer units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -585,7 +585,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = specific humidity at lowest model layer units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -594,7 +594,7 @@ standard_name = x_wind_at_lowest_model_layer long_name = zonal wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -603,7 +603,7 @@ standard_name = y_wind_at_lowest_model_layer long_name = meridional wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -612,7 +612,7 @@ standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -621,7 +621,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -630,7 +630,7 @@ standard_name = surface_downwelling_direct_near_infrared_shortwave_flux long_name = surface downwelling beam near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -639,7 +639,7 @@ standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux long_name = surface downwelling diffuse near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -648,7 +648,7 @@ standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux long_name = surface downwelling beam ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -657,7 +657,7 @@ standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux long_name = surface downwelling diffuse ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -666,7 +666,7 @@ standard_name = surface_upwelling_longwave_flux long_name = surface upwelling longwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -675,7 +675,7 @@ standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -684,7 +684,7 @@ standard_name = surface_upwelling_direct_near_infrared_shortwave_flux long_name = surface upwelling beam near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -693,7 +693,7 @@ standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux long_name = surface upwelling diffuse near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -702,7 +702,7 @@ standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux long_name = surface upwelling beam ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -711,7 +711,7 @@ standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux long_name = surface upwelling diffuse ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -720,7 +720,7 @@ standard_name = temperature_at_2m long_name = 2 meter temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -729,7 +729,7 @@ standard_name = specific_humidity_at_2m long_name = 2 meter specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -738,7 +738,7 @@ standard_name = x_wind_at_10m long_name = 10 meter u wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -747,7 +747,7 @@ standard_name = y_wind_at_10m long_name = 10 meter v wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -756,7 +756,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -765,7 +765,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -774,7 +774,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -783,7 +783,7 @@ standard_name = instantaneous_cosine_of_zenith_angle long_name = cosine of zenith angle at current time units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -792,7 +792,7 @@ standard_name = soil_upward_latent_heat_flux long_name = soil upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -801,7 +801,7 @@ standard_name = canopy_upward_latent_heat_flux long_name = canopy upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -810,7 +810,7 @@ standard_name = transpiration_flux long_name = total plant transpiration rate units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -819,7 +819,7 @@ standard_name = snow_deposition_sublimation_upward_latent_heat_flux long_name = latent heat flux from snow depo/subl units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -828,7 +828,7 @@ standard_name = surface_snow_area_fraction long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -837,7 +837,7 @@ standard_name = snow_freezing_rain_upward_latent_heat_flux long_name = latent heat flux due to snow and frz rain units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -846,7 +846,7 @@ standard_name = instantaneous_surface_potential_evaporation long_name = instantaneous sfc potential evaporation units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -855,7 +855,7 @@ standard_name = instantaneous_surface_ground_heat_flux long_name = instantaneous sfc ground heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -864,7 +864,7 @@ standard_name = air_temperature_at_lowest_model_layer_for_diag long_name = layer 1 temperature for diag units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -873,7 +873,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer_for_diag long_name = layer 1 specific humidity for diag units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -882,7 +882,7 @@ standard_name = x_wind_at_lowest_model_layer_for_diag long_name = layer 1 x wind for diag units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -891,7 +891,7 @@ standard_name = y_wind_at_lowest_model_layer_for_diag long_name = layer 1 y wind for diag units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -900,7 +900,7 @@ standard_name = instantaneous_surface_downwelling_longwave_flux_for_coupling long_name = instantaneous sfc downward lw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -909,7 +909,7 @@ standard_name = instantaneous_surface_downwelling_shortwave_flux_for_coupling long_name = instantaneous sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -918,7 +918,7 @@ standard_name = cumulative_surface_downwelling_longwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc downward lw flux mulitplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -927,7 +927,7 @@ standard_name = cumulative_surface_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc downward sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -936,7 +936,7 @@ standard_name = instantaneous_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling long_name = instantaneous sfc nir beam downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -945,7 +945,7 @@ standard_name = instantaneous_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling long_name = instantaneous sfc nir diff downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -954,7 +954,7 @@ standard_name = instantaneous_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling long_name = instantaneous sfc uv+vis beam downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -963,7 +963,7 @@ standard_name = instantaneous_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling long_name = instantaneous sfc uv+vis diff downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -972,7 +972,7 @@ standard_name = cumulative_surface_downwelling_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc nir beam downward sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -981,7 +981,7 @@ standard_name = cumulative_surface_downwelling_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc nir diff downward sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -990,7 +990,7 @@ standard_name = cumulative_surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc uv+vis beam dnwd sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -999,7 +999,7 @@ standard_name = cumulative_surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc uv+vis diff dnwd sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1008,7 +1008,7 @@ standard_name = instantaneous_surface_net_downward_longwave_flux_for_coupling long_name = instantaneous net sfc downward lw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1017,7 +1017,7 @@ standard_name = cumulative_surface_net_downward_longwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net downward lw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1026,7 +1026,7 @@ standard_name = instantaneous_temperature_at_2m_for_coupling long_name = instantaneous T2m units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1035,7 +1035,7 @@ standard_name = instantaneous_specific_humidity_at_2m_for_coupling long_name = instantaneous Q2m units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1044,7 +1044,7 @@ standard_name = instantaneous_x_wind_at_10m_for_coupling long_name = instantaneous U10m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1053,7 +1053,7 @@ standard_name = instantaneous_y_wind_at_10m_for_coupling long_name = instantaneous V10m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1062,7 +1062,7 @@ standard_name = instantaneous_surface_skin_temperature_for_coupling long_name = instantaneous sfc temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1071,7 +1071,7 @@ standard_name = instantaneous_surface_air_pressure_for_coupling long_name = instantaneous sfc pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1080,7 +1080,7 @@ standard_name = instantaneous_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling long_name = instantaneous net nir beam sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1089,7 +1089,7 @@ standard_name = instantaneous_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling long_name = instantaneous net nir diff sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1098,7 +1098,7 @@ standard_name = instantaneous_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling long_name = instantaneous net uv+vis beam downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1107,7 +1107,7 @@ standard_name = instantaneous_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling long_name = instantaneous net uv+vis diff downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1116,7 +1116,7 @@ standard_name = instantaneous_surface_net_downward_shortwave_flux_for_coupling long_name = instantaneous net sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1125,7 +1125,7 @@ standard_name = cumulative_surface_net_downward_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net downward sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1134,7 +1134,7 @@ standard_name = cumulative_surface_net_downward_direct_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir beam downward sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1143,7 +1143,7 @@ standard_name = cumulative_surface_net_downward_diffuse_near_infrared_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir diff downward sw flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1152,7 +1152,7 @@ standard_name = cumulative_surface_net_downward_direct_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis beam downward sw rad flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1161,7 +1161,7 @@ standard_name = cumulative_surface_net_downward_diffuse_ultraviolet_and_visible_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis diff downward sw rad flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1170,7 +1170,7 @@ standard_name = cumulative_surface_ground_heat_flux_multiplied_by_timestep long_name = cumulative groud conductive heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1179,7 +1179,7 @@ standard_name = cumulative_soil_upward_latent_heat_flux_multiplied_by_timestep long_name = cumulative soil upward latent heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1188,7 +1188,7 @@ standard_name = cumulative_canopy_upward_latent_heat_flu_multiplied_by_timestep long_name = cumulative canopy upward latent heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1197,7 +1197,7 @@ standard_name = cumulative_transpiration_flux_multiplied_by_timestep long_name = cumulative total plant transpiration rate multiplied by timestep units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1206,7 +1206,7 @@ standard_name = cumulative_snow_deposition_sublimation_upward_latent_heat_flux_multiplied_by_timestep long_name = cumulative latent heat flux from snow depo/subl multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1215,7 +1215,7 @@ standard_name = cumulative_surface_snow_area_fraction_multiplied_by_timestep long_name = cumulative surface snow area fraction multiplied by timestep units = s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1224,7 +1224,7 @@ standard_name = cumulative_snow_freezing_rain_upward_latent_heat_flux_multiplied_by_timestep long_name = cumulative latent heat flux due to snow and frz rain multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1233,7 +1233,7 @@ standard_name = cumulative_surface_upward_potential_latent_heat_flux_multiplied_by_timestep long_name = cumulative surface upward potential latent heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1242,7 +1242,7 @@ standard_name = total_runoff long_name = total water runoff units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1251,7 +1251,7 @@ standard_name = surface_runoff long_name = surface water runoff (from lsm) units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1260,7 +1260,7 @@ standard_name = surface_runoff_flux long_name = surface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1269,7 +1269,7 @@ standard_name = subsurface_runoff_flux long_name = subsurface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1304,7 +1304,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1313,7 +1313,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1322,7 +1322,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1331,7 +1331,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1340,7 +1340,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1349,7 +1349,7 @@ standard_name = surface_upward_latent_heat_flux_reduction_factor long_name = surface upward latent heat flux reduction factor from canopy heat storage units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1358,7 +1358,7 @@ standard_name = surface_upward_sensible_heat_flux_reduction_factor long_name = surface upward sensible heat flux reduction factor from canopy heat storage units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/GFS_surface_loop_control.meta b/physics/GFS_surface_loop_control.meta index a4d62cd29..569500a94 100644 --- a/physics/GFS_surface_loop_control.meta +++ b/physics/GFS_surface_loop_control.meta @@ -27,7 +27,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = flag_for_guess_run long_name = flag for guess run units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -88,7 +88,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -97,7 +97,7 @@ standard_name = flag_for_guess_run long_name = flag for guess run units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -105,7 +105,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -113,7 +113,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -121,7 +121,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -129,7 +129,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index ca1e573ba..3dda6a07c 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -283,7 +283,7 @@ standard_name = orography long_name = orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -292,7 +292,7 @@ standard_name = orography_unfiltered long_name = unfiltered orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -301,7 +301,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -318,7 +318,7 @@ standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -327,7 +327,7 @@ standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with_respect to east of maximum subgrid orographic variations units = degree - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -336,7 +336,7 @@ standard_name = slope_of_subgrid_orography long_name = slope of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -345,7 +345,7 @@ standard_name = anisotropy_of_subgrid_orography long_name = anisotropy of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -354,7 +354,7 @@ standard_name = maximum_subgrid_orography long_name = maximum of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -363,7 +363,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -372,7 +372,7 @@ standard_name = asymmetry_of_subgrid_orography long_name = asymmetry of subgrid orography units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -406,7 +406,7 @@ standard_name = latitude long_name = grid latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -415,7 +415,7 @@ standard_name = latitude_in_degree long_name = latitude in degree north units = degree_north - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -424,7 +424,7 @@ standard_name = sine_of_latitude long_name = sine of the grid latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -433,7 +433,7 @@ standard_name = cosine_of_latitude long_name = cosine of the grid latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -442,7 +442,7 @@ standard_name = cell_area long_name = area of the grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -451,7 +451,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -460,7 +460,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -469,7 +469,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -478,7 +478,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -487,7 +487,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -496,7 +496,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -505,7 +505,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -514,7 +514,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -523,7 +523,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -532,7 +532,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between midlayers units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -541,7 +541,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -549,7 +549,7 @@ standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -558,7 +558,7 @@ standard_name = instantaneous_y_stress_due_to_gravity_wave_drag long_name = meridional surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -567,7 +567,7 @@ standard_name = tendency_of_x_wind_due_to_ugwp long_name = zonal wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -576,7 +576,7 @@ standard_name = tendency_of_y_wind_due_to_ugwp long_name = meridional wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -585,7 +585,7 @@ standard_name = tendency_of_air_temperature_due_to_ugwp long_name = air temperature tendency due to UGWP units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -594,7 +594,7 @@ standard_name = eddy_mixing_due_to_ugwp long_name = eddy mixing due to UGWP units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -603,7 +603,7 @@ standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag long_name = momentum flux or stress due to TOFD units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -612,7 +612,7 @@ standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag long_name = momentum flux or stress due to mountain blocking drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -621,7 +621,7 @@ standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag long_name = momentum flux or stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -630,7 +630,7 @@ standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave long_name = momentum flux or stress due to nonstationary gravity waves units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -639,7 +639,7 @@ standard_name = height_of_mountain_blocking long_name = height of mountain blocking drag units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -648,7 +648,7 @@ standard_name = height_of_low_level_wave_breaking long_name = height of low level wave breaking units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -657,7 +657,7 @@ standard_name = height_of_launch_level_of_orographic_gravity_wave long_name = height of launch level of orographic gravity wave units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -666,7 +666,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -675,7 +675,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -684,7 +684,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -693,7 +693,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag long_name = time integral of change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -702,7 +702,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -711,7 +711,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -720,7 +720,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -729,7 +729,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -738,7 +738,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -747,7 +747,7 @@ standard_name = level_of_dividing_streamline long_name = level of the dividing streamline units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -810,7 +810,7 @@ standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -827,7 +827,7 @@ standard_name = turbulent_kinetic_energy long_name = turbulent kinetic energy units = J - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -836,7 +836,7 @@ standard_name = tendency_of_turbulent_kinetic_energy_due_to_model_physics long_name = turbulent kinetic energy tendency due to model physics units = J s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -861,7 +861,7 @@ standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in x wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -870,7 +870,7 @@ standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in y wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -879,7 +879,7 @@ standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag long_name = cumulative change in temperature due to orographic gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -888,7 +888,7 @@ standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in x wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -897,7 +897,7 @@ standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in y wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -906,7 +906,7 @@ standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag long_name = cumulative change in temperature due to convective gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta index ccb7cf50f..80b8ce1ca 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/cires_ugwp_post.meta @@ -44,7 +44,7 @@ standard_name = tendency_of_air_temperature_due_to_ugwp long_name = air temperature tendency due to UGWP units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -53,7 +53,7 @@ standard_name = tendency_of_x_wind_due_to_ugwp long_name = zonal wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -62,7 +62,7 @@ standard_name = tendency_of_y_wind_due_to_ugwp long_name = meridional wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -71,7 +71,7 @@ standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag long_name = momentum flux or stress due to TOFD units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -80,7 +80,7 @@ standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag long_name = momentum flux or stress due to mountain blocking drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -89,7 +89,7 @@ standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag long_name = momentum flux or stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -98,7 +98,7 @@ standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave long_name = momentum flux or stress due to nonstationary gravity waves units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = height_of_mountain_blocking long_name = height of mountain blocking drag units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -116,7 +116,7 @@ standard_name = height_of_low_level_wave_breaking long_name = height of low level wave breaking units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -125,7 +125,7 @@ standard_name = height_of_launch_level_of_orographic_gravity_wave long_name = height of launch level of orographic gravity wave units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -134,7 +134,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -143,7 +143,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -152,7 +152,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -161,7 +161,7 @@ standard_name = time_integral_of_height_of_mountain_blocking long_name = time integral of height of mountain blocking drag units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -170,7 +170,7 @@ standard_name = time_integral_of_height_of_low_level_wave_breaking long_name = time integral of height of drag due to low level wave breaking units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -179,7 +179,7 @@ standard_name = time_integral_of_height_of_launch_level_of_orographic_gravity_wave long_name = time integral of height of launch level of orographic gravity wave units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -188,7 +188,7 @@ standard_name = time_integral_of_momentum_flux_due_to_turbulent_orographic_form_drag long_name = time integral of momentum flux due to TOFD units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -197,7 +197,7 @@ standard_name = time_integral_of_momentum_flux_due_to_mountain_blocking_drag long_name = time integral of momentum flux due to mountain blocking drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -206,7 +206,7 @@ standard_name = time_integral_of_momentum_flux_due_to_orographic_gravity_wave_drag long_name = time integral of momentum flux due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -215,7 +215,7 @@ standard_name = time_integral_of_momentum_flux_due_to_nonstationary_gravity_wave long_name = time integral of momentum flux due to nonstationary gravity waves units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -224,7 +224,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag long_name = time integral of change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -233,7 +233,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -242,7 +242,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -251,7 +251,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -260,7 +260,7 @@ standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -269,7 +269,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -278,7 +278,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -287,7 +287,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/cnvc90.meta b/physics/cnvc90.meta index ab487ff22..169f6b221 100644 --- a/physics/cnvc90.meta +++ b/physics/cnvc90.meta @@ -28,7 +28,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_on_dynamics_timestep long_name = convective rainfall amount on dynamics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -37,7 +37,7 @@ standard_name = vertical_index_at_cloud_base long_name = vertical index at cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -45,7 +45,7 @@ standard_name = vertical_index_at_cloud_top long_name = vertical index at cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -61,7 +61,7 @@ standard_name = air_pressure_at_interface long_name = interface pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -70,7 +70,7 @@ standard_name = accumulated_lwe_thickness_of_convective_precipitation_amount_cnvc90 long_name = accumulated convective rainfall amount for cnvc90 only units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -79,7 +79,7 @@ standard_name = smallest_cloud_base_vertical_index_encountered_thus_far long_name = smallest cloud base vertical index encountered thus far units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -88,7 +88,7 @@ standard_name = largest_cloud_top_vertical_index_encountered_thus_far long_name = largest cloud top vertical index encountered thus far units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -97,7 +97,7 @@ standard_name = fraction_of_convective_cloud long_name = fraction of convective cloud units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -106,7 +106,7 @@ standard_name = pressure_at_bottom_of_convective_cloud long_name = pressure at bottom of convective cloud units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -115,7 +115,7 @@ standard_name = pressure_at_top_of_convective_cloud long_name = pressure at top of convective cloud units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index 42201b155..14a0d5bf2 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -8,7 +8,7 @@ name = cs_conv_pre_run type = scheme [im] - standard_name = horizontal_dimension + standard_name = horizontal_loop_extent long_name = horizontal dimension units = count dimensions = () @@ -43,7 +43,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -52,7 +52,7 @@ standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -61,7 +61,7 @@ standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -70,7 +70,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes long_name = grid size related coefficient used in scale-sensitive schemes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -79,7 +79,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement long_name = complement to work1 units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -106,7 +106,7 @@ standard_name = maximum_updraft_velocity_at_cloud_base long_name = maximum updraft velocity at cloud base units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -133,7 +133,7 @@ standard_name = water_vapor_specific_humidity_save long_name = water vapor specific humidity before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -142,7 +142,7 @@ standard_name = cloud_condensed_water_mixing_ratio_save long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -151,7 +151,7 @@ standard_name = ice_water_mixing_ratio_save long_name = cloud ice water mixing ratio before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -185,7 +185,7 @@ name = cs_conv_post_run type = scheme [im] - standard_name = horizontal_dimension + standard_name = horizontal_loop_extent long_name = horizontal dimension units = count dimensions = () @@ -212,7 +212,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -221,7 +221,7 @@ standard_name = convective_updraft_area_fraction long_name = convective updraft area fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -330,7 +330,7 @@ standard_name = air_temperature_updated_by_physics long_name = mid-layer temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -339,7 +339,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = mid-layer specific humidity of water vapor units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -348,7 +348,7 @@ standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -357,7 +357,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout @@ -366,7 +366,7 @@ standard_name = geopotential long_name = mid-layer geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -375,7 +375,7 @@ standard_name = geopotential_at_interface long_name = interface geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -384,7 +384,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -393,7 +393,7 @@ standard_name = air_pressure_at_interface long_name = interface pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -420,7 +420,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -429,7 +429,7 @@ standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -438,7 +438,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -447,7 +447,7 @@ standard_name = x_wind_updated_by_physics long_name = mid-layer zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -456,7 +456,7 @@ standard_name = y_wind_updated_by_physics long_name = mid-layer meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -483,7 +483,7 @@ standard_name = cloud_base_mass_flux long_name = cloud base mass flux units = kg m-2 s-1 - dimensions = (horizontal_dimension,number_of_cloud_types_CS) + dimensions = (horizontal_loop_extent,number_of_cloud_types_CS) type = real kind = kind_phys intent = inout @@ -500,7 +500,7 @@ standard_name = maximum_updraft_velocity_at_cloud_base long_name = maximum updraft velocity at cloud base units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -536,7 +536,7 @@ standard_name = convective_updraft_area_fraction_at_model_interfaces long_name = convective updraft area fraction at model interfaces units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -585,7 +585,7 @@ standard_name = flag_deep_convection long_name = flag indicating whether convection occurs in column units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -593,7 +593,7 @@ standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -602,7 +602,7 @@ standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -611,7 +611,7 @@ standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -620,7 +620,7 @@ standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -629,7 +629,7 @@ standard_name = detrained_mass_flux long_name = detrained mass flux units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -638,7 +638,7 @@ standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -647,7 +647,7 @@ standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -656,7 +656,7 @@ standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -665,7 +665,7 @@ standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -674,7 +674,7 @@ standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/cs_conv_aw_adj.meta b/physics/cs_conv_aw_adj.meta index 626fd6d4b..720330c50 100644 --- a/physics/cs_conv_aw_adj.meta +++ b/physics/cs_conv_aw_adj.meta @@ -8,7 +8,7 @@ name = cs_conv_aw_adj_run type = scheme [im] - standard_name = horizontal_dimension + standard_name = horizontal_loop_extent long_name = horizontal dimension units = count dimensions = () @@ -100,7 +100,7 @@ standard_name = convective_updraft_area_fraction long_name = convective updraft area fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -109,7 +109,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -118,7 +118,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -127,7 +127,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -136,7 +136,7 @@ standard_name = tracer_concentration_save long_name = tracer concentration before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -145,7 +145,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -154,7 +154,7 @@ standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -163,7 +163,7 @@ standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -172,7 +172,7 @@ standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 7c86d7952..f27b2cc91 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -57,7 +57,7 @@ standard_name = cell_area long_name = grid cell area units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -91,7 +91,7 @@ standard_name = conv_activity_counter long_name = convective activity memory units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -99,7 +99,7 @@ standard_name = temperature_tendency_due_to_dynamics long_name = temperature tendency due to dynamics only units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -108,7 +108,7 @@ standard_name = moisture_tendency_due_to_dynamics long_name = moisture tendency due to dynamics only units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -117,7 +117,7 @@ standard_name = geopotential long_name = layer geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -126,7 +126,7 @@ standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -135,7 +135,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -144,7 +144,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -153,7 +153,7 @@ standard_name = cloud_work_function long_name = cloud work function units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -162,7 +162,7 @@ standard_name = x_wind_updated_by_physics long_name = updated x-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -171,7 +171,7 @@ standard_name = y_wind_updated_by_physics long_name = updated y-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -180,7 +180,7 @@ standard_name = air_temperature long_name = mid-layer temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -189,7 +189,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -198,7 +198,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -207,7 +207,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -216,7 +216,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -225,7 +225,7 @@ standard_name = vertical_index_at_cloud_base long_name = index for cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -233,7 +233,7 @@ standard_name = vertical_index_at_cloud_top long_name = index for cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -241,7 +241,7 @@ standard_name = flag_deep_convection long_name = deep convection: 0=no, 1=yes units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -249,7 +249,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -257,7 +257,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -266,7 +266,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -275,7 +275,7 @@ standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -284,7 +284,7 @@ standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -293,7 +293,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -302,7 +302,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -311,7 +311,7 @@ standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -320,7 +320,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -329,7 +329,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -338,7 +338,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -371,7 +371,7 @@ standard_name = cumulative_change_in_x_wind_due_to_shallow_convection long_name = cumulative change in x wind due to shallow convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -380,7 +380,7 @@ standard_name = cumulative_change_in_y_wind_due_to_shallow_convection long_name = cumulative change in y wind due to shallow convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -389,7 +389,7 @@ standard_name = cumulative_change_in_temperature_due_to_shallow_convection long_name = cumulative change in temperature due to shallow convection units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -398,7 +398,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shallow_convection long_name = cumulative change in water vapor specific humidity due to shallow convection units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -407,7 +407,7 @@ standard_name = cumulative_change_in_x_wind_due_to_deep_convection long_name = cumulative change in x wind due to deep convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -416,7 +416,7 @@ standard_name = cumulative_change_in_y_wind_due_to_deep_convection long_name = cumulative change in y wind due to deep convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -425,7 +425,7 @@ standard_name = cumulative_change_in_temperature_due_to_deep_convection long_name = cumulative change in temperature due to deep convection units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -434,7 +434,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection long_name = cumulative change in water vapor specific humidity due to deep convection units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -459,7 +459,7 @@ standard_name = convective_cloud_condesate_after_rainout long_name = convective cloud condesate after rainout units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/cu_gf_driver_post.meta b/physics/cu_gf_driver_post.meta index 43bc02545..152409fbd 100644 --- a/physics/cu_gf_driver_post.meta +++ b/physics/cu_gf_driver_post.meta @@ -19,7 +19,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -28,7 +28,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -37,7 +37,7 @@ standard_name = temperature_from_previous_timestep long_name = temperature from previous time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -46,7 +46,7 @@ standard_name = moisture_from_previous_timestep long_name = moisture from previous time step units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -55,7 +55,7 @@ standard_name = conv_activity_counter long_name = convective activity memory units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -63,7 +63,7 @@ standard_name = gf_memory_counter long_name = Memory counter for GF units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/cu_gf_driver_pre.meta b/physics/cu_gf_driver_pre.meta index bfdebee59..1a7fbe4a3 100644 --- a/physics/cu_gf_driver_pre.meta +++ b/physics/cu_gf_driver_pre.meta @@ -53,7 +53,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -62,7 +62,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -71,7 +71,7 @@ standard_name = temperature_from_previous_timestep long_name = temperature from previous time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -80,7 +80,7 @@ standard_name = moisture_from_previous_timestep long_name = moisture from previous time step units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -89,7 +89,7 @@ standard_name = temperature_tendency_due_to_dynamics long_name = temperature tendency due to dynamics only units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -98,7 +98,7 @@ standard_name = moisture_tendency_due_to_dynamics long_name = moisture tendency due to dynamics only units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -107,7 +107,7 @@ standard_name = conv_activity_counter long_name = convective activity memory units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -115,7 +115,7 @@ standard_name = gf_memory_counter long_name = Memory counter for GF units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 8bc067735..70e977eed 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -49,7 +49,7 @@ standard_name = x_wind_updated_by_physics long_name = updated x-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -58,7 +58,7 @@ standard_name = y_wind_updated_by_physics long_name = updated y-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -67,7 +67,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -76,7 +76,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -85,7 +85,7 @@ standard_name = air_temperature long_name = mid-layer temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -94,7 +94,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -103,7 +103,7 @@ standard_name = moisture_tendency_due_to_dynamics long_name = moisture tendency due to dynamics only units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -112,7 +112,7 @@ standard_name = temperature_tendency_due_to_dynamics long_name = temperature tendency due to dynamics only units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -121,7 +121,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout @@ -130,7 +130,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -139,7 +139,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -148,7 +148,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -157,7 +157,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -166,7 +166,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -175,7 +175,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -184,7 +184,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -193,7 +193,7 @@ standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -202,7 +202,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -235,7 +235,7 @@ standard_name = cell_size long_name = size of the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -244,7 +244,7 @@ standard_name = vertical_index_at_cloud_base long_name = index for cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -252,7 +252,7 @@ standard_name = vertical_index_at_cloud_top long_name = index for cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -260,7 +260,7 @@ standard_name = flag_deep_convection long_name = deep convection: 0=no, 1=yes units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -276,7 +276,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -285,7 +285,7 @@ standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -294,7 +294,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -303,7 +303,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = convective cloud water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -312,7 +312,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/cu_ntiedtke_post.meta b/physics/cu_ntiedtke_post.meta index dfaee692d..543ebae16 100644 --- a/physics/cu_ntiedtke_post.meta +++ b/physics/cu_ntiedtke_post.meta @@ -11,7 +11,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -20,7 +20,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -29,7 +29,7 @@ standard_name = temperature_from_previous_timestep long_name = temperature from previous time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -38,7 +38,7 @@ standard_name = moisture_from_previous_timestep long_name = moisture from previous time step units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/cu_ntiedtke_pre.meta b/physics/cu_ntiedtke_pre.meta index 411bb8fab..c2670ee09 100644 --- a/physics/cu_ntiedtke_pre.meta +++ b/physics/cu_ntiedtke_pre.meta @@ -53,7 +53,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -62,7 +62,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -71,7 +71,7 @@ standard_name = temperature_from_previous_timestep long_name = temperature from previous time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -80,7 +80,7 @@ standard_name = moisture_from_previous_timestep long_name = moisture from previous time step units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -89,7 +89,7 @@ standard_name = temperature_tendency_due_to_dynamics long_name = temperature tendency due to dynamics only units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -98,7 +98,7 @@ standard_name = moisture_tendency_due_to_dynamics long_name = moisture tendency due to dynamics only units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index ce406e824..6fbc7f8b6 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -47,7 +47,7 @@ standard_name = sine_of_latitude long_name = sine of latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -56,7 +56,7 @@ standard_name = cosine_of_latitude long_name = cosine of latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -65,7 +65,7 @@ standard_name = longitude long_name = longitude of grid box units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -74,7 +74,7 @@ standard_name = cosine_of_zenith_angle long_name = average of cosine of zenith angle over daytime shortwave call time interval units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -83,7 +83,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -92,7 +92,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -101,7 +101,7 @@ standard_name = surface_skin_temperature_over_ice_interstitial long_name = surface skin temperature over ice (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -110,7 +110,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = air temperature at lowest model layer units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -119,7 +119,7 @@ standard_name = surface_midlayer_air_temperature_in_longwave_radiation long_name = surface (first layer) air temperature saved in longwave radiation call units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -128,7 +128,7 @@ standard_name = surface_longwave_emissivity_over_land_interstitial long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = surface_longwave_emissivity_over_ice_interstitial long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -146,7 +146,7 @@ standard_name = surface_longwave_emissivity_over_ocean_interstitial long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -155,7 +155,7 @@ standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky surface downwelling shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -164,7 +164,7 @@ standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step long_name = total sky surface net downwelling shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -173,7 +173,7 @@ standard_name = surface_downwelling_longwave_flux_on_radiation_time_step long_name = total sky surface downwelling longwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -182,7 +182,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -191,7 +191,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky shortwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -200,7 +200,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -209,7 +209,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky longwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -218,7 +218,7 @@ standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = total sky surface upwelling beam near-infrared shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -227,7 +227,7 @@ standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = total sky surface upwelling diffuse near-infrared shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -236,7 +236,7 @@ standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = total sky surface upwelling beam ultraviolet plus visible shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -245,7 +245,7 @@ standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = total sky surface upwelling diffuse ultraviolet plus visible shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -254,7 +254,7 @@ standard_name = surface_downwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step long_name = total sky surface downwelling beam near-infrared shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -263,7 +263,7 @@ standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step long_name = total sky surface downwelling diffuse near-infrared shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -272,7 +272,7 @@ standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = total sky surface downwelling beam ultraviolet plus visible shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -281,7 +281,7 @@ standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step long_name = total sky surface downwelling diffuse ultraviolet plus visible shortwave flux on radiation time step units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -324,7 +324,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -332,7 +332,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -340,7 +340,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -348,7 +348,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = total radiative heating rate at current time units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -357,7 +357,7 @@ standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky long_name = clear sky radiative (shortwave + longwave) heating rate at current time units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -366,7 +366,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -375,7 +375,7 @@ standard_name = surface_net_downwelling_shortwave_flux long_name = surface net downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -384,7 +384,7 @@ standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -393,7 +393,7 @@ standard_name = surface_upwelling_longwave_flux_over_land_interstitial long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -402,7 +402,7 @@ standard_name = surface_upwelling_longwave_flux_over_ice_interstitial long_name = surface upwelling longwave flux at current time over ice (temporary use as interstitial) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -411,7 +411,7 @@ standard_name = surface_upwelling_longwave_flux_over_ocean_interstitial long_name = surface upwelling longwave flux at current time over ocean (temporary use as interstitial) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -420,7 +420,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave fluxes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -429,7 +429,7 @@ standard_name = instantaneous_cosine_of_zenith_angle long_name = cosine of zenith angle at current time units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -438,7 +438,7 @@ standard_name = surface_upwelling_direct_near_infrared_shortwave_flux long_name = surface upwelling beam near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -447,7 +447,7 @@ standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux long_name = surface upwelling diffuse near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -456,7 +456,7 @@ standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux long_name = surface upwelling beam ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -465,7 +465,7 @@ standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux long_name = surface upwelling diffuse ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -474,7 +474,7 @@ standard_name = surface_downwelling_direct_near_infrared_shortwave_flux long_name = surface downwelling beam near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -483,7 +483,7 @@ standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux long_name = surface downwelling diffuse near-infrared shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -492,7 +492,7 @@ standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux long_name = surface downwelling beam ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -501,7 +501,7 @@ standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux long_name = surface downwelling diffuse ultraviolet plus visible shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index ba15719c1..f78259e82 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -27,7 +27,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -36,7 +36,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -45,7 +45,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -54,7 +54,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = air_temperature long_name = mid-layer temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = water_vapor_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -98,7 +98,7 @@ standard_name = air_pressure_at_interface long_name = interface pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -116,7 +116,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -125,7 +125,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = mid-layer Exner function units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -134,7 +134,7 @@ standard_name = geopotential_at_interface long_name = interface geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -143,7 +143,7 @@ standard_name = geopotential long_name = mid-layer geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -169,7 +169,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -187,7 +187,7 @@ standard_name = asymmetry_of_subgrid_orography long_name = asymmetry of subgrid orography units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -196,7 +196,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -205,7 +205,7 @@ standard_name = standard_deviation_of_subgrid_orography_small_scale long_name = standard deviation of subgrid orography small scale units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -214,7 +214,7 @@ standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid orography small scale units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -223,7 +223,7 @@ standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid orography small scale units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -232,7 +232,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -241,7 +241,7 @@ standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with respect to east of maximum subgrid orographic variations units = degree - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -250,7 +250,7 @@ standard_name = slope_of_subgrid_orography long_name = slope of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -259,7 +259,7 @@ standard_name = anisotropy_of_subgrid_orography long_name = anisotropy of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -268,7 +268,7 @@ standard_name = maximum_subgrid_orography long_name = maximum of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -277,7 +277,7 @@ standard_name = x_momentum_tendency_from_large_scale_gwd long_name = x momentum tendency from large scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -286,7 +286,7 @@ standard_name = y_momentum_tendency_from_large_scale_gwd long_name = y momentum tendency from large scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -295,7 +295,7 @@ standard_name = x_momentum_tendency_from_blocking_drag long_name = x momentum tendency from blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -304,7 +304,7 @@ standard_name = y_momentum_tendency_from_blocking_drag long_name = y momentum tendency from blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -313,7 +313,7 @@ standard_name = x_momentum_tendency_from_small_scale_gwd long_name = x momentum tendency from small scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -322,7 +322,7 @@ standard_name = y_momentum_tendency_from_small_scale_gwd long_name = y momentum tendency from small scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -331,7 +331,7 @@ standard_name = x_momentum_tendency_from_form_drag long_name = x momentum tendency from form drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -340,7 +340,7 @@ standard_name = y_momentum_tendency_from_form_drag long_name = y momentum tendency from form drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -349,7 +349,7 @@ standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -358,7 +358,7 @@ standard_name = instantaneous_y_stress_due_to_gravity_wave_drag long_name = meridional surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -367,7 +367,7 @@ standard_name = integrated_x_momentum_flux_from_large_scale_gwd long_name = integrated x momentum flux from large scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -376,7 +376,7 @@ standard_name = integrated_y_momentum_flux_from_large_scale_gwd long_name = integrated y momentum flux from large scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -385,7 +385,7 @@ standard_name = integrated_x_momentum_flux_from_blocking_drag long_name = integrated x momentum flux from blocking drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -394,7 +394,7 @@ standard_name = integrated_y_momentum_flux_from_blocking_drag long_name = integrated y momentum flux from blocking drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -403,7 +403,7 @@ standard_name = integrated_x_momentum_flux_from_small_scale_gwd long_name = integrated x momentum flux from small scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -412,7 +412,7 @@ standard_name = integrated_y_momentum_flux_from_small_scale_gwd long_name = integrated y momentum flux from small scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -421,7 +421,7 @@ standard_name = integrated_x_momentum_flux_from_form_drag long_name = integrated x momentum flux from form drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -430,7 +430,7 @@ standard_name = integrated_y_momentum_flux_from_form_drag long_name = integrated y momentum flux from form drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -439,7 +439,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -448,7 +448,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -457,7 +457,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -569,7 +569,7 @@ standard_name = level_of_dividing_streamline long_name = level of the dividing streamline units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -578,7 +578,7 @@ standard_name = cell_size long_name = size of the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 128977e05..2b857e509 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -63,7 +63,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = mean temperature at lowest model layer units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -99,7 +99,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ocean long_name = total sky surface downward longwave flux absorbed by the ground over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -108,7 +108,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -117,7 +117,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_ocean long_name = water equiv of acc snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -126,7 +126,7 @@ standard_name = lake_depth long_name = lake depth units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -135,7 +135,7 @@ standard_name = flag_nonzero_lake_surface_fraction long_name = flag indicating presence of some lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -143,7 +143,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -161,7 +161,7 @@ standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -170,7 +170,7 @@ standard_name = orography long_name = orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -179,7 +179,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -187,7 +187,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -220,7 +220,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -229,7 +229,7 @@ standard_name = sea_ice_thickness long_name = sea ice thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -238,7 +238,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -247,7 +247,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -256,7 +256,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -265,7 +265,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -274,7 +274,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -283,7 +283,7 @@ standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -292,7 +292,7 @@ standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -301,7 +301,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -310,7 +310,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -319,7 +319,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean long_name = thermal exchange coefficient over ocean units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -328,7 +328,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean long_name = momentum exchange coefficient over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index d9a58d8b5..8cb03727d 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -126,7 +126,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -135,7 +135,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -144,7 +144,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -153,7 +153,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -162,7 +162,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -171,7 +171,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -180,7 +180,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -189,7 +189,7 @@ standard_name = critical_relative_humidity long_name = critical relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -261,7 +261,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -270,7 +270,7 @@ standard_name = prandtl_number long_name = turbulent Prandtl number units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -279,7 +279,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -288,7 +288,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -369,7 +369,7 @@ standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -378,7 +378,7 @@ standard_name = turbulent_kinetic_energy_convective_transport_tracer long_name = turbulent kinetic energy in the convectively transported tracer array units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -387,7 +387,7 @@ standard_name = atmosphere_heat_diffusivity_from_shoc long_name = diffusivity for heat from the SHOC scheme units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -396,7 +396,7 @@ standard_name = kinematic_buoyancy_flux_from_shoc long_name = upward kinematic buoyancy flux from the SHOC scheme units = K m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/get_prs_fv3.meta b/physics/get_prs_fv3.meta index 2db340300..82b6a00d6 100644 --- a/physics/get_prs_fv3.meta +++ b/physics/get_prs_fv3.meta @@ -8,7 +8,7 @@ name = get_prs_fv3_run type = scheme [ix] - standard_name = horizontal_dimension + standard_name = horizontal_loop_extent long_name = horizontal dimension units = count dimensions = () @@ -27,7 +27,7 @@ standard_name = geopotential_at_interface long_name = interface geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = air_pressure_at_interface long_name = interface pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -45,7 +45,7 @@ standard_name = air_temperature long_name = mid-layer temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -54,7 +54,7 @@ standard_name = water_vapor_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -72,7 +72,7 @@ standard_name = geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature long_name = difference between mid-layer geopotentials divided by mid-layer virtual temperature units = m2 s-2 K-1 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -106,7 +106,7 @@ name = get_phi_fv3_run type = scheme [ix] - standard_name = horizontal_dimension + standard_name = horizontal_loop_extent long_name = horizontal dimension units = count dimensions = () @@ -125,7 +125,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -134,7 +134,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = mid-layer specific humidity of water vapor units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -143,7 +143,7 @@ standard_name = geopotential_difference_between_midlayers_divided_by_midlayer_virtual_temperature long_name = difference between mid-layer geopotentials divided by mid-layer virtual temperature units = m2 s-2 K-1 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = inout @@ -152,7 +152,7 @@ standard_name = geopotential_at_interface long_name = interface geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -161,7 +161,7 @@ standard_name = geopotential long_name = mid-layer geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index 3c9a53606..60da43272 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -172,7 +172,7 @@ standard_name = land_area_fraction_for_microphysics long_name = land area fraction used in microphysics schemes units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -181,7 +181,7 @@ standard_name = cell_area long_name = area of grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -190,7 +190,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -198,7 +198,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -207,7 +207,7 @@ standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics long_name = cloud condensed water mixing ratio updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -216,7 +216,7 @@ standard_name = rain_water_mixing_ratio_updated_by_physics long_name = moist mixing ratio of rain updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -225,7 +225,7 @@ standard_name = ice_water_mixing_ratio_updated_by_physics long_name = moist mixing ratio of cloud ice updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -234,7 +234,7 @@ standard_name = snow_water_mixing_ratio_updated_by_physics long_name = moist mixing ratio of snow updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -243,7 +243,7 @@ standard_name = graupel_mixing_ratio_updated_by_physics long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -252,7 +252,7 @@ standard_name = cloud_fraction_updated_by_physics long_name = cloud fraction updated by physics units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -261,7 +261,7 @@ standard_name = air_temperature_updated_by_physics long_name = air temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -270,7 +270,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -279,7 +279,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -288,7 +288,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -297,7 +297,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -306,7 +306,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -315,7 +315,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between mid-layers units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -324,7 +324,7 @@ standard_name = lwe_thickness_of_explicit_rain_amount long_name = explicit rain on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -333,7 +333,7 @@ standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -342,7 +342,7 @@ standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -351,7 +351,7 @@ standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -360,7 +360,7 @@ standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -369,7 +369,7 @@ standard_name = ratio_of_snowfall_to_rainfall long_name = snow ratio: ratio of snow to total precipitation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -411,7 +411,7 @@ standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm units = dBZ - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -436,7 +436,7 @@ standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -445,7 +445,7 @@ standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -454,7 +454,7 @@ standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um long_name = effective radius of cloud rain particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -463,7 +463,7 @@ standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -472,7 +472,7 @@ standard_name = effective_radius_of_stratiform_cloud_graupel_particle_in_um long_name = eff. radius of cloud graupel particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/gmtb_scm_sfc_flux_spec.meta b/physics/gmtb_scm_sfc_flux_spec.meta index 2dba88b57..71ddff22a 100644 --- a/physics/gmtb_scm_sfc_flux_spec.meta +++ b/physics/gmtb_scm_sfc_flux_spec.meta @@ -11,7 +11,7 @@ standard_name = x_wind_at_lowest_model_layer long_name = x component of 1st model layer wind units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -20,7 +20,7 @@ standard_name = y_wind_at_lowest_model_layer long_name = y component of 1st model layer wind units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -29,7 +29,7 @@ standard_name = height_above_ground_at_lowest_model_layer long_name = height above ground at 1st model layer units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -38,7 +38,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = 1st model layer air temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -47,7 +47,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = 1st model layer specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -56,7 +56,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = Model layer 1 mean pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -65,7 +65,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -74,7 +74,7 @@ standard_name = specified_kinematic_surface_upward_sensible_heat_flux long_name = specified kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -83,7 +83,7 @@ standard_name = specified_kinematic_surface_upward_latent_heat_flux long_name = specified kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -92,7 +92,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -101,7 +101,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -164,7 +164,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -173,7 +173,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux long_name = surface upward evaporation flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -182,7 +182,7 @@ standard_name = surface_friction_velocity long_name = boundary layer parameter units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -191,7 +191,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -200,7 +200,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air long_name = surface exchange coeff for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -209,7 +209,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air long_name = surface exchange coeff heat & moisture units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -218,7 +218,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -227,7 +227,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -236,7 +236,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -245,7 +245,7 @@ standard_name = x_wind_at_10m long_name = 10 meter u wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -254,7 +254,7 @@ standard_name = y_wind_at_10m long_name = 10 meter v wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -263,7 +263,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -272,7 +272,7 @@ standard_name = surface_specific_humidity long_name = surface air saturation specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -281,7 +281,7 @@ standard_name = temperature_at_2m long_name = 2 meter temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -290,7 +290,7 @@ standard_name = specific_humidity_at_2m long_name = 2 meter specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/gscond.meta b/physics/gscond.meta index 9012cc650..7cab7298d 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -45,7 +45,7 @@ standard_name = air_pressure long_name = layer mean air pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -54,7 +54,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -72,7 +72,7 @@ standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics long_name = moist cloud condensed water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -99,7 +99,7 @@ standard_name = air_temperature_updated_by_physics long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -108,7 +108,7 @@ standard_name = air_temperature_two_time_steps_back long_name = air temperature two time steps back units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -117,7 +117,7 @@ standard_name = water_vapor_specific_humidity_two_time_steps_back long_name = water vapor specific humidity two time steps back units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -126,7 +126,7 @@ standard_name = surface_air_pressure_two_time_steps_back long_name = surface air pressure two time steps back units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -135,7 +135,7 @@ standard_name = air_temperature_at_previous_time_step long_name = air temperature at previous time step units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -144,7 +144,7 @@ standard_name = water_vapor_specific_humidity_at_previous_time_step long_name = water vapor specific humidity at previous time step units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -153,7 +153,7 @@ standard_name = surface_air_pressure_at_previous_time_step long_name = surface air surface pressure at previous time step units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -162,7 +162,7 @@ standard_name = critical_relative_humidity long_name = critical relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 30f5fcbfd..5c3fa63d6 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -28,7 +28,7 @@ standard_name = cell_size long_name = grid size in zonal direction units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -37,7 +37,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes long_name = grid size related coefficient used in scale-sensitive schemes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -46,7 +46,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes_complement long_name = complement to work1 units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -55,7 +55,7 @@ standard_name = characteristic_grid_length_scale long_name = representative horizontal length scale of grid box units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -64,7 +64,7 @@ standard_name = cloud_area_fraction long_name = fraction of grid box area in which updrafts occur units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -81,7 +81,7 @@ standard_name = vertical_index_at_cloud_base long_name = vertical index at cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -89,7 +89,7 @@ standard_name = vertical_index_at_cloud_top long_name = vertical index at cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -106,7 +106,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -115,7 +115,7 @@ standard_name = air_temperature_save long_name = air temperature before entering convection scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -124,7 +124,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -133,7 +133,7 @@ standard_name = maximum_column_heating_rate long_name = maximum heating rate in column units = K s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -202,7 +202,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -211,7 +211,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -220,7 +220,7 @@ standard_name = air_temperature long_name = mid-layer temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -229,7 +229,7 @@ standard_name = water_vapor_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -247,7 +247,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -256,7 +256,7 @@ standard_name = air_pressure_at_interface long_name = interface pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -265,7 +265,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -274,7 +274,7 @@ standard_name = maximum_column_heating_rate long_name = maximum heating rate in column units = K s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -283,7 +283,7 @@ standard_name = vertical_index_at_cloud_top long_name = vertical index at cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -291,7 +291,7 @@ standard_name = vertical_index_at_cloud_base long_name = vertical index at cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -299,7 +299,7 @@ standard_name = flag_deep_convection long_name = flag indicating whether convection occurs in column (0 or 1) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -307,7 +307,7 @@ standard_name = cloud_area_fraction long_name = fraction of grid box area in which updrafts occur units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -361,7 +361,7 @@ standard_name = characteristic_grid_length_scale long_name = representative horizontal length scale of grid box units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -395,7 +395,7 @@ standard_name = tendency_of_x_wind_due_to_convective_gravity_wave_drag long_name = zonal wind tendency due to convective gravity wave drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -404,7 +404,7 @@ standard_name = tendency_of_y_wind_due_to_convective_gravity_wave_drag long_name = meridional wind tendency due to convective gravity wave drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -413,7 +413,7 @@ standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal stress at cloud top due to convective gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -422,7 +422,7 @@ standard_name = instantaneous_y_stress_due_to_gravity_wave_drag long_name = meridional stress at cloud top due to convective gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -518,7 +518,7 @@ standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal stress at cloud top due to convective gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -527,7 +527,7 @@ standard_name = instantaneous_y_stress_due_to_gravity_wave_drag long_name = meridional stress at cloud top due to convective gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -536,7 +536,7 @@ standard_name = tendency_of_x_wind_due_to_convective_gravity_wave_drag long_name = zonal wind tendency due to convective gravity wave drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -545,7 +545,7 @@ standard_name = tendency_of_y_wind_due_to_convective_gravity_wave_drag long_name = meridional wind tendency due to convective gravity wave drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -554,7 +554,7 @@ standard_name = time_integral_of_x_stress_due_to_gravity_wave_drag long_name = integral over time of zonal stress due to gravity wave drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -563,7 +563,7 @@ standard_name = time_integral_of_y_stress_due_to_gravity_wave_drag long_name = integral over time of meridional stress due to gravity wave drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -572,7 +572,7 @@ standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in zonal wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -581,7 +581,7 @@ standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in meridional wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -590,7 +590,7 @@ standard_name = x_wind_updated_by_physics long_name = updated zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -599,7 +599,7 @@ standard_name = y_wind_updated_by_physics long_name = updated meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -608,7 +608,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/gwdps.meta b/physics/gwdps.meta index 401024729..1935e9991 100644 --- a/physics/gwdps.meta +++ b/physics/gwdps.meta @@ -27,7 +27,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -36,7 +36,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -45,7 +45,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -54,7 +54,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = air_temperature long_name = mid-layer temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = water_vapor_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -98,7 +98,7 @@ standard_name = air_pressure_at_interface long_name = interface pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -116,7 +116,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -125,7 +125,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = mid-layer Exner function units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -134,7 +134,7 @@ standard_name = geopotential_at_interface long_name = interface geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -143,7 +143,7 @@ standard_name = geopotential long_name = mid-layer geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -169,7 +169,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -187,7 +187,7 @@ standard_name = asymmetry_of_subgrid_orography long_name = asymmetry of subgrid orography units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -196,7 +196,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -205,7 +205,7 @@ standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with respect to east of maximum subgrid orographic variations units = degree - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -214,7 +214,7 @@ standard_name = slope_of_subgrid_orography long_name = slope of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -223,7 +223,7 @@ standard_name = anisotropy_of_subgrid_orography long_name = anisotropy of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -232,7 +232,7 @@ standard_name = maximum_subgrid_orography long_name = maximum of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -241,7 +241,7 @@ standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -250,7 +250,7 @@ standard_name = instantaneous_y_stress_due_to_gravity_wave_drag long_name = meridional surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -344,7 +344,7 @@ standard_name = level_of_dividing_streamline long_name = level of the dividing streamline units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 27476ae08..62db330f4 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -44,7 +44,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -62,7 +62,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -71,7 +71,7 @@ standard_name = h2o_forcing long_name = water forcing data units = various - dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + dimensions = (horizontal_loop_extent,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) type = real kind = kind_phys intent = in diff --git a/physics/lsm_ruc_sfc_sice_interstitial.meta b/physics/lsm_ruc_sfc_sice_interstitial.meta index d78343422..d7a5736a5 100644 --- a/physics/lsm_ruc_sfc_sice_interstitial.meta +++ b/physics/lsm_ruc_sfc_sice_interstitial.meta @@ -43,7 +43,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -51,7 +51,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -59,7 +59,7 @@ standard_name = soil_temperature long_name = soil temperature units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -68,7 +68,7 @@ standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model units = K - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = in @@ -77,7 +77,7 @@ standard_name = internal_ice_temperature long_name = sea ice internal temperature units = K - dimensions = (horizontal_dimension,ice_vertical_dimension) + dimensions = (horizontal_loop_extent,ice_vertical_dimension) type = real kind = kind_phys intent = inout @@ -146,7 +146,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -154,7 +154,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = inout optional = F @@ -162,7 +162,7 @@ standard_name = soil_temperature long_name = soil temperature units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = in @@ -171,7 +171,7 @@ standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model units = K - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -180,7 +180,7 @@ standard_name = internal_ice_temperature long_name = sea ice internal temperature units = K - dimensions = (horizontal_dimension,ice_vertical_dimension) + dimensions = (horizontal_loop_extent,ice_vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/m_micro.meta b/physics/m_micro.meta index f61e6511f..8acd23cda 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -339,7 +339,7 @@ standard_name = air_pressure long_name = layer mean pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -348,7 +348,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -357,7 +357,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -366,7 +366,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -375,7 +375,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -384,7 +384,7 @@ standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -393,7 +393,7 @@ standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -402,7 +402,7 @@ standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -411,7 +411,7 @@ standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -420,7 +420,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -429,7 +429,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -438,7 +438,7 @@ standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -447,7 +447,7 @@ standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -456,7 +456,7 @@ standard_name = land_area_fraction_for_microphysics long_name = land area fraction used in microphysics schemes units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -465,7 +465,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = pbl height units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -474,7 +474,7 @@ standard_name = detrained_mass_flux long_name = detrained mass flux units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -483,7 +483,7 @@ standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -492,7 +492,7 @@ standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -501,7 +501,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -510,7 +510,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -519,7 +519,7 @@ standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc x momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -528,7 +528,7 @@ standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc y momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -537,7 +537,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -546,7 +546,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -555,7 +555,7 @@ standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -564,7 +564,7 @@ standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -573,7 +573,7 @@ standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -582,7 +582,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -591,7 +591,7 @@ standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -600,7 +600,7 @@ standard_name = ice_water_mixing_ratio_updated_by_physics long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -609,7 +609,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -618,7 +618,7 @@ standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel, ...) on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -627,7 +627,7 @@ standard_name = ratio_of_snowfall_to_rainfall long_name = snow ratio: ratio of snow to total precipitation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -636,7 +636,7 @@ standard_name = cloud_droplet_number_concentration_updated_by_physics long_name = number concentration of cloud droplets updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -645,7 +645,7 @@ standard_name = ice_number_concentration_updated_by_physics long_name = number concentration of ice updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -662,7 +662,7 @@ standard_name = local_rain_water_mixing_ratio long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -671,7 +671,7 @@ standard_name = local_snow_water_mixing_ratio long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -680,7 +680,7 @@ standard_name = local_graupel_mixing_ratio long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -689,7 +689,7 @@ standard_name = local_rain_number_concentration long_name = number concentration of rain local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -698,7 +698,7 @@ standard_name = local_snow_number_concentration long_name = number concentration of snow local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -707,7 +707,7 @@ standard_name = local_graupel_number_concentration long_name = number concentration of graupel local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -716,7 +716,7 @@ standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -725,7 +725,7 @@ standard_name = vertical_index_at_cloud_base long_name = vertical index at cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -733,7 +733,7 @@ standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = effective radius of cloud liquid water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -742,7 +742,7 @@ standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = effective radius of cloud ice water particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -751,7 +751,7 @@ standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um long_name = effective radius of cloud rain particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -760,7 +760,7 @@ standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -769,7 +769,7 @@ standard_name = effective_radius_of_stratiform_cloud_graupel_particle_in_um long_name = effective radius of cloud graupel particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -778,7 +778,7 @@ standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys intent = in @@ -787,7 +787,7 @@ standard_name = in_number_concentration long_name = IN number concentration units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -796,7 +796,7 @@ standard_name = ccn_number_concentration long_name = CCN number concentration units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -855,7 +855,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -864,7 +864,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -873,7 +873,7 @@ standard_name = critical_relative_humidity long_name = critical relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index ec0944f28..7961cb2db 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -59,7 +59,7 @@ standard_name = ice_water_mixing_ratio_updated_by_physics long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -68,7 +68,7 @@ standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -77,7 +77,7 @@ standard_name = rain_water_mixing_ratio_updated_by_physics long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -86,7 +86,7 @@ standard_name = snow_water_mixing_ratio_updated_by_physics long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -95,7 +95,7 @@ standard_name = graupel_mixing_ratio_updated_by_physics long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -104,7 +104,7 @@ standard_name = rain_number_concentration_updated_by_physics long_name = number concentration of rain updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -113,7 +113,7 @@ standard_name = snow_number_concentration_updated_by_physics long_name = number concentration of snow updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -122,7 +122,7 @@ standard_name = graupel_number_concentration_updated_by_physics long_name = number concentration of graupel updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -131,7 +131,7 @@ standard_name = subgrid_scale_cloud_fraction_from_shoc long_name = subgrid-scale cloud fraction from the SHOC scheme units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -140,7 +140,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -149,7 +149,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = local_rain_water_mixing_ratio long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -194,7 +194,7 @@ standard_name = local_snow_water_mixing_ratio long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -203,7 +203,7 @@ standard_name = local_graupel_mixing_ratio long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -212,7 +212,7 @@ standard_name = local_rain_number_concentration long_name = number concentration of rain local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -221,7 +221,7 @@ standard_name = local_snow_number_concentration long_name = number concentration of snow local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -230,7 +230,7 @@ standard_name = local_graupel_number_concentration long_name = number concentration of graupel local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -239,7 +239,7 @@ standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -248,7 +248,7 @@ standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -257,7 +257,7 @@ standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -266,7 +266,7 @@ standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -335,7 +335,7 @@ standard_name = local_rain_number_concentration long_name = number concentration of rain local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -344,7 +344,7 @@ standard_name = local_snow_number_concentration long_name = number concentration of snow local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -353,7 +353,7 @@ standard_name = local_graupel_number_concentration long_name = number concentration of graupel local to physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -362,7 +362,7 @@ standard_name = local_rain_water_mixing_ratio long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -371,7 +371,7 @@ standard_name = local_snow_water_mixing_ratio long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -380,7 +380,7 @@ standard_name = local_graupel_mixing_ratio long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -389,7 +389,7 @@ standard_name = ice_water_mixing_ratio_updated_by_physics long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -398,7 +398,7 @@ standard_name = rain_water_mixing_ratio_updated_by_physics long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -407,7 +407,7 @@ standard_name = snow_water_mixing_ratio_updated_by_physics long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -416,7 +416,7 @@ standard_name = graupel_mixing_ratio_updated_by_physics long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -425,7 +425,7 @@ standard_name = rain_number_concentration_updated_by_physics long_name = number concentration of rain updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -434,7 +434,7 @@ standard_name = snow_number_concentration_updated_by_physics long_name = number concentration of snow updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -443,7 +443,7 @@ standard_name = graupel_number_concentration_updated_by_physics long_name = number concentration of graupel updated by physics units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -452,7 +452,7 @@ standard_name = lwe_thickness_of_ice_amount_on_dynamics_timestep long_name = ice fall at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -461,7 +461,7 @@ standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep long_name = snow fall at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -470,7 +470,7 @@ standard_name = lwe_thickness_of_graupel_amount_on_dynamics_timestep long_name = graupel fall at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/maximum_hourly_diagnostics.meta b/physics/maximum_hourly_diagnostics.meta index 48223113c..67b3df039 100644 --- a/physics/maximum_hourly_diagnostics.meta +++ b/physics/maximum_hourly_diagnostics.meta @@ -84,7 +84,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -93,7 +93,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -102,7 +102,7 @@ standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm units = dBZ - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -111,7 +111,7 @@ standard_name = maximum_reflectivity_at_1km_agl_over_maximum_hourly_time_interval long_name = maximum reflectivity at 1km agl over maximum hourly time interval units = dBZ - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -120,7 +120,7 @@ standard_name = maximum_reflectivity_at_minus10c_over_maximum_hourly_time_interval long_name = maximum reflectivity at minus10c over maximum hourly time interval units = dBZ - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -129,7 +129,7 @@ standard_name = x_wind_at_10m long_name = 10 meter u wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -138,7 +138,7 @@ standard_name = y_wind_at_10m long_name = 10 meter v wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -147,7 +147,7 @@ standard_name = maximum_u_wind_at_10m_over_maximum_hourly_time_interval long_name = maximum u wind at 10m over maximum hourly time interval units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -156,7 +156,7 @@ standard_name = maximum_v_wind_at_10m_over_maximum_hourly_time_interval long_name = maximum v wind at 10m over maximum hourly time interval units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -165,7 +165,7 @@ standard_name = maximum_wind_at_10m_over_maximum_hourly_time_interval long_name = maximum wind at 10m over maximum hourly time interval units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -174,7 +174,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -183,7 +183,7 @@ standard_name = temperature_at_2m long_name = 2 meter temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -192,7 +192,7 @@ standard_name = specific_humidity_at_2m long_name = 2 meter specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -201,7 +201,7 @@ standard_name = maximum_temperature_at_2m_over_maximum_hourly_time_interval long_name = maximum temperature at 2m over maximum hourly time interval units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -210,7 +210,7 @@ standard_name = minimum_temperature_at_2m_over_maximum_hourly_time_interval long_name = minumum temperature at 2m over maximum hourly time interval units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -219,7 +219,7 @@ standard_name = maximum_relative_humidity_at_2m_over_maximum_hourly_time_interval long_name = maximum relative humidity at 2m over maximum hourly time interval units = % - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -228,7 +228,7 @@ standard_name = minimum_relative_humidity_at_2m_over_maximum_hourly_time_interval long_name = minumum relative humidity at 2m over maximum hourly time interval units = % - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index 356ce74a9..6d34ef64e 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -116,7 +116,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -125,7 +125,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -134,7 +134,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -143,7 +143,7 @@ standard_name = vertically_diffused_tracer_concentration long_name = tracer concentration diffused by PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -152,7 +152,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -161,7 +161,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -170,7 +170,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -179,7 +179,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -188,7 +188,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at lowest model interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -197,7 +197,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_layer long_name = dimensionless Exner function at lowest model layer units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -206,7 +206,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -215,7 +215,7 @@ standard_name = surface_skin_temperature long_name = surface temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -224,7 +224,7 @@ standard_name = surface_specific_humidity long_name = surface air saturation specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -233,7 +233,7 @@ standard_name = surface_specific_humidity_for_MYJ_schemes long_name = surface air saturation specific humidity for MYJ schem units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -242,7 +242,7 @@ standard_name = potential_temperature_at_viscous_sublayer_top long_name = potential temperat at viscous sublayer top over water units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -251,7 +251,7 @@ standard_name = specific_humidity_at_viscous_sublayer_top long_name = specific humidity at_viscous sublayer top over water units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -260,7 +260,7 @@ standard_name = u_wind_component_at_viscous_sublayer_top long_name = u wind component at viscous sublayer top over water units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -269,7 +269,7 @@ standard_name = v_wind_component_at_viscous_sublayer_top long_name = v wind component at viscous sublayer top over water units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -278,7 +278,7 @@ standard_name = baseline_surface_roughness_length long_name = baseline surface roughness length for momentum in mete units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -287,7 +287,7 @@ standard_name = heat_exchange_coefficient_for_MYJ_schemes long_name = surface heat exchange_coefficient for MYJ schemes units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -296,7 +296,7 @@ standard_name = momentum_exchange_coefficient_for_MYJ_schemes long_name = surface momentum exchange_coefficient for MYJ schemes units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -305,7 +305,7 @@ standard_name = surface_layer_evaporation_switch long_name = surface layer evaporation switch units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -314,7 +314,7 @@ standard_name = kinematic_surface_latent_heat_flux long_name = kinematic surface latent heat flux units = m s-1 kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -323,7 +323,7 @@ standard_name = weight_for_momentum_at_viscous_sublayer_top long_name = Weight for momentum at viscous layer top units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -332,7 +332,7 @@ standard_name = weight_for_potental_temperature_at_viscous_sublayer_top long_name = Weight for potental temperature at viscous layer top units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -341,7 +341,7 @@ standard_name = weight_for_specific_humidity_at_viscous_sublayer_top long_name = Weight for Specfic Humidity at viscous layer top units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -350,7 +350,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -359,7 +359,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -367,7 +367,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -375,7 +375,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -384,7 +384,7 @@ standard_name = cell_area long_name = area of the grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -393,7 +393,7 @@ standard_name = surface_friction_velocity long_name = boundary layer parameter units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -402,7 +402,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air long_name = surface exchange coeff for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -411,7 +411,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air long_name = surface exchange coeff heat & moisture units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -420,7 +420,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -429,7 +429,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -438,7 +438,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -447,7 +447,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -456,7 +456,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -465,7 +465,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -474,7 +474,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -483,7 +483,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -492,7 +492,7 @@ standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers PBL vertical diff units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -501,7 +501,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -510,7 +510,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -519,7 +519,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -528,7 +528,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -537,7 +537,7 @@ standard_name = atmosphere_heat_diffusivity long_name = diffusivity for heat units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) type = real kind = kind_phys intent = out @@ -573,7 +573,7 @@ standard_name = countergradient_mixing_term_for_temperature long_name = countergradient mixing term for temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -582,7 +582,7 @@ standard_name = countergradient_mixing_term_for_water_vapor long_name = countergradient mixing term for water vapor units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index 8938aeccd..e1e6ab2b9 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -107,7 +107,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -115,7 +115,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -124,7 +124,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -133,7 +133,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -142,7 +142,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -151,7 +151,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -160,7 +160,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -169,7 +169,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at lowest model interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -187,7 +187,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_layer long_name = dimensionless Exner function at lowest model layer units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -196,7 +196,7 @@ standard_name = surface_skin_temperature long_name = surface temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -205,7 +205,7 @@ standard_name = surface_specific_humidity long_name = surface air saturation specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -214,7 +214,7 @@ standard_name = surface_specific_humidity_for_MYJ_schemes long_name = surface air saturation specific humidity for MYJ schem units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -223,7 +223,7 @@ standard_name = potential_temperature_at_viscous_sublayer_top long_name = potential temperat at viscous sublayer top over water units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -232,7 +232,7 @@ standard_name = specific_humidity_at_viscous_sublayer_top long_name = specific humidity at_viscous sublayer top over water units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -241,7 +241,7 @@ standard_name = u_wind_component_at_viscous_sublayer_top long_name = u wind component at viscous sublayer top over water units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -250,7 +250,7 @@ standard_name = v_wind_component_at_viscous_sublayer_top long_name = v wind component at viscous sublayer top over water units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -259,7 +259,7 @@ standard_name = baseline_surface_roughness_length long_name = baseline surface roughness length for momentum in mete units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -268,7 +268,7 @@ standard_name = heat_exchange_coefficient_for_MYJ_schemes long_name = surface heat exchange_coefficient for MYJ schemes units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -277,7 +277,7 @@ standard_name = momentum_exchange_coefficient_for_MYJ_schemes long_name = surface momentum exchange_coefficient for MYJ schemes units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -286,7 +286,7 @@ standard_name = surface_layer_evaporation_switch long_name = surface layer evaporation switch units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -295,7 +295,7 @@ standard_name = kinematic_surface_latent_heat_flux long_name = kinematic surface latent heat flux units = m s-1 kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -304,7 +304,7 @@ standard_name = weight_for_momentum_at_viscous_sublayer_top long_name = Weight for momentum at viscous layer top units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -313,7 +313,7 @@ standard_name = weight_for_potental_temperature_at_viscous_sublayer_top long_name = Weight for potental temperature at viscous layer top units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -322,7 +322,7 @@ standard_name = weight_for_specific_humidity_at_viscous_sublayer_top long_name = Weight for Specfic Humidity at viscous layer top units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -331,7 +331,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -340,7 +340,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -349,7 +349,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -358,7 +358,7 @@ standard_name = surface_friction_velocity long_name = boundary layer parameter units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -367,7 +367,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -376,7 +376,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air long_name = surface exchange coeff for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -385,7 +385,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air long_name = surface exchange coeff heat & moisture units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -394,7 +394,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -403,7 +403,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin_Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -412,7 +412,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin_Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -421,7 +421,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m long_name = Monin_Obukhov similarity parameter for momentum at 10m units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -430,7 +430,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m long_name = Monin_Obukhov similarity parameter for heat at 2m units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -439,7 +439,7 @@ standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -448,7 +448,7 @@ standard_name = lake_area_fraction long_name = fraction of horizontal grid area occupied by lake units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -457,7 +457,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -466,7 +466,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -475,7 +475,7 @@ standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -484,7 +484,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -493,7 +493,7 @@ standard_name = surface_roughness_length_over_ice_interstitial long_name = surface roughness length over ice (interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -502,7 +502,7 @@ standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -511,7 +511,7 @@ standard_name = surface_friction_velocity_over_land long_name = surface friction velocity over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -520,7 +520,7 @@ standard_name = surface_friction_velocity_over_ice long_name = surface friction velocity over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -529,7 +529,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -538,7 +538,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -547,7 +547,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice long_name = surface exchange coeff for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -556,7 +556,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -565,7 +565,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -574,7 +574,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice long_name = surface exchange coeff heat & moisture over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -583,7 +583,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -592,7 +592,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_land long_name = bulk Richardson number at the surface over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -601,7 +601,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ice long_name = bulk Richardson number at the surface over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -610,7 +610,7 @@ standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -619,7 +619,7 @@ standard_name = surface_wind_stress_over_land long_name = surface wind stress over land units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -628,7 +628,7 @@ standard_name = surface_wind_stress_over_ice long_name = surface wind stress over ice units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -637,7 +637,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity funct for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -646,7 +646,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land long_name = Monin-Obukhov similarity funct for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -655,7 +655,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice long_name = Monin-Obukhov similarity funct for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -664,7 +664,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -673,7 +673,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_land long_name = Monin-Obukhov similarity function for heat over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -682,7 +682,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice long_name = Monin-Obukhov similarity function for heat over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -691,7 +691,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov parameter for momentum at 10m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -700,7 +700,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land long_name = Monin-Obukhov parameter for momentum at 10m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -709,7 +709,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice long_name = Monin-Obukhov parameter for momentum at 10m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -718,7 +718,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov parameter for heat at 2m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -727,7 +727,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land long_name = Monin-Obukhov parameter for heat at 2m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -736,7 +736,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice long_name = Monin-Obukhov parameter for heat at 2m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -745,7 +745,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index c51b6f0f7..4f2bc5cea 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -131,7 +131,7 @@ standard_name = cell_size long_name = size of the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -140,7 +140,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -149,7 +149,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -158,7 +158,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = cloud_condensed_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -212,7 +212,7 @@ standard_name = ice_water_mixing_ratio long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -221,7 +221,7 @@ standard_name = cloud_droplet_number_concentration long_name = number concentration of cloud droplets (liquid) units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -230,7 +230,7 @@ standard_name = ice_number_concentration long_name = number concentration of ice units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -239,7 +239,7 @@ standard_name = ozone_mixing_ratio long_name = ozone mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -248,7 +248,7 @@ standard_name = water_friendly_aerosol_number_concentration long_name = number concentration of water-friendly aerosols units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -257,7 +257,7 @@ standard_name = ice_friendly_aerosol_number_concentration long_name = number concentration of ice-friendly aerosols units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -266,7 +266,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -275,7 +275,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -284,7 +284,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -293,7 +293,7 @@ standard_name = surface_skin_temperature long_name = surface temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -302,7 +302,7 @@ standard_name = surface_specific_humidity long_name = surface air saturation specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -311,7 +311,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -320,7 +320,7 @@ standard_name = surface_friction_velocity long_name = boundary layer parameter units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -329,7 +329,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air long_name = momentum exchange coefficient units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -338,7 +338,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -347,7 +347,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -356,7 +356,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -365,7 +365,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -374,7 +374,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux valid for current call units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -383,7 +383,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux valid for current call units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -392,7 +392,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = surface momentum flux in the x-direction valid for current call units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -401,7 +401,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = surface momentum flux in the y-direction valid for current call units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -410,7 +410,7 @@ standard_name = instantaneous_surface_x_momentum_flux_for_diag long_name = instantaneous sfc x momentum flux multiplied by timestep units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -419,7 +419,7 @@ standard_name = instantaneous_surface_y_momentum_flux_for_diag long_name = instantaneous sfc y momentum flux multiplied by timestep units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -428,7 +428,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux_for_diag long_name = instantaneous sfc sensible heat flux multiplied by timestep units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -437,7 +437,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux_for_diag long_name = instantaneous sfc latent heat flux multiplied by timestep units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -446,7 +446,7 @@ standard_name = cumulative_surface_x_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc x momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -455,7 +455,7 @@ standard_name = cumulative_surface_y_momentum_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc y momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -464,7 +464,7 @@ standard_name = cumulative_surface_upward_sensible_heat_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -473,7 +473,7 @@ standard_name = cumulative_surface_upward_latent_heat_flux_for_diag_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -482,7 +482,7 @@ standard_name = surface_x_momentum_flux_for_coupling long_name = sfc x momentum flux for coupling units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -491,7 +491,7 @@ standard_name = surface_y_momentum_flux_for_coupling long_name = sfc y momentum flux for coupling units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -500,7 +500,7 @@ standard_name = surface_upward_sensible_heat_flux_for_coupling long_name = sfc sensible heat flux for coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -509,7 +509,7 @@ standard_name = surface_upward_latent_heat_flux_for_coupling long_name = sfc latent heat flux for coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -518,7 +518,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -527,7 +527,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -536,7 +536,7 @@ standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -545,7 +545,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -554,7 +554,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -563,7 +563,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -571,7 +571,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -579,7 +579,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -587,7 +587,7 @@ standard_name = instantaneous_surface_x_momentum_flux_for_coupling long_name = instantaneous sfc u momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -596,7 +596,7 @@ standard_name = instantaneous_surface_y_momentum_flux_for_coupling long_name = instantaneous sfc v momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -605,7 +605,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux_for_coupling long_name = instantaneous sfc sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -614,7 +614,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux_for_coupling long_name = instantaneous sfc latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -623,7 +623,7 @@ standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc u momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -632,7 +632,7 @@ standard_name = cumulative_surface_y_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc v momentum flux multiplied by timestep units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -641,7 +641,7 @@ standard_name = cumulative_surface_upward_sensible_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc sensible heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -650,7 +650,7 @@ standard_name = cumulative_surface_upward_latent_heat_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc latent heat flux multiplied by timestep units = W m-2 s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -659,7 +659,7 @@ standard_name = reciprocal_of_obukhov_length long_name = one over obukhov length units = m-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -668,7 +668,7 @@ standard_name = tke_at_mass_points long_name = 2 x tke at mass points units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -677,7 +677,7 @@ standard_name = turbulent_kinetic_energy long_name = turbulent kinetic energy units = J - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -686,7 +686,7 @@ standard_name = t_prime_squared long_name = temperature fluctuation squared units = K2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -695,7 +695,7 @@ standard_name = q_prime_squared long_name = water vapor fluctuation squared units = kg2 kg-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -704,7 +704,7 @@ standard_name = t_prime_q_prime long_name = covariance of temperature and moisture units = K kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -713,7 +713,7 @@ standard_name = mixing_length long_name = mixing length in meters units = m - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -722,7 +722,7 @@ standard_name = stability_function_for_heat long_name = stability function for heat units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -731,7 +731,7 @@ standard_name = atmosphere_heat_diffusivity_for_mynnpbl long_name = diffusivity for heat for MYNN PBL (defined for all mass levels) units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -740,7 +740,7 @@ standard_name = atmosphere_momentum_diffusivity_for_mynnpbl long_name = diffusivity for momentum for MYNN PBL (defined for all mass levels) units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -749,7 +749,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -758,7 +758,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -766,7 +766,7 @@ standard_name = subgrid_cloud_water_mixing_ratio_pbl long_name = subgrid cloud water mixing ratio from PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -775,7 +775,7 @@ standard_name = subgrid_cloud_ice_mixing_ratio_pbl long_name = subgrid cloud ice mixing ratio from PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -784,7 +784,7 @@ standard_name = subgrid_cloud_fraction_pbl long_name = subgrid cloud fraction from PBL scheme units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -793,7 +793,7 @@ standard_name = emdf_updraft_area long_name = updraft area from mass flux scheme units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -802,7 +802,7 @@ standard_name = emdf_updraft_vertical_velocity long_name = updraft vertical velocity from mass flux scheme units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -811,7 +811,7 @@ standard_name = emdf_updraft_total_water long_name = updraft total water from mass flux scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -820,7 +820,7 @@ standard_name = emdf_updraft_theta_l long_name = updraft theta-l from mass flux scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -829,7 +829,7 @@ standard_name = emdf_updraft_entrainment_rate long_name = updraft entrainment rate from mass flux scheme units = s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -838,7 +838,7 @@ standard_name = emdf_updraft_cloud_water long_name = updraft cloud water from mass flux scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -847,7 +847,7 @@ standard_name = theta_subsidence_tendency long_name = updraft theta subsidence tendency units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -856,7 +856,7 @@ standard_name = water_vapor_subsidence_tendency long_name = updraft water vapor subsidence tendency units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -865,7 +865,7 @@ standard_name = theta_detrainment_tendency long_name = updraft theta detrainment tendency units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -874,7 +874,7 @@ standard_name = water_vapor_detrainment_tendency long_name = updraft water vapor detrainment tendency units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -883,7 +883,7 @@ standard_name = number_of_plumes long_name = number of plumes per grid column units = count - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -891,7 +891,7 @@ standard_name = maximum_mass_flux long_name = maximum mass flux within a column units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -900,7 +900,7 @@ standard_name = k_level_of_highest_plume long_name = k-level of highest plume units = count - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -908,7 +908,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -917,7 +917,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -926,7 +926,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -935,7 +935,7 @@ standard_name = tendency_of_water_vapor_specific_humidity_due_to_model_physics long_name = water vapor specific humidity tendency due to model physics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -944,7 +944,7 @@ standard_name = tendency_of_liquid_cloud_water_mixing_ratio_due_to_model_physics long_name = cloud condensed water mixing ratio tendency due to model physics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -953,7 +953,7 @@ standard_name = tendency_of_ice_cloud_water_mixing_ratio_due_to_model_physics long_name = cloud condensed water mixing ratio tendency due to model physics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -962,7 +962,7 @@ standard_name = tendency_of_ozone_mixing_ratio_due_to_model_physics long_name = ozone mixing ratio tendency due to model physics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -971,7 +971,7 @@ standard_name = tendency_of_cloud_droplet_number_concentration_due_to_model_physics long_name = number conc. of cloud droplets (liquid) tendency due to model physics units = kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -980,7 +980,7 @@ standard_name = tendency_of_ice_number_concentration_due_to_model_physics long_name = number conc. of ice tendency due to model physics units = kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -989,7 +989,7 @@ standard_name = tendency_of_water_friendly_aerosol_number_concentration_due_to_model_physics long_name = number conc. of water-friendly aerosols tendency due to model physics units = kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -998,7 +998,7 @@ standard_name = tendency_of_ice_friendly_aerosol_number_concentration_due_to_model_physics long_name = number conc. of ice-friendly aerosols tendency due to model physics units = kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1007,7 +1007,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1016,7 +1016,7 @@ standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in x wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1025,7 +1025,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1034,7 +1034,7 @@ standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in y wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1043,7 +1043,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1052,7 +1052,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1061,7 +1061,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1070,7 +1070,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1079,7 +1079,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1088,7 +1088,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 59df18419..6a410c297 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -67,7 +67,7 @@ standard_name = bounded_vegetation_area_fraction long_name = areal fractional cover of green vegetation bounded on the bottom units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -76,7 +76,7 @@ standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -84,7 +84,7 @@ standard_name = maximum_vegetation_area_fraction long_name = max fractnl cover of green veg units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -101,7 +101,7 @@ standard_name = perturbation_of_momentum_roughness_length long_name = perturbation of momentum roughness length units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -110,7 +110,7 @@ standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio long_name = perturbation of heat to momentum roughness length ratio units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -144,7 +144,7 @@ standard_name = cell_size long_name = size of the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -153,7 +153,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -162,7 +162,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -171,7 +171,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -180,7 +180,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -189,7 +189,7 @@ standard_name = cloud_condensed_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -198,7 +198,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -207,7 +207,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -216,7 +216,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -225,7 +225,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -234,7 +234,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -243,7 +243,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -260,7 +260,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -268,7 +268,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -276,7 +276,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -285,7 +285,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -294,7 +294,7 @@ standard_name = surface_skin_temperature_over_ice_interstitial long_name = surface skin temperature over ice (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -303,7 +303,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -312,7 +312,7 @@ standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -321,7 +321,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ice long_name = surface skin temperature after iteration over ice units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -330,7 +330,7 @@ standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -339,7 +339,7 @@ standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -348,7 +348,7 @@ standard_name = surface_specific_humidity_over_ice long_name = surface air saturation specific humidity over ice units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -357,7 +357,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -366,7 +366,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -375,7 +375,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -384,7 +384,7 @@ standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -393,7 +393,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -402,7 +402,7 @@ standard_name = surface_roughness_length_over_ice_interstitial long_name = surface roughness length over ice (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -411,7 +411,7 @@ standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -420,7 +420,7 @@ standard_name = surface_friction_velocity_over_land long_name = surface friction velocity over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -429,7 +429,7 @@ standard_name = surface_friction_velocity_over_ice long_name = surface friction velocity over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -438,7 +438,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -447,7 +447,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -456,7 +456,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice long_name = surface exchange coeff for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -465,7 +465,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -474,7 +474,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -483,7 +483,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice long_name = surface exchange coeff heat & moisture over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -492,7 +492,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -501,7 +501,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_land long_name = bulk Richardson number at the surface over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -510,7 +510,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ice long_name = bulk Richardson number at the surface over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -519,7 +519,7 @@ standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -528,7 +528,7 @@ standard_name = surface_wind_stress_over_land long_name = surface wind stress over land units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -537,7 +537,7 @@ standard_name = surface_wind_stress_over_ice long_name = surface wind stress over ice units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -546,7 +546,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity function for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -555,7 +555,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land long_name = Monin-Obukhov similarity function for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -564,7 +564,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice long_name = Monin-Obukhov similarity function for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -573,7 +573,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -582,7 +582,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_land long_name = Monin-Obukhov similarity function for heat over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -591,7 +591,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice long_name = Monin-Obukhov similarity function for heat over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -600,7 +600,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -609,7 +609,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land long_name = Monin-Obukhov similarity parameter for momentum at 10m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -618,7 +618,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -627,7 +627,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -636,7 +636,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land long_name = Monin-Obukhov similarity parameter for heat at 2m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -645,7 +645,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice long_name = Monin-Obukhov similarity parameter for heat at 2m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -654,7 +654,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -663,7 +663,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -672,7 +672,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice long_name = kinematic surface upward sensible heat flux over ice units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -681,7 +681,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -690,7 +690,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward latent heat flux over land units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -699,7 +699,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ice long_name = kinematic surface upward latent heat flux over ice units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -708,7 +708,7 @@ standard_name = surface_specific_humidity long_name = surface air saturation specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -717,7 +717,7 @@ standard_name = water_vapor_mixing_ratio_at_surface long_name = water vapor mixing ratio at surface units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -726,7 +726,7 @@ standard_name = surface_friction_velocity_drag long_name = friction velocity isolated for momentum only units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -735,7 +735,7 @@ standard_name = surface_stability_parameter long_name = monin obukhov surface stability parameter units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -744,7 +744,7 @@ standard_name = theta_star long_name = temperature flux divided by ustar (temperature scale) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -753,7 +753,7 @@ standard_name = reciprocal_of_obukhov_length long_name = one over obukhov length units = m-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -762,7 +762,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -771,7 +771,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air long_name = momentum exchange coefficient units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -780,7 +780,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -789,7 +789,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -798,7 +798,7 @@ standard_name = surface_latent_heat long_name = latent heating at the surface (pos = up) units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -807,7 +807,7 @@ standard_name = surface_exchange_coefficient_for_heat long_name = surface exchange coefficient for heat units = W m-2 K-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -816,7 +816,7 @@ standard_name = surface_exchange_coefficient_for_moisture long_name = surface exchange coefficient for moisture units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -825,7 +825,7 @@ standard_name = x_wind_at_10m long_name = 10 meter u wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -834,7 +834,7 @@ standard_name = y_wind_at_10m long_name = 10 meter v wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -843,7 +843,7 @@ standard_name = potential_temperature_at_2m long_name = 2 meter potential temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -852,7 +852,7 @@ standard_name = temperature_at_2m long_name = 2 meter temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -861,7 +861,7 @@ standard_name = specific_humidity_at_2m long_name = 2 meter specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -870,7 +870,7 @@ standard_name = surface_wind_enhancement_due_to_convection long_name = surface wind enhancement due to convection units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -879,7 +879,7 @@ standard_name = surface_exchange_coefficient_for_heat_at_2m long_name = exchange coefficient for heat at 2 meters units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -888,7 +888,7 @@ standard_name = surface_exchange_coefficient_for_moisture_at_2m long_name = exchange coefficient for moisture at 2 meters units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta index 089c770c2..06df85da7 100644 --- a/physics/module_SGSCloud_RadPost.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -43,7 +43,7 @@ standard_name = cloud_condensed_water_mixing_ratio long_name = no condensates) ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -52,7 +52,7 @@ standard_name = ice_water_mixing_ratio long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -61,7 +61,7 @@ standard_name = cloud_condensed_water_mixing_ratio_save long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -70,7 +70,7 @@ standard_name = ice_water_mixing_ratio_save long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index e74f5f7ee..d8b5fd5da 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -43,7 +43,7 @@ standard_name = cloud_condensed_water_mixing_ratio long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -52,7 +52,7 @@ standard_name = ice_water_mixing_ratio long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -61,7 +61,7 @@ standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -70,7 +70,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -79,7 +79,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -88,7 +88,7 @@ standard_name = rain_water_mixing_ratio long_name = moist (dry+vapor, no condensates) mixing ratio of rain water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -97,7 +97,7 @@ standard_name = snow_water_mixing_ratio long_name = moist (dry+vapor, no condensates) mixing ratio of snow water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -106,7 +106,7 @@ standard_name = graupel_mixing_ratio long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -115,7 +115,7 @@ standard_name = convective_cloud_condesate_after_rainout long_name = convective cloud condesate after rainout units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -140,7 +140,7 @@ standard_name = cloud_condensed_water_mixing_ratio_save long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -149,7 +149,7 @@ standard_name = ice_water_mixing_ratio_save long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -158,7 +158,7 @@ standard_name = subgrid_cloud_water_mixing_ratio_pbl long_name = subgrid cloud water mixing ratio from PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = subgrid_cloud_ice_mixing_ratio_pbl long_name = subgrid cloud ice mixing ratio from PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = subgrid_cloud_fraction_pbl long_name = subgrid cloud fraction from PBL scheme units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness on radiation levels units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -203,7 +203,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -212,7 +212,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -221,7 +221,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -230,7 +230,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -239,7 +239,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -256,7 +256,7 @@ standard_name = air_pressure_at_layer_for_radiation_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -265,7 +265,7 @@ standard_name = latitude long_name = grid latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -274,7 +274,7 @@ standard_name = layer_thickness_for_radiation long_name = layer thickness on radiation levels units = km - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -283,7 +283,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -292,7 +292,7 @@ standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle,high, total and BL units = frac - dimensions = (horizontal_dimension,5) + dimensions = (horizontal_loop_extent,5) type = real kind = kind_phys intent = inout @@ -301,7 +301,7 @@ standard_name = model_layer_number_at_cloud_top long_name = vertical indices for low, middle and high cloud tops units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = inout optional = F @@ -309,7 +309,7 @@ standard_name = model_layer_number_at_cloud_base long_name = vertical indices for low, middle and high cloud bases units = index - dimensions = (horizontal_dimension,3) + dimensions = (horizontal_loop_extent,3) type = integer intent = inout optional = F diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 31a26053f..1dfef6e9e 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -74,7 +74,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -83,7 +83,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -92,7 +92,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -101,7 +101,7 @@ standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -110,7 +110,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -119,7 +119,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -128,7 +128,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = vertically_diffused_tracer_concentration long_name = tracer concentration diffused by PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = in @@ -146,7 +146,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -155,7 +155,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -164,7 +164,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -173,7 +173,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the surface interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -182,7 +182,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -191,7 +191,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -200,7 +200,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -209,7 +209,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -218,7 +218,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -227,7 +227,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -236,7 +236,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -245,7 +245,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -254,7 +254,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -263,7 +263,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -272,7 +272,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -281,7 +281,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -289,7 +289,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -298,7 +298,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -307,7 +307,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -316,7 +316,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -325,7 +325,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -334,7 +334,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -360,7 +360,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -369,7 +369,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -378,7 +378,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -387,7 +387,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -396,7 +396,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -405,7 +405,7 @@ standard_name = countergradient_mixing_term_for_temperature long_name = countergradient mixing term for temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -414,7 +414,7 @@ standard_name = countergradient_mixing_term_for_water_vapor long_name = countergradient mixing term for water vapor units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -423,7 +423,7 @@ standard_name = atmosphere_heat_diffusivity long_name = diffusivity for heat units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) type = real kind = kind_phys intent = out @@ -432,7 +432,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -541,7 +541,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -550,7 +550,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -559,7 +559,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -568,7 +568,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -577,7 +577,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index d79245330..d6872cf7f 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -74,7 +74,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -83,7 +83,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -92,7 +92,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -101,7 +101,7 @@ standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -110,7 +110,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -119,7 +119,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -128,7 +128,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = vertically_diffused_tracer_concentration long_name = tracer concentration diffused by PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = in @@ -146,7 +146,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -155,7 +155,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -164,7 +164,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -173,7 +173,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the surface interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -182,7 +182,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -191,7 +191,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -200,7 +200,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -209,7 +209,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -218,7 +218,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -227,7 +227,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -236,7 +236,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -245,7 +245,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -254,7 +254,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -263,7 +263,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -272,7 +272,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -281,7 +281,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -289,7 +289,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -298,7 +298,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -307,7 +307,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -316,7 +316,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -325,7 +325,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -334,7 +334,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -360,7 +360,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -369,7 +369,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -378,7 +378,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -387,7 +387,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -396,7 +396,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -405,7 +405,7 @@ standard_name = countergradient_mixing_term_for_temperature long_name = countergradient mixing term for temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -414,7 +414,7 @@ standard_name = countergradient_mixing_term_for_water_vapor long_name = countergradient mixing term for water vapor units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -423,7 +423,7 @@ standard_name = atmosphere_heat_diffusivity long_name = diffusivity for heat units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) type = real kind = kind_phys intent = out @@ -432,7 +432,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -501,7 +501,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index 48754564f..2bcd2a872 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -51,7 +51,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -60,7 +60,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -69,7 +69,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -78,7 +78,7 @@ standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -87,7 +87,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -96,7 +96,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -105,7 +105,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -114,7 +114,7 @@ standard_name = vertically_diffused_tracer_concentration long_name = tracer concentration diffused by PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = in @@ -123,7 +123,7 @@ standard_name = atmosphere_heat_diffusivity_from_shoc long_name = diffusivity for heat from the SHOC scheme units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -132,7 +132,7 @@ standard_name = prandtl_number long_name = turbulent Prandtl number units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -149,7 +149,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the surface interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -158,7 +158,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -212,7 +212,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -221,7 +221,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -230,7 +230,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -239,7 +239,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -248,7 +248,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -257,7 +257,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -265,7 +265,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -274,7 +274,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -283,7 +283,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -292,7 +292,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -301,7 +301,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -310,7 +310,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -328,7 +328,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -337,7 +337,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -346,7 +346,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -355,7 +355,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -364,7 +364,7 @@ standard_name = atmosphere_heat_diffusivity long_name = diffusivity for heat units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension_minus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) type = real kind = kind_phys intent = out @@ -373,7 +373,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -382,7 +382,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index a0591ade8..0e790d71c 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -173,7 +173,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind= kind_phys intent = in @@ -182,7 +182,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -191,7 +191,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -200,7 +200,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -209,7 +209,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -218,7 +218,7 @@ standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics long_name = total cloud condensate mixing ratio (except water vapor) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -227,7 +227,7 @@ standard_name = accumulated_change_of_air_temperature_due_to_FA_scheme long_name = accumulated change of air temperature due to FA MP scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -236,7 +236,7 @@ standard_name = ratio_of_snowfall_to_rainfall long_name = snow ratio: ratio of snow to total precipitation (explicit only) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -245,7 +245,7 @@ standard_name = fraction_of_ice_water_cloud long_name = fraction of ice water cloud units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -254,7 +254,7 @@ standard_name = fraction_of_rain_water_cloud long_name = fraction of rain water cloud units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -263,7 +263,7 @@ standard_name = rime_factor long_name = rime factor units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -272,7 +272,7 @@ standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -281,7 +281,7 @@ standard_name = ice_water_mixing_ratio_updated_by_physics long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -290,7 +290,7 @@ standard_name = rain_water_mixing_ratio_updated_by_physics long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -299,7 +299,7 @@ standard_name = mass_weighted_rime_factor_updated_by_physics long_name = mass weighted rime factor updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -308,7 +308,7 @@ standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation ( rain, ice, snow, graupel, ...) on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -341,7 +341,7 @@ standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm units = dBZ - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -359,7 +359,7 @@ standard_name = cell_size long_name = relative dx for the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 427b2bc84..f290639a6 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -345,7 +345,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -354,7 +354,7 @@ standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics long_name = cloud water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -363,7 +363,7 @@ standard_name = rain_water_mixing_ratio_updated_by_physics long_name = rain water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -372,7 +372,7 @@ standard_name = ice_water_mixing_ratio_updated_by_physics long_name = ice water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -381,7 +381,7 @@ standard_name = snow_water_mixing_ratio_updated_by_physics long_name = snow water mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -390,7 +390,7 @@ standard_name = graupel_mixing_ratio_updated_by_physics long_name = graupel mixing ratio wrt dry+vapor (no condensates) units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -399,7 +399,7 @@ standard_name = ice_number_concentration_updated_by_physics long_name = ice number concentration units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -408,7 +408,7 @@ standard_name = rain_number_concentration_updated_by_physics long_name = rain number concentration units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -425,7 +425,7 @@ standard_name = cloud_droplet_number_concentration_updated_by_physics long_name = cloud droplet number concentration units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -434,7 +434,7 @@ standard_name = water_friendly_aerosol_number_concentration_updated_by_physics long_name = number concentration of water-friendly aerosols units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -443,7 +443,7 @@ standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics long_name = number concentration of ice-friendly aerosols units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -452,7 +452,7 @@ standard_name = tendency_of_water_friendly_aerosols_at_surface long_name = instantaneous fake water-friendly surface aerosol source units = kg-1 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -461,7 +461,7 @@ standard_name = tendency_of_ice_friendly_aerosols_at_surface long_name = instantaneous fake ice-friendly surface aerosol source units = kg-1 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -470,7 +470,7 @@ standard_name = air_temperature_updated_by_physics long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -479,7 +479,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -488,7 +488,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -497,7 +497,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -515,7 +515,7 @@ standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation (rain, ice, snow, graupel) on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -524,7 +524,7 @@ standard_name = lwe_thickness_of_explicit_rain_amount long_name = explicit rain fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -533,7 +533,7 @@ standard_name = lwe_thickness_of_graupel_amount long_name = graupel fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -542,7 +542,7 @@ standard_name = lwe_thickness_of_ice_amount long_name = ice fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -551,7 +551,7 @@ standard_name = lwe_thickness_of_snow_amount long_name = snow fall on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -560,7 +560,7 @@ standard_name = ratio_of_snowfall_to_rainfall long_name = ratio of snowfall to large-scale rainfall units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -569,7 +569,7 @@ standard_name = radar_reflectivity_10cm long_name = instantaneous refl_10cm units = dBZ - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -594,7 +594,7 @@ standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer (meter here) units = m - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -603,7 +603,7 @@ standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer (meter here) units = m - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -612,7 +612,7 @@ standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometer (meter here) units = m - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/mp_thompson_post.meta b/physics/mp_thompson_post.meta index 2c68fc78a..248705b30 100644 --- a/physics/mp_thompson_post.meta +++ b/physics/mp_thompson_post.meta @@ -58,7 +58,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -67,7 +67,7 @@ standard_name = air_temperature_updated_by_physics long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -76,7 +76,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/mp_thompson_pre.meta b/physics/mp_thompson_pre.meta index 2511ba3bc..e695d0a11 100644 --- a/physics/mp_thompson_pre.meta +++ b/physics/mp_thompson_pre.meta @@ -27,7 +27,7 @@ standard_name = air_temperature_updated_by_physics long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = air_temperature_save long_name = air temperature before entering a physics scheme units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/ozphys.meta b/physics/ozphys.meta index b43f7931c..2edfc04e8 100644 --- a/physics/ozphys.meta +++ b/physics/ozphys.meta @@ -74,7 +74,7 @@ standard_name = ozone_concentration_updated_by_physics long_name = ozone concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -83,7 +83,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -101,7 +101,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -110,7 +110,7 @@ standard_name = ozone_forcing long_name = ozone forcing coefficients units = various - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -152,7 +152,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate long_name = cumulative change in ozone concentration due to production and loss rate units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -161,7 +161,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio long_name = cumulative change in ozone concentration due to ozone mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -170,7 +170,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_temperature long_name = cumulative change in ozone concentration due to temperature units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -179,7 +179,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column long_name = cumulative change in ozone concentration due to overhead ozone column units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/ozphys_2015.meta b/physics/ozphys_2015.meta index 2db91982f..11f1dfa0c 100644 --- a/physics/ozphys_2015.meta +++ b/physics/ozphys_2015.meta @@ -74,7 +74,7 @@ standard_name = ozone_concentration_updated_by_physics long_name = ozone concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -83,7 +83,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -101,7 +101,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -110,7 +110,7 @@ standard_name = ozone_forcing long_name = ozone forcing data units = various - dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + dimensions = (horizontal_loop_extent,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = difference between mid-layer pressures units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -152,7 +152,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate long_name = cumulative change in ozone concentration due to production and loss rate units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -161,7 +161,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio long_name = cumulative change in ozone concentration due to ozone mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -170,7 +170,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_temperature long_name = cumulative change in ozone concentration due to temperature units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -179,7 +179,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column long_name = cumulative change in ozone concentration due to overhead ozone column units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/phys_tend.meta b/physics/phys_tend.meta index b5637063c..3af255148 100644 --- a/physics/phys_tend.meta +++ b/physics/phys_tend.meta @@ -27,7 +27,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in x wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -45,7 +45,7 @@ standard_name = cumulative_change_in_x_wind_due_to_deep_convection long_name = cumulative change in x wind due to deep convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -54,7 +54,7 @@ standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in x wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = cumulative_change_in_x_wind_due_to_rayleigh_damping long_name = cumulative change in x wind due to Rayleigh damping units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = cumulative_change_in_x_wind_due_to_shallow_convection long_name = cumulative change in x wind due to shallow convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = cumulative_change_in_x_wind_due_to_physics long_name = cumulative change in x wind due to physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -90,7 +90,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -99,7 +99,7 @@ standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in y wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -108,7 +108,7 @@ standard_name = cumulative_change_in_y_wind_due_to_deep_convection long_name = cumulative change in y wind due to deep convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -117,7 +117,7 @@ standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in y wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -126,7 +126,7 @@ standard_name = cumulative_change_in_y_wind_due_to_rayleigh_damping long_name = cumulative change in y wind due to Rayleigh damping units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -135,7 +135,7 @@ standard_name = cumulative_change_in_y_wind_due_to_shallow_convection long_name = cumulative change in y wind due to shallow convection units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -144,7 +144,7 @@ standard_name = cumulative_change_in_y_wind_due_to_physics long_name = cumulative change in y wind due to physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -153,7 +153,7 @@ standard_name = cumulative_change_in_temperature_due_to_longwave_radiation long_name = cumulative change in temperature due to longwave radiation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -162,7 +162,7 @@ standard_name = cumulative_change_in_temperature_due_to_shortwave_radiation long_name = cumulative change in temperature due to shortwave radiation units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -171,7 +171,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -180,7 +180,7 @@ standard_name = cumulative_change_in_temperature_due_to_deep_convection long_name = cumulative change in temperature due to deep convection units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -189,7 +189,7 @@ standard_name = cumulative_change_in_temperature_due_to_shallow_convection long_name = cumulative change in temperature due to shallow convection units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -198,7 +198,7 @@ standard_name = cumulative_change_in_temperature_due_to_microphysics long_name = cumulative change in temperature due to microphysics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -207,7 +207,7 @@ standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag long_name = cumulative change in temperature due to orographic gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -216,7 +216,7 @@ standard_name = cumulative_change_in_temperature_due_to_rayleigh_damping long_name = cumulative change in temperature due to Rayleigh damping units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -225,7 +225,7 @@ standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag long_name = cumulative change in temperature due to convective gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -234,7 +234,7 @@ standard_name = cumulative_change_in_temperature_due_to_physics long_name = cumulative change in temperature due to physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -243,7 +243,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_deep_convection long_name = cumulative change in water vapor specific humidity due to deep convection units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -261,7 +261,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_shallow_convection long_name = cumulative change in water vapor specific humidity due to shallow convection units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -270,7 +270,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_microphysics long_name = cumulative change in water vapor specific humidity due to microphysics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -279,7 +279,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -288,7 +288,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_production_and_loss_rate long_name = cumulative change in ozone concentration due to production and loss rate units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -297,7 +297,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_ozone_mixing_ratio long_name = cumulative change in ozone concentration due to ozone mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -306,7 +306,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_temperature long_name = cumulative change in ozone concentration due to temperature units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -315,7 +315,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_overhead_ozone_column long_name = cumulative change in ozone concentration due to overhead ozone column units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -324,7 +324,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_physics long_name = cumulative change in water vapor specific humidity due to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -333,7 +333,7 @@ standard_name = cumulative_change_in_ozone_concentration_due_to_physics long_name = cumulative change in ozone concentration due to physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/precpd.meta b/physics/precpd.meta index 3d76d18ed..715991990 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -36,7 +36,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pressure level thickness units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -45,7 +45,7 @@ standard_name = air_pressure long_name = layer mean pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -54,7 +54,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -63,7 +63,7 @@ standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics long_name = moist cloud condensed water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -72,7 +72,7 @@ standard_name = air_temperature_updated_by_physics long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -81,7 +81,7 @@ standard_name = lwe_thickness_of_explicit_precipitation_amount long_name = explicit precipitation amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -90,7 +90,7 @@ standard_name = ratio_of_snowfall_to_rainfall long_name = ratio of snowfall to large-scale rainfall units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -99,7 +99,7 @@ standard_name = tendency_of_rain_water_mixing_ratio_due_to_microphysics long_name = tendency of rain water mixing ratio due to microphysics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -108,7 +108,7 @@ standard_name = critical_relative_humidity long_name = critical relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -153,7 +153,7 @@ standard_name = grid_size_related_coefficient_used_in_scale_sensitive_schemes long_name = grid size related coefficient used in scale-sensitive schemes units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 05fcf1de6..15347f363 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -11,7 +11,7 @@ standard_name = air_pressure_at_layer_for_radiation_in_hPa long_name = air pressure layer units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -20,7 +20,7 @@ standard_name = air_pressure_at_interface_for_radiation_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -29,7 +29,7 @@ standard_name = air_temperature_at_layer_for_radiation long_name = air temperature layer units = K - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -38,7 +38,7 @@ standard_name = air_temperature_at_interface_for_radiation long_name = air temperature level units = K - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -47,7 +47,7 @@ standard_name = water_vapor_specific_humidity_at_layer_for_radiation long_name = specific humidity layer units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -56,7 +56,7 @@ standard_name = ozone_concentration_at_layer_for_radiation long_name = ozone concentration layer units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -65,7 +65,7 @@ standard_name = volume_mixing_ratio_co2 long_name = volume mixing ratio co2 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -74,7 +74,7 @@ standard_name = volume_mixing_ratio_n2o long_name = volume mixing ratio no2 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -83,7 +83,7 @@ standard_name = volume_mixing_ratio_ch4 long_name = volume mixing ratio ch4 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -92,7 +92,7 @@ standard_name = volume_mixing_ratio_o2 long_name = volume mixing ratio o2 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -101,7 +101,7 @@ standard_name = volume_mixing_ratio_co long_name = volume mixing ratio co units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -110,7 +110,7 @@ standard_name = volume_mixing_ratio_cfc11 long_name = volume mixing ratio cfc11 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -119,7 +119,7 @@ standard_name = volume_mixing_ratio_cfc12 long_name = volume mixing ratio cfc12 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -128,7 +128,7 @@ standard_name = volume_mixing_ratio_cfc22 long_name = volume mixing ratio cfc22 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = volume_mixing_ratio_ccl4 long_name = volume mixing ratio ccl4 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -146,7 +146,7 @@ standard_name = seed_random_numbers_lw long_name = seed for random number generation for longwave radiation units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -154,7 +154,7 @@ standard_name = aerosol_optical_depth_for_longwave_bands_01_16 long_name = aerosol optical depth for longwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = in @@ -163,7 +163,7 @@ standard_name = aerosol_single_scattering_albedo_for_longwave_bands_01_16 long_name = aerosol single scattering albedo for longwave bands 01-16 units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_longwave_radiation) type = real kind = kind_phys intent = in @@ -172,7 +172,7 @@ standard_name = surface_longwave_emissivity long_name = surface emissivity units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -181,7 +181,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -190,7 +190,7 @@ standard_name = layer_thickness_for_radiation long_name = layer thickness units = km - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -199,7 +199,7 @@ standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -208,7 +208,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -249,7 +249,7 @@ standard_name = total_cloud_fraction long_name = total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -266,7 +266,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels long_name = longwave total sky heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -275,7 +275,7 @@ standard_name = lw_fluxes_top_atmosphere long_name = longwave total sky fluxes at the top of the atm units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = topflw_type intent = inout optional = F @@ -283,7 +283,7 @@ standard_name = lw_fluxes_sfc long_name = longwave total sky fluxes at the Earth surface units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcflw_type intent = inout optional = F @@ -291,7 +291,7 @@ standard_name = cloud_optical_depth_layers_at_10mu_band long_name = approx 10mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -300,7 +300,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = longwave clear sky heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -309,7 +309,7 @@ standard_name = cloud_liquid_water_path long_name = cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -318,7 +318,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -327,7 +327,7 @@ standard_name = cloud_ice_water_path long_name = cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -336,7 +336,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -345,7 +345,7 @@ standard_name = cloud_rain_water_path long_name = cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -354,7 +354,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -363,7 +363,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -372,7 +372,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index 30e1d850c..b379b36f4 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -11,7 +11,7 @@ standard_name = air_pressure_at_layer_for_radiation_in_hPa long_name = air pressure layer units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -20,7 +20,7 @@ standard_name = air_pressure_at_interface_for_radiation_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -29,7 +29,7 @@ standard_name = air_temperature_at_layer_for_radiation long_name = air temperature layer units = K - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -38,7 +38,7 @@ standard_name = air_temperature_at_interface_for_radiation long_name = air temperature level units = K - dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -47,7 +47,7 @@ standard_name = water_vapor_specific_humidity_at_layer_for_radiation long_name = specific humidity layer units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -56,7 +56,7 @@ standard_name = ozone_concentration_at_layer_for_radiation long_name = ozone concentration layer units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -65,7 +65,7 @@ standard_name = volume_mixing_ratio_co2 long_name = volume mixing ratio co2 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -74,7 +74,7 @@ standard_name = volume_mixing_ratio_n2o long_name = volume mixing ratio no2 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -83,7 +83,7 @@ standard_name = volume_mixing_ratio_ch4 long_name = volume mixing ratio ch4 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -92,7 +92,7 @@ standard_name = volume_mixing_ratio_o2 long_name = volume mixing ratio o2 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -101,7 +101,7 @@ standard_name = volume_mixing_ratio_co long_name = volume mixing ratio co units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -110,7 +110,7 @@ standard_name = volume_mixing_ratio_cfc11 long_name = volume mixing ratio cfc11 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -119,7 +119,7 @@ standard_name = volume_mixing_ratio_cfc12 long_name = volume mixing ratio cfc12 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -128,7 +128,7 @@ standard_name = volume_mixing_ratio_cfc22 long_name = volume mixing ratio cfc22 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = volume_mixing_ratio_ccl4 long_name = volume mixing ratio ccl4 units = kg kg-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -146,7 +146,7 @@ standard_name = seed_random_numbers_sw long_name = seed for random number generation for shortwave radiation units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -154,7 +154,7 @@ standard_name = aerosol_optical_depth_for_shortwave_bands_01_16 long_name = aerosol optical depth for shortwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = in @@ -163,7 +163,7 @@ standard_name = aerosol_single_scattering_albedo_for_shortwave_bands_01_16 long_name = aerosol single scattering albedo for shortwave bands 01-16 units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = in @@ -172,7 +172,7 @@ standard_name = aerosol_asymmetry_parameter_for_shortwave_bands_01_16 long_name = aerosol asymmetry paramter for shortwave bands 01-16 units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation,number_of_aerosol_bands_for_shortwave_radiation) type = real kind = kind_phys intent = in @@ -181,7 +181,7 @@ standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -190,7 +190,7 @@ standard_name = surface_albedo_due_to_near_IR_diffused long_name = surface albedo due to near IR diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -199,7 +199,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_direct long_name = surface albedo due to UV+VIS direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -208,7 +208,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_diffused long_name = surface albedo due to UV+VIS diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -217,7 +217,7 @@ standard_name = layer_thickness_for_radiation long_name = layer thickness units = km - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -226,7 +226,7 @@ standard_name = layer_pressure_thickness_for_radiation long_name = layer pressure thickness units = hPa - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -235,7 +235,7 @@ standard_name = cloud_decorrelation_length long_name = cloud decorrelation length units = km - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -244,7 +244,7 @@ standard_name = cosine_of_zenith_angle long_name = cosine of the solar zenit angle units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -270,7 +270,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -310,7 +310,7 @@ standard_name = total_cloud_fraction long_name = total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -327,7 +327,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels long_name = shortwave total sky heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -336,7 +336,7 @@ standard_name = sw_fluxes_top_atmosphere long_name = shortwave total sky fluxes at the top of the atm units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = topfsw_type intent = inout optional = F @@ -344,7 +344,7 @@ standard_name = sw_fluxes_sfc long_name = shortwave total sky fluxes at the Earth surface units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = sfcfsw_type intent = inout optional = F @@ -352,7 +352,7 @@ standard_name = cloud_optical_depth_layers_at_0p55mu_band long_name = approx .55mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -361,7 +361,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = shortwave clear sky heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -370,7 +370,7 @@ standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = inout optional = T @@ -378,7 +378,7 @@ standard_name = cloud_liquid_water_path long_name = cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -387,7 +387,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -396,7 +396,7 @@ standard_name = cloud_ice_water_path long_name = cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -405,7 +405,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -414,7 +414,7 @@ standard_name = cloud_rain_water_path long_name = cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -423,7 +423,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -432,7 +432,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -441,7 +441,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/rascnv.meta b/physics/rascnv.meta index 8a8cc0153..f0ab36f19 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -249,7 +249,7 @@ standard_name = cell_area long_name = area of the grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -328,7 +328,7 @@ standard_name = random_number_array long_name = random number array (0-1) units = none - dimensions = (horizontal_dimension,array_dimension_of_random_number) + dimensions = (horizontal_loop_extent,array_dimension_of_random_number) type = real kind = kind_phys intent = in @@ -377,7 +377,7 @@ standard_name = critical_relative_humidity long_name = critical relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -386,7 +386,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -395,7 +395,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = updated vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -404,7 +404,7 @@ standard_name = x_wind_updated_by_physics long_name = updated x-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -413,7 +413,7 @@ standard_name = y_wind_updated_by_physics long_name = updated y-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -422,7 +422,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,tracer_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,tracer_dimension) type = real kind = kind_phys intent = inout @@ -440,7 +440,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -449,7 +449,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -458,7 +458,7 @@ standard_name = dimensionless_exner_function_at_model_interfaces long_name = dimensionless Exner function at model layer interfaces units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -467,7 +467,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -476,7 +476,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -485,7 +485,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -494,7 +494,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -502,7 +502,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air long_name = surface exchange coeff for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -511,7 +511,7 @@ standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -520,7 +520,7 @@ standard_name = vertical_index_at_cloud_base long_name = index for cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -528,7 +528,7 @@ standard_name = vertical_index_at_cloud_top long_name = index for cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -536,7 +536,7 @@ standard_name = flag_deep_convection long_name = deep convection: 0=no, 1=yes units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -544,7 +544,7 @@ standard_name = surface_wind_enhancement_due_to_convection long_name = surface wind enhancement due to convection units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -553,7 +553,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * dt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -562,7 +562,7 @@ standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * dt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -571,7 +571,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * dt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -580,7 +580,7 @@ standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -589,7 +589,7 @@ standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -598,7 +598,7 @@ standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -607,7 +607,7 @@ standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -616,7 +616,7 @@ standard_name = detrained_mass_flux long_name = detrained mass flux units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -625,7 +625,7 @@ standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -634,7 +634,7 @@ standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -643,7 +643,7 @@ standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -652,7 +652,7 @@ standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -661,7 +661,7 @@ standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/rayleigh_damp.meta b/physics/rayleigh_damp.meta index 9a40ceff1..e53cfa75d 100644 --- a/physics/rayleigh_damp.meta +++ b/physics/rayleigh_damp.meta @@ -35,7 +35,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -44,7 +44,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -53,7 +53,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -62,7 +62,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -71,7 +71,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -106,7 +106,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -115,7 +115,7 @@ standard_name = air_pressure long_name = mid-layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -150,7 +150,7 @@ standard_name = cumulative_change_in_x_wind_due_to_rayleigh_damping long_name = cumulative change in zonal wind due to Rayleigh damping units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -159,7 +159,7 @@ standard_name = cumulative_change_in_y_wind_due_to_rayleigh_damping long_name = cumulative change in meridional wind due to Rayleigh damping units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -168,7 +168,7 @@ standard_name = cumulative_change_in_temperature_due_to_rayleigh_damping long_name = cumulative change in temperature due to Rayleigh damping units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 4886e600c..6225d9ea0 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -75,7 +75,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -84,7 +84,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels long_name = total sky heating rate due to longwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -93,7 +93,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = clear sky heating rate due to longwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index fb7b9d3b0..ba7dcf99e 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -51,7 +51,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -60,7 +60,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index da2272a54..82c737e32 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -91,7 +91,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels long_name = total sky heating rate due to shortwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -100,7 +100,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = clear sky heating rates due to shortwave radiation units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in @@ -109,7 +109,7 @@ standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -118,7 +118,7 @@ standard_name = surface_albedo_due_to_near_IR_diffused long_name = surface albedo due to near IR diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_direct long_name = surface albedo due to UV+VIS direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -136,7 +136,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_diffused long_name = surface albedo due to UV+VIS diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -145,7 +145,7 @@ standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = inout optional = F diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 9088284bb..cf1dae24e 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -59,7 +59,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -67,7 +67,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -76,7 +76,7 @@ standard_name = surface_air_temperature_for_radiation long_name = lowest model layer air temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -85,7 +85,7 @@ standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -94,7 +94,7 @@ standard_name = surface_albedo_due_to_near_IR_diffused long_name = surface albedo due to near IR diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -103,7 +103,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_direct long_name = surface albedo due to UV+VIS direct beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -112,7 +112,7 @@ standard_name = surface_albedo_due_to_UV_and_VIS_diffused long_name = surface albedo due to UV+VIS diffused beam units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -121,7 +121,7 @@ standard_name = surface_albedo_perturbation long_name = surface albedo perturbation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index 8df363cb6..26d548144 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -51,7 +51,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -60,7 +60,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -69,7 +69,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -78,7 +78,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -87,7 +87,7 @@ standard_name = relative_humidity long_name = layer relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -96,7 +96,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -105,7 +105,7 @@ standard_name = chemical_tracers long_name = chemical tracers units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -114,7 +114,7 @@ standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys intent = in @@ -123,7 +123,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -132,7 +132,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -157,7 +157,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = inout diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 34ce77ad3..ca0054be7 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -171,7 +171,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -179,7 +179,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -187,7 +187,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -195,7 +195,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -203,7 +203,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -211,7 +211,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -219,7 +219,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -227,7 +227,7 @@ standard_name = cloud_rain_water_path long_name = cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -235,7 +235,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real intent = in kind = kind_phys @@ -243,7 +243,7 @@ standard_name = precipitation_fraction_by_layer long_name = precipitation fraction in each layer units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -277,7 +277,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -286,7 +286,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -295,7 +295,7 @@ standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band long_name = approx 10mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index ff161d902..35699efb6 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -81,7 +81,7 @@ standard_name = seed_random_numbers_lw long_name = seed for random number generation for longwave radiation units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -89,7 +89,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -98,7 +98,7 @@ standard_name = precipitation_fraction_by_layer long_name = precipitation fraction in each layer units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -116,7 +116,7 @@ standard_name = precip_overlap_param long_name = precipitation overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 56cc7cefa..92d475d24 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -133,7 +133,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -142,7 +142,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -151,7 +151,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature layer units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -160,7 +160,7 @@ standard_name = air_temperature_at_interface_for_RRTMGP long_name = air temperature level units = K - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -169,7 +169,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 4dfc48203..8084ecf90 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -27,7 +27,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -45,7 +45,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -54,7 +54,7 @@ standard_name = surface_roughness_length long_name = surface roughness length units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -116,7 +116,7 @@ standard_name = surface_emissivity_in_each_RRTMGP_LW_band long_name = surface emissivity in each RRTMGP LW band units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_lw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index cf11fcc64..857ab834c 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -60,7 +60,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -69,7 +69,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -78,7 +78,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature layer units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -87,7 +87,7 @@ standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -96,7 +96,7 @@ standard_name = surface_emissivity_in_each_RRTMGP_LW_band long_name = surface emissivity in each RRTMGP LW band units = none - dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_lw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -145,7 +145,7 @@ standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -154,7 +154,7 @@ standard_name = RRTMGP_lw_flux_profile_downward_allsky long_name = RRTMGP downward longwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -163,7 +163,7 @@ standard_name = RRTMGP_lw_flux_profile_upward_clrsky long_name = RRTMGP upward longwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -172,7 +172,7 @@ standard_name = RRTMGP_lw_flux_profile_downward_clrsky long_name = RRTMGP downward longwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -181,7 +181,7 @@ standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward long_name = RRTMGP Jacobian upward longwave flux profile units = W m-2 K-1 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out @@ -190,7 +190,7 @@ standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward long_name = RRTMGP Jacobian downward of longwave flux profile units = W m-2 K-1 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = out diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 68979ae5b..be472fdaf 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -59,7 +59,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -67,7 +67,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -76,7 +76,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -85,7 +85,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -94,7 +94,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -103,7 +103,7 @@ standard_name = relative_humidity long_name = layer relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -112,7 +112,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -121,7 +121,7 @@ standard_name = chemical_tracers long_name = chemical tracers units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -130,7 +130,7 @@ standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration units = kg-1? - dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys intent = in @@ -139,7 +139,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -148,7 +148,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -173,7 +173,7 @@ standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species units = none - dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys intent = inout diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index 08fd7f3fd..6c8b3c20e 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -171,7 +171,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -180,7 +180,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -189,7 +189,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -198,7 +198,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -207,7 +207,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -216,7 +216,7 @@ standard_name = cloud_snow_water_path long_name = layer cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -225,7 +225,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -234,7 +234,7 @@ standard_name = cloud_rain_water_path long_name = layer cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -243,7 +243,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = precipitation_fraction_by_layer long_name = precipitation fraction in each layer units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -285,7 +285,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -309,7 +309,7 @@ standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band long_name = approx .55mu band layer cloud optical depth units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 7890d750e..082704462 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -89,7 +89,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -97,7 +97,7 @@ standard_name = seed_random_numbers_sw long_name = seed for random number generation for shortwave radiation units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -105,7 +105,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -114,7 +114,7 @@ standard_name = precipitation_fraction_by_layer long_name = precipitation fraction in each layer units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -123,7 +123,7 @@ standard_name = cloud_overlap_param long_name = cloud overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -132,7 +132,7 @@ standard_name = precip_overlap_param long_name = precipitation overlap parameter units = km - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 1d0c96547..75bcde0c8 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -133,7 +133,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -149,7 +149,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -158,7 +158,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature layer units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = air_temperature_at_interface_for_RRTMGP long_name = air temperature level units = K - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = toa_incident_sw_flux_by_spectral_point long_name = TOA shortwave incident flux at each spectral points units = W m-2 - dimensions = (horizontal_dimension,number_of_sw_spectral_points_rrtmgp) + dimensions = (horizontal_loop_extent,number_of_sw_spectral_points_rrtmgp) type = real kind = kind_phys intent = out diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 302221ce3..43febcd92 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -52,7 +52,7 @@ standard_name = daytime_points long_name = daytime points units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -60,7 +60,7 @@ standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -69,7 +69,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -78,7 +78,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -87,7 +87,7 @@ standard_name = air_temperature_at_layer_for_RRTMGP long_name = air temperature layer units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -128,7 +128,7 @@ standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = surface_albedo_nearIR_diffuse long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -146,7 +146,7 @@ standard_name = surface_albedo_uvvis_dir long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -155,7 +155,7 @@ standard_name = surface_albedo_uvvis_dif long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none - dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -164,7 +164,7 @@ standard_name = toa_incident_sw_flux_by_spectral_point long_name = TOA shortwave incident flux at each spectral points units = W m-2 - dimensions = (horizontal_dimension,number_of_sw_spectral_points_rrtmgp) + dimensions = (horizontal_loop_extent,number_of_sw_spectral_points_rrtmgp) type = real kind = kind_phys intent = in @@ -190,7 +190,7 @@ standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = cmpfsw_type intent = inout optional = T @@ -198,7 +198,7 @@ standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = inout @@ -207,7 +207,7 @@ standard_name = RRTMGP_sw_flux_profile_downward_allsky long_name = RRTMGP downward shortwave all-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = inout @@ -216,7 +216,7 @@ standard_name = RRTMGP_sw_flux_profile_upward_clrsky long_name = RRTMGP upward shortwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = inout @@ -225,7 +225,7 @@ standard_name = RRTMGP_sw_flux_profile_downward_clrsky long_name = RRTMGP downward shortwave clr-sky flux profile units = W m-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = inout diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 7085e6577..8000fb90c 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -167,7 +167,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = geopotential long_name = layer geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout @@ -212,7 +212,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = updated vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -221,7 +221,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -230,7 +230,7 @@ standard_name = x_wind_updated_by_physics long_name = updated x-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -239,7 +239,7 @@ standard_name = y_wind_updated_by_physics long_name = updated y-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -265,7 +265,7 @@ standard_name = cloud_work_function long_name = cloud work function units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -274,7 +274,7 @@ standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -283,7 +283,7 @@ standard_name = vertical_index_at_cloud_base long_name = index for cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -291,7 +291,7 @@ standard_name = vertical_index_at_cloud_top long_name = index for cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -299,7 +299,7 @@ standard_name = flag_deep_convection long_name = deep convection: 0=no, 1=yes units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -307,7 +307,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -315,7 +315,7 @@ standard_name = cell_area long_name = grid cell area units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -324,7 +324,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -341,7 +341,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -350,7 +350,7 @@ standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -359,7 +359,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -368,7 +368,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -377,7 +377,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -386,7 +386,7 @@ standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -395,7 +395,7 @@ standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -404,7 +404,7 @@ standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -413,7 +413,7 @@ standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -422,7 +422,7 @@ standard_name = detrained_mass_flux long_name = detrained mass flux units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -431,7 +431,7 @@ standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -440,7 +440,7 @@ standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -449,7 +449,7 @@ standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -458,7 +458,7 @@ standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -467,7 +467,7 @@ standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -614,7 +614,7 @@ standard_name = fraction_of_cellular_automata_for_deep_convection long_name = fraction of cellular automata for deep convection units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -623,7 +623,7 @@ standard_name = physics_field_for_coupling long_name = physics_field_for_coupling units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 6c7eedb82..7f5421b70 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -167,7 +167,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = geopotential long_name = layer geopotential units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout @@ -212,7 +212,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = updated vapor specific humidity units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -221,7 +221,7 @@ standard_name = air_temperature_updated_by_physics long_name = updated temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -230,7 +230,7 @@ standard_name = x_wind_updated_by_physics long_name = updated x-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -239,7 +239,7 @@ standard_name = y_wind_updated_by_physics long_name = updated y-direction wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -257,7 +257,7 @@ standard_name = lwe_thickness_of_shallow_convective_precipitation_amount long_name = shallow convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -266,7 +266,7 @@ standard_name = vertical_index_at_cloud_base long_name = index at cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -274,7 +274,7 @@ standard_name = vertical_index_at_cloud_top long_name = index at cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -282,7 +282,7 @@ standard_name = flag_deep_convection long_name = deep convection: 0=no, 1=yes units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -290,7 +290,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -298,7 +298,7 @@ standard_name = cell_area long_name = grid cell area units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -307,7 +307,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -324,7 +324,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL top height units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -333,7 +333,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -342,7 +342,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -351,7 +351,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -360,7 +360,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index 3031e8fd7..d49d287e1 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -181,7 +181,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between midlayers units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -190,7 +190,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -199,7 +199,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -208,7 +208,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -217,7 +217,7 @@ standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -226,7 +226,7 @@ standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -235,7 +235,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -244,7 +244,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -253,7 +253,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -262,7 +262,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -271,7 +271,7 @@ standard_name = cloud_work_function long_name = cloud work function units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -280,7 +280,7 @@ standard_name = lwe_thickness_of_deep_convective_precipitation_amount long_name = deep convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -289,7 +289,7 @@ standard_name = vertical_index_at_cloud_base long_name = index for cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -297,7 +297,7 @@ standard_name = vertical_index_at_cloud_top long_name = index for cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -305,7 +305,7 @@ standard_name = flag_deep_convection long_name = deep convection: 0=no, 1=yes units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -313,7 +313,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -321,7 +321,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -338,7 +338,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -347,7 +347,7 @@ standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux long_name = (downdraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -356,7 +356,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -365,7 +365,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -374,7 +374,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -383,7 +383,7 @@ standard_name = mass_fraction_of_convective_cloud_liquid_water long_name = mass fraction of convective cloud liquid water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -392,7 +392,7 @@ standard_name = mass_fraction_of_convective_cloud_ice long_name = mass fraction of convective cloud ice water units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -401,7 +401,7 @@ standard_name = vertical_velocity_for_updraft long_name = vertical velocity for updraft units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -410,7 +410,7 @@ standard_name = convective_cloud_fraction_for_microphysics long_name = convective cloud fraction for microphysics units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -419,7 +419,7 @@ standard_name = detrained_mass_flux long_name = detrained mass flux units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -428,7 +428,7 @@ standard_name = tendency_of_cloud_water_due_to_convective_microphysics long_name = tendency of cloud water due to convective microphysics units = kg m-2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -437,7 +437,7 @@ standard_name = convective_cloud_volume_fraction long_name = convective cloud volume fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -446,7 +446,7 @@ standard_name = ice_fraction_in_convective_tower long_name = ice fraction in convective tower units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -455,7 +455,7 @@ standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment long_name = droplet number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -464,7 +464,7 @@ standard_name = number_concentration_of_ice_crystals_for_detrainment long_name = crystal number concentration in convective detrainment units = m-3 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index e34d778dc..93597f0e3 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -178,7 +178,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -187,7 +187,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -196,7 +196,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -205,7 +205,7 @@ standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -214,7 +214,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -223,7 +223,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -232,7 +232,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -241,7 +241,7 @@ standard_name = vertically_diffused_tracer_concentration long_name = tracer concentration diffused by PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = in @@ -250,7 +250,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -259,7 +259,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -268,7 +268,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -277,7 +277,7 @@ standard_name = cell_area long_name = area of the grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -286,7 +286,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the surface interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -295,7 +295,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -304,7 +304,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -313,7 +313,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -322,7 +322,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -331,7 +331,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -340,7 +340,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -349,7 +349,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -358,7 +358,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -367,7 +367,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -376,7 +376,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -385,7 +385,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -394,7 +394,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -402,7 +402,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -411,7 +411,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -420,7 +420,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -429,7 +429,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -438,7 +438,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -447,7 +447,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -473,7 +473,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -482,7 +482,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -491,7 +491,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -500,7 +500,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -509,7 +509,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -518,7 +518,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -553,7 +553,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -562,7 +562,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -571,7 +571,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -580,7 +580,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -589,7 +589,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index 75c5fbd3d..210bd34bf 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -178,7 +178,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -187,7 +187,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -196,7 +196,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -205,7 +205,7 @@ standard_name = tendency_of_vertically_diffused_tracer_concentration long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = inout @@ -214,7 +214,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -223,7 +223,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -232,7 +232,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -241,7 +241,7 @@ standard_name = vertically_diffused_tracer_concentration long_name = tracer concentration diffused by PBL scheme units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) type = real kind = kind_phys intent = in @@ -250,7 +250,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -259,7 +259,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -268,7 +268,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -277,7 +277,7 @@ standard_name = cell_area long_name = area of the grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -286,7 +286,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -294,7 +294,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -303,7 +303,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the surface interface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -312,7 +312,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -321,7 +321,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -330,7 +330,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -339,7 +339,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -348,7 +348,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -357,7 +357,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -366,7 +366,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -375,7 +375,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -384,7 +384,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -393,7 +393,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -402,7 +402,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -411,7 +411,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -419,7 +419,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -428,7 +428,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = pres(k) - pres(k+1) units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -437,7 +437,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -446,7 +446,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -455,7 +455,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -464,7 +464,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -490,7 +490,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -499,7 +499,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -508,7 +508,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -517,7 +517,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -526,7 +526,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -535,7 +535,7 @@ standard_name = index_of_highest_temperature_inversion long_name = index of highest temperature inversion units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -605,7 +605,7 @@ standard_name = cumulative_change_in_x_wind_due_to_PBL long_name = cumulative change in x wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -614,7 +614,7 @@ standard_name = cumulative_change_in_y_wind_due_to_PBL long_name = cumulative change in y wind due to PBL units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -623,7 +623,7 @@ standard_name = cumulative_change_in_temperature_due_to_PBL long_name = cumulative change in temperature due to PBL units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -632,7 +632,7 @@ standard_name = cumulative_change_in_water_vapor_specific_humidity_due_to_PBL long_name = cumulative change in water vapor specific humidity due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -641,7 +641,7 @@ standard_name = cumulative_change_in_ozone_mixing_ratio_due_to_PBL long_name = cumulative change in ozone mixing ratio due to PBL units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index ffb49b530..fc0361ec1 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -63,7 +63,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = surface layer mean temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = surface layer mean specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice long_name = surface exchange coeff for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice long_name = surface exchange coeff heat & moisture over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -99,7 +99,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = surface layer mean pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -108,7 +108,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -117,7 +117,7 @@ standard_name = flag_for_cice long_name = flag for cice units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -125,7 +125,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -133,7 +133,7 @@ standard_name = surface_upward_latent_heat_flux_for_coupling long_name = sfc latent heat flux for coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -142,7 +142,7 @@ standard_name = surface_upward_sensible_heat_flux_for_coupling long_name = sfc sensible heat flux for coupling units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -151,7 +151,7 @@ standard_name = surface_x_momentum_flux_for_coupling long_name = sfc x momentum flux for coupling units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -160,7 +160,7 @@ standard_name = surface_y_momentum_flux_for_coupling long_name = sfc y momentum flux for coupling units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -169,7 +169,7 @@ standard_name = surface_snow_thickness_for_coupling long_name = sfc snow depth in meters over sea ice for coupling units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ standard_name = surface_specific_humidity_over_ice long_name = surface air saturation specific humidity over ice units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -187,7 +187,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice long_name = momentum exchange coefficient over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -196,7 +196,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice long_name = thermal exchange coefficient over ice units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -205,7 +205,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ice long_name = kinematic surface upward latent heat flux over ice units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -214,7 +214,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice long_name = kinematic surface upward sensible heat flux over ice units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -223,7 +223,7 @@ standard_name = surface_wind_stress_over_ice long_name = surface wind stress over ice units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -232,7 +232,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_ice long_name = water equiv of acc snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -241,7 +241,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -250,7 +250,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_ice long_name = surface upward potential latent heat flux over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index 6ede745b8..deebf23df 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -55,7 +55,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -64,7 +64,7 @@ standard_name = x_wind_at_lowest_model_layer_updated_by_physics long_name = x component of 1st model layer wind units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -73,7 +73,7 @@ standard_name = y_wind_at_lowest_model_layer_updated_by_physics long_name = y component of 1st model layer wind units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -82,7 +82,7 @@ standard_name = air_temperature_at_lowest_model_layer_updated_by_physics long_name = 1st model layer air temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -91,7 +91,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer_updated_by_physics long_name = 1st model layer specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -100,7 +100,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -109,7 +109,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux long_name = surface upward evaporation flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -118,7 +118,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity parameter for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity parameter for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -136,7 +136,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m long_name = Monin-Obukhov similarity parameter for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -145,7 +145,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m long_name = Monin-Obukhov similarity parameter for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -154,7 +154,7 @@ standard_name = surface_skin_temperature long_name = surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -163,7 +163,7 @@ standard_name = surface_specific_humidity long_name = surface specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -172,7 +172,7 @@ standard_name = ratio_of_wind_at_lowest_model_layer_and_wind_at_10m long_name = ratio of fm10 and fm units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -181,7 +181,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -190,7 +190,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -199,7 +199,7 @@ standard_name = temperature_at_2m long_name = temperature at 2 m units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -208,7 +208,7 @@ standard_name = specific_humidity_at_2m long_name = specific humidity at 2 m units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/sfc_diag_post.meta b/physics/sfc_diag_post.meta index 492a97a0f..1da5bb2ea 100644 --- a/physics/sfc_diag_post.meta +++ b/physics/sfc_diag_post.meta @@ -35,7 +35,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -78,7 +78,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -87,7 +87,7 @@ standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -96,7 +96,7 @@ standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -105,7 +105,7 @@ standard_name = temperature_at_2m long_name = 2 meter temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -114,7 +114,7 @@ standard_name = specific_humidity_at_2m long_name = 2 meter specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -123,7 +123,7 @@ standard_name = x_wind_at_10m long_name = 10 meter u wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -132,7 +132,7 @@ standard_name = y_wind_at_10m long_name = 10 meter v wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -141,7 +141,7 @@ standard_name = minimum_temperature_at_2m long_name = min temperature at 2m height units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -150,7 +150,7 @@ standard_name = maximum_temperature_at_2m long_name = max temperature at 2m height units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -159,7 +159,7 @@ standard_name = minimum_specific_humidity_at_2m long_name = minimum specific humidity at 2m height units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -168,7 +168,7 @@ standard_name = maximum_specific_humidity_at_2m long_name = maximum specific humidity at 2m height units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -177,7 +177,7 @@ standard_name = maximum_wind_at_10m long_name = maximum wind speed at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -186,7 +186,7 @@ standard_name = maximum_x_wind_at_10m long_name = maximum x wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -195,7 +195,7 @@ standard_name = maximum_y_wind_at_10m long_name = maximum y wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -204,7 +204,7 @@ standard_name = dewpoint_temperature_at_2m long_name = 2 meter dewpoint temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 8db932a68..9f03b3bf1 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -55,7 +55,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -64,7 +64,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = 1st model layer air temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -73,7 +73,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = 1st model layer specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -82,7 +82,7 @@ standard_name = height_above_ground_at_lowest_model_layer long_name = height above ground at 1st model layer units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -91,7 +91,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -100,7 +100,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = Model layer 1 mean pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -109,7 +109,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -118,7 +118,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the ground surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_layer long_name = dimensionless Exner function at the lowest model layer units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -136,7 +136,7 @@ standard_name = bounded_vegetation_area_fraction long_name = areal fractional cover of green vegetation bounded on the bottom units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -145,7 +145,7 @@ standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -153,7 +153,7 @@ standard_name = maximum_vegetation_area_fraction long_name = max fractnl cover of green veg units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -170,7 +170,7 @@ standard_name = perturbation_of_momentum_roughness_length long_name = perturbation of momentum roughness length units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -179,7 +179,7 @@ standard_name = perturbation_of_heat_to_momentum_roughness_length_ratio long_name = perturbation of heat to momentum roughness length ratio units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -188,7 +188,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -204,7 +204,7 @@ standard_name = x_wind_at_10m long_name = 10 meter u wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -213,7 +213,7 @@ standard_name = y_wind_at_10m long_name = 10 meter v wind speed units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -230,7 +230,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -238,7 +238,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -246,7 +246,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -254,7 +254,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -263,7 +263,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -272,7 +272,7 @@ standard_name = surface_skin_temperature_over_ice_interstitial long_name = surface skin temperature over ice (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -281,7 +281,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -290,7 +290,7 @@ standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -299,7 +299,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ice long_name = surface skin temperature after iteration over ice units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -308,7 +308,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ocean long_name = water equivalent snow depth over ocean units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -317,7 +317,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -326,7 +326,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -335,7 +335,7 @@ standard_name = surface_roughness_length_over_ocean_interstitial long_name = surface roughness length over ocean (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -344,7 +344,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -353,7 +353,7 @@ standard_name = surface_roughness_length_over_ice_interstitial long_name = surface roughness length over ice (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -362,7 +362,7 @@ standard_name = surface_roughness_length_from_wave_model long_name = surface roughness length from wave model units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -371,7 +371,7 @@ standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -380,7 +380,7 @@ standard_name = surface_friction_velocity_over_land long_name = surface friction velocity over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -389,7 +389,7 @@ standard_name = surface_friction_velocity_over_ice long_name = surface friction velocity over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -398,7 +398,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -407,7 +407,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -416,7 +416,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice long_name = surface exchange coeff for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -425,7 +425,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -434,7 +434,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -443,7 +443,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice long_name = surface exchange coeff heat & moisture over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -452,7 +452,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ocean long_name = bulk Richardson number at the surface over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -461,7 +461,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_land long_name = bulk Richardson number at the surface over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -470,7 +470,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level_over_ice long_name = bulk Richardson number at the surface over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -479,7 +479,7 @@ standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -488,7 +488,7 @@ standard_name = surface_wind_stress_over_land long_name = surface wind stress over land units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -497,7 +497,7 @@ standard_name = surface_wind_stress_over_ice long_name = surface wind stress over ice units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -506,7 +506,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ocean long_name = Monin-Obukhov similarity function for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -515,7 +515,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_land long_name = Monin-Obukhov similarity function for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -524,7 +524,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_over_ice long_name = Monin-Obukhov similarity function for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -533,7 +533,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ocean long_name = Monin-Obukhov similarity function for heat over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -542,7 +542,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_land long_name = Monin-Obukhov similarity function for heat over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -551,7 +551,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_over_ice long_name = Monin-Obukhov similarity function for heat over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -560,7 +560,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ocean long_name = Monin-Obukhov similarity parameter for momentum at 10m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -569,7 +569,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_land long_name = Monin-Obukhov similarity parameter for momentum at 10m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -578,7 +578,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum_at_10m_over_ice long_name = Monin-Obukhov similarity parameter for momentum at 10m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -587,7 +587,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ocean long_name = Monin-Obukhov similarity parameter for heat at 2m over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -596,7 +596,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_land long_name = Monin-Obukhov similarity parameter for heat at 2m over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -605,7 +605,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat_at_2m_over_ice long_name = Monin-Obukhov similarity parameter for heat at 2m over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index b397e0f4c..eb3f77a98 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -166,7 +166,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -175,7 +175,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = 1st model layer air temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -184,7 +184,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = 1st model layer specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -193,7 +193,7 @@ standard_name = soil_type_classification long_name = soil type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -201,7 +201,7 @@ standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -209,7 +209,7 @@ standard_name = bounded_vegetation_area_fraction long_name = areal fractional cover of green vegetation bounded on the bottom units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -218,7 +218,7 @@ standard_name = surface_longwave_emissivity_over_land_interstitial long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -227,7 +227,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land long_name = total sky surface downward longwave flux absorbed by the ground over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -236,7 +236,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = total sky surface downward shortwave flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -245,7 +245,7 @@ standard_name = surface_net_downwelling_shortwave_flux long_name = total sky surface net shortwave flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -263,7 +263,7 @@ standard_name = deep_soil_temperature long_name = bottom soil temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -272,7 +272,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -281,7 +281,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -290,7 +290,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = Model layer 1 mean pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -299,7 +299,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -308,7 +308,7 @@ standard_name = height_above_ground_at_lowest_model_layer long_name = height above ground at 1st model layer units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -317,7 +317,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -325,7 +325,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -334,7 +334,7 @@ standard_name = surface_slope_classification long_name = surface slope type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -342,7 +342,7 @@ standard_name = minimum_vegetation_area_fraction long_name = min fractional coverage of green veg units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -351,7 +351,7 @@ standard_name = maximum_vegetation_area_fraction long_name = max fractnl cover of green veg (not used) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -360,7 +360,7 @@ standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = upper bound on max albedo over deep snow units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -369,7 +369,7 @@ standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused shortwave albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -378,7 +378,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -386,7 +386,7 @@ standard_name = flag_for_guess_run long_name = flag for guess run units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -418,7 +418,7 @@ standard_name = perturbation_of_soil_type_b_parameter long_name = perturbation of soil type "b" parameter units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -427,7 +427,7 @@ standard_name = perturbation_of_leaf_area_index long_name = perturbation of leaf area index units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -436,7 +436,7 @@ standard_name = perturbation_of_vegetation_fraction long_name = perturbation of vegetation fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -454,7 +454,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -463,7 +463,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -472,7 +472,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -481,7 +481,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land long_name = total precipitation amount in each time step over land units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -490,7 +490,7 @@ standard_name = flag_for_precipitation_type long_name = flag for snow or rain precipitation units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -499,7 +499,7 @@ standard_name = volume_fraction_of_soil_moisture long_name = volumetric fraction of soil moisture units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -508,7 +508,7 @@ standard_name = soil_temperature long_name = soil temperature units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -517,7 +517,7 @@ standard_name = volume_fraction_of_unfrozen_soil_moisture long_name = volume fraction of unfrozen soil moisture units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -526,7 +526,7 @@ standard_name = canopy_water_amount long_name = canopy moisture content units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -535,7 +535,7 @@ standard_name = transpiration_flux long_name = total plant transpiration rate units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -544,7 +544,7 @@ standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -553,7 +553,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -562,7 +562,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -571,7 +571,7 @@ standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -580,7 +580,7 @@ standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -589,7 +589,7 @@ standard_name = subsurface_runoff_flux long_name = subsurface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -598,7 +598,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward latent heat flux over land units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -607,7 +607,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -616,7 +616,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_land long_name = surface upward potential latent heat flux over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -625,7 +625,7 @@ standard_name = surface_runoff_flux long_name = surface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -634,7 +634,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land long_name = momentum exchange coefficient over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -643,7 +643,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land long_name = thermal exchange coefficient over land units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -652,7 +652,7 @@ standard_name = soil_upward_latent_heat_flux long_name = soil upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -661,7 +661,7 @@ standard_name = canopy_upward_latent_heat_flux long_name = canopy upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -670,7 +670,7 @@ standard_name = snow_deposition_sublimation_upward_latent_heat_flux long_name = latent heat flux from snow depo/subl units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -679,7 +679,7 @@ standard_name = surface_snow_area_fraction long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -688,7 +688,7 @@ standard_name = soil_moisture_content long_name = soil moisture content units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -697,7 +697,7 @@ standard_name = snow_freezing_rain_upward_latent_heat_flux long_name = latent heat flux due to snow and frz rain units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -706,7 +706,7 @@ standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point long_name = soil water fraction at wilting point units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -715,7 +715,7 @@ standard_name = threshold_volume_fraction_of_condensed_water_in_soil long_name = soil moisture threshold units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -724,7 +724,7 @@ standard_name = normalized_soil_wetness long_name = normalized soil wetness units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 2c91a3d59..a8c39defe 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -160,7 +160,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = mean temperature at lowest model layer units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -169,7 +169,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -178,7 +178,7 @@ standard_name = cloud_condensed_water_mixing_ratio_at_lowest_model_layer long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water at lowest model layer units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -187,7 +187,7 @@ standard_name = soil_type_classification long_name = soil type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -195,7 +195,7 @@ standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -203,7 +203,7 @@ standard_name = vegetation_area_fraction long_name = areal fractional cover of green vegetation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -212,7 +212,7 @@ standard_name = leaf_area_index long_name = leaf area index units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -221,7 +221,7 @@ standard_name = surface_longwave_emissivity_over_land_interstitial long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -230,7 +230,7 @@ standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -239,7 +239,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -248,7 +248,7 @@ standard_name = surface_net_downwelling_shortwave_flux long_name = surface net downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -266,7 +266,7 @@ standard_name = deep_soil_temperature long_name = deep soil temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -275,7 +275,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -284,7 +284,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -293,7 +293,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = mean pressure at lowest model layer units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -302,7 +302,7 @@ standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -311,7 +311,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -320,7 +320,7 @@ standard_name = minimum_vegetation_area_fraction long_name = min fractional coverage of green vegetation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -329,7 +329,7 @@ standard_name = maximum_vegetation_area_fraction long_name = max fractional coverage of green vegetation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -338,7 +338,7 @@ standard_name = mean_vis_albedo_with_weak_cosz_dependency long_name = mean vis albedo with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -347,7 +347,7 @@ standard_name = mean_nir_albedo_with_weak_cosz_dependency long_name = mean nir albedo with weak cosz dependency units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -356,7 +356,7 @@ standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -365,7 +365,7 @@ standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused sw albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -374,7 +374,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -382,7 +382,7 @@ standard_name = flag_for_guess_run long_name = flag for guess run units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -406,7 +406,7 @@ standard_name = sea_ice_concentration long_name = ice fraction over open water units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -415,7 +415,7 @@ standard_name = volume_fraction_of_soil_moisture long_name = total soil moisture units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -424,7 +424,7 @@ standard_name = soil_temperature long_name = soil temperature units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -433,7 +433,7 @@ standard_name = volume_fraction_of_unfrozen_soil_moisture long_name = liquid soil moisture units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -458,7 +458,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -466,7 +466,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -506,7 +506,7 @@ standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point long_name = soil water fraction at wilting point units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -515,7 +515,7 @@ standard_name = threshold_volume_fraction_of_condensed_water_in_soil long_name = soil moisture threshold units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -595,7 +595,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -604,7 +604,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -613,7 +613,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land use as interstitial units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -622,7 +622,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -631,7 +631,7 @@ standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep long_name = explicit rainfall from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -640,7 +640,7 @@ standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep long_name = convective_precipitation_amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -649,7 +649,7 @@ standard_name = lwe_thickness_of_ice_amount_from_previous_timestep long_name = ice amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -658,7 +658,7 @@ standard_name = lwe_thickness_of_snow_amount_from_previous_timestep long_name = snow amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -667,7 +667,7 @@ standard_name = lwe_thickness_of_graupel_amount_from_previous_timestep long_name = graupel amount from previous timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -676,7 +676,7 @@ standard_name = flag_for_precipitation_type long_name = snow/rain flag for precipitation units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -685,7 +685,7 @@ standard_name = volume_fraction_of_soil_moisture_for_land_surface_model long_name = volumetric fraction of soil moisture for lsm units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -694,7 +694,7 @@ standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model units = K - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -703,7 +703,7 @@ standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model long_name = volume fraction of unfrozen soil moisture for lsm units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -712,7 +712,7 @@ standard_name = flag_for_frozen_soil_physics long_name = flag for frozen soil physics (RUC) units = flag - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -721,7 +721,7 @@ standard_name = volume_fraction_of_frozen_soil_moisture_for_land_surface_model long_name = volume fraction of frozen soil moisture for lsm units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -730,7 +730,7 @@ standard_name = canopy_water_amount long_name = canopy water amount units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -739,7 +739,7 @@ standard_name = transpiration_flux long_name = total plant transpiration rate units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -748,7 +748,7 @@ standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -757,7 +757,7 @@ standard_name = snow_temperature_bottom_first_layer long_name = snow temperature at the bottom of first snow layer units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -766,7 +766,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -775,7 +775,7 @@ standard_name = cloud_condensed_water_mixing_ratio_at_surface long_name = moist cloud water mixing ratio at surface units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -784,7 +784,7 @@ standard_name = surface_condensation_mass long_name = surface condensation mass units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -793,7 +793,7 @@ standard_name = sea_ice_temperature_interstitial long_name = sea ice surface skin temperature use as interstitial units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -802,7 +802,7 @@ standard_name = water_vapor_mixing_ratio_at_surface long_name = water vapor mixing ratio at surface units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -811,7 +811,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -820,7 +820,7 @@ standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -829,7 +829,7 @@ standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -838,7 +838,7 @@ standard_name = subsurface_runoff_flux long_name = subsurface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -847,7 +847,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward evaporation flux over land units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -856,7 +856,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -865,7 +865,7 @@ standard_name = density_of_frozen_precipitation long_name = density of frozen precipitation units = kg m-3 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -874,7 +874,7 @@ standard_name = surface_runoff_flux long_name = surface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -883,7 +883,7 @@ standard_name = total_runoff long_name = total water runoff units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -892,7 +892,7 @@ standard_name = surface_runoff long_name = surface water runoff (from lsm) units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -901,7 +901,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land long_name = thermal exchange coefficient over land units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -910,7 +910,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land long_name = momentum exchange coefficient over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -919,7 +919,7 @@ standard_name = soil_upward_latent_heat_flux long_name = soil upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -928,7 +928,7 @@ standard_name = canopy_upward_latent_heat_flux long_name = canopy upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -937,7 +937,7 @@ standard_name = snow_deposition_sublimation_upward_latent_heat_flux long_name = latent heat flux from snow depo/subl units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -946,7 +946,7 @@ standard_name = soil_moisture_content long_name = soil moisture content units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -955,7 +955,7 @@ standard_name = normalized_soil_wetness_for_land_surface_model long_name = normalized soil wetness units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -964,7 +964,7 @@ standard_name = accumulated_water_equivalent_of_frozen_precip long_name = snow water equivalent of run-total frozen precip units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -973,7 +973,7 @@ standard_name = total_accumulated_snowfall long_name = run-total snow accumulation on the ground units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 73382d008..ecfd3e09f 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -62,7 +62,7 @@ name = noahmpdrv_run type = scheme [im] - standard_name = horizontal_dimension + standard_name = horizontal_loop_extent long_name = horizontal dimension units = count dimensions = () @@ -89,7 +89,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -98,7 +98,7 @@ standard_name = x_wind_at_lowest_model_layer long_name = zonal wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -107,7 +107,7 @@ standard_name = y_wind_at_lowest_model_layer long_name = meridional wind at lowest model layer units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent= in @@ -116,7 +116,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = mean temperature at lowest model layer units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent= in @@ -125,7 +125,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = water vapor specific humidity at lowest model layer units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent= in @@ -134,7 +134,7 @@ standard_name = soil_type_classification long_name = soil type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent= in optional = F @@ -142,7 +142,7 @@ standard_name = vegetation_type_classification long_name = vegetation type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent= in optional = F @@ -150,7 +150,7 @@ standard_name = bounded_vegetation_area_fraction long_name = areal fractional cover of green vegetation bounded on the bottom units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent= in @@ -159,7 +159,7 @@ standard_name = surface_longwave_emissivity_over_land_interstitial long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -168,7 +168,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land long_name = total sky surface downward longwave flux absorbed by the ground over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -177,7 +177,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = surface downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent= in @@ -186,7 +186,7 @@ standard_name = surface_net_downwelling_shortwave_flux long_name = surface net downwelling shortwave flux at current time units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -204,7 +204,7 @@ standard_name = deep_soil_temperature long_name = deep soil temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -213,7 +213,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -222,7 +222,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land long_name = surface exchange coeff heat & moisture over land units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -231,7 +231,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = mean pressure at lowest model layer units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -240,7 +240,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -249,7 +249,7 @@ standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -258,7 +258,7 @@ standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -266,7 +266,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -275,7 +275,7 @@ standard_name = surface_slope_classification long_name = surface slope type at each grid cell units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -283,7 +283,7 @@ standard_name = minimum_vegetation_area_fraction long_name = min fractional coverage of green vegetation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -292,7 +292,7 @@ standard_name = maximum_vegetation_area_fraction long_name = max fractional coverage of green vegetation units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -301,7 +301,7 @@ standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -310,7 +310,7 @@ standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused sw albedo units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -319,7 +319,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -327,7 +327,7 @@ standard_name = flag_for_guess_run long_name = flag for guess run units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -431,7 +431,7 @@ standard_name = latitude long_name = latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -440,7 +440,7 @@ standard_name = instantaneous_cosine_of_zenith_angle long_name = cosine of zenith angle at current time units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -466,7 +466,7 @@ standard_name = explicit_rainfall_rate_from_previous_timestep long_name = explicit rainfall rate previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -475,7 +475,7 @@ standard_name = convective_precipitation_rate_from_previous_timestep long_name = convective precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -484,7 +484,7 @@ standard_name = snow_precipitation_rate_from_previous_timestep long_name = snow precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -493,7 +493,7 @@ standard_name = graupel_precipitation_rate_from_previous_timestep long_name = graupel precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -502,7 +502,7 @@ standard_name = ice_precipitation_rate_from_previous_timestep long_name = ice precipitation rate from previous timestep units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -592,7 +592,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -601,7 +601,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -610,7 +610,7 @@ standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -619,7 +619,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_land long_name = total precipitation amount in each time step over land units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -628,7 +628,7 @@ standard_name = flag_for_precipitation_type long_name = snow/rain flag for precipitation units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -637,7 +637,7 @@ standard_name = volume_fraction_of_soil_moisture long_name = total soil moisture units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -646,7 +646,7 @@ standard_name = soil_temperature long_name = soil temperature units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -655,7 +655,7 @@ standard_name = volume_fraction_of_unfrozen_soil_moisture long_name = liquid soil moisture units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) + dimensions = (horizontal_loop_extent,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -664,7 +664,7 @@ standard_name = canopy_water_amount long_name = canopy water amount units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -673,7 +673,7 @@ standard_name = transpiration_flux long_name = total plant transpiration rate units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -682,7 +682,7 @@ standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -691,7 +691,7 @@ standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -700,7 +700,7 @@ standard_name = number_of_snow_layers long_name = number of snow layers units = count - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -709,7 +709,7 @@ standard_name = vegetation_temperature long_name = vegetation temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -718,7 +718,7 @@ standard_name = ground_temperature_for_noahmp long_name = ground temperature for noahmp units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -727,7 +727,7 @@ standard_name = canopy_intercepted_ice_mass long_name = canopy intercepted ice mass units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -736,7 +736,7 @@ standard_name = canopy_intercepted_liquid_water long_name = canopy intercepted liquid water units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -745,7 +745,7 @@ standard_name = canopy_air_vapor_pressure long_name = canopy air vapor pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -754,7 +754,7 @@ standard_name = canopy_air_temperature long_name = canopy air temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -763,7 +763,7 @@ standard_name = surface_drag_coefficient_for_momentum_for_noahmp long_name = surface drag coefficient for momentum for noahmp units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -772,7 +772,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp long_name = surface exchange coeff heat & moisture for noahmp units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -781,7 +781,7 @@ standard_name = area_fraction_of_wet_canopy long_name = area fraction of canopy that is wetted/snowed units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -790,7 +790,7 @@ standard_name = snow_mass_at_previous_time_step long_name = snow mass at previous time step units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -799,7 +799,7 @@ standard_name = snow_albedo_at_previous_time_step long_name = snow albedo at previous time step units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -808,7 +808,7 @@ standard_name = snow_precipitation_rate_at_surface long_name = snow precipitation rate at surface units = mm s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -817,7 +817,7 @@ standard_name = lake_water_storage long_name = lake water storage units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -826,7 +826,7 @@ standard_name = water_table_depth long_name = water table depth units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -835,7 +835,7 @@ standard_name = water_storage_in_aquifer long_name = water storage in aquifer units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -844,7 +844,7 @@ standard_name = water_storage_in_aquifer_and_saturated_soil long_name = water storage in aquifer and saturated soil units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -853,7 +853,7 @@ standard_name = snow_temperature long_name = snow_temperature units = K - dimensions = (horizontal_dimension, -2:0) + dimensions = (horizontal_loop_extent, -2:0) type = real kind = kind_phys intent = inout @@ -862,7 +862,7 @@ standard_name = layer_bottom_depth_from_snow_surface long_name = depth from the top of the snow surface at the bottom of the layer units = m - dimensions = (horizontal_dimension, -2:4) + dimensions = (horizontal_loop_extent, -2:4) type = real kind = kind_phys intent = inout @@ -871,7 +871,7 @@ standard_name = snow_layer_ice long_name = snow_layer_ice units = mm - dimensions = (horizontal_dimension, -2:0) + dimensions = (horizontal_loop_extent, -2:0) type = real kind = kind_phys intent = inout @@ -880,7 +880,7 @@ standard_name = snow_layer_liquid_water long_name = snow layer liquid water units = mm - dimensions = (horizontal_dimension, -2:0) + dimensions = (horizontal_loop_extent, -2:0) type = real kind = kind_phys intent = inout @@ -889,7 +889,7 @@ standard_name = leaf_mass long_name = leaf mass units = g m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -898,7 +898,7 @@ standard_name = fine_root_mass long_name = fine root mass units = g m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -907,7 +907,7 @@ standard_name = stem_mass long_name = stem mass units = g m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -916,7 +916,7 @@ standard_name = wood_mass long_name = wood mass including woody roots units = g m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -925,7 +925,7 @@ standard_name = slow_soil_pool_mass_content_of_carbon long_name = stable carbon in deep soil units = g m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -934,7 +934,7 @@ standard_name = fast_soil_pool_mass_content_of_carbon long_name = short-lived carbon in shallow soil units = g m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -943,7 +943,7 @@ standard_name = leaf_area_index long_name = leaf area index units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -952,7 +952,7 @@ standard_name = stem_area_index long_name = stem area index units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -961,7 +961,7 @@ standard_name = nondimensional_snow_age long_name = non-dimensional snow age units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -970,7 +970,7 @@ standard_name = equilibrium_soil_water_content long_name = equilibrium soil water content units = m3 m-3 - dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -979,7 +979,7 @@ standard_name = soil_water_content_between_soil_bottom_and_water_table long_name = soil water content between the bottom of the soil and the water table units = m3 m-3 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -988,7 +988,7 @@ standard_name = water_table_recharge_when_deep long_name = recharge to or from the water table when deep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -997,7 +997,7 @@ standard_name = water_table_recharge_when_shallow long_name = recharge to or from the water table when shallow units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -1006,7 +1006,7 @@ standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1015,7 +1015,7 @@ standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1024,7 +1024,7 @@ standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1033,7 +1033,7 @@ standard_name = subsurface_runoff_flux long_name = subsurface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1042,7 +1042,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward latent heat flux over land units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1051,7 +1051,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1060,7 +1060,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_land long_name = surface upward potential latent heat flux over land units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1069,7 +1069,7 @@ standard_name = surface_runoff_flux long_name = surface runoff flux units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1078,7 +1078,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land long_name = momentum exchange coefficient over land units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1087,7 +1087,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land long_name = thermal exchange coefficient over land units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1096,7 +1096,7 @@ standard_name = soil_upward_latent_heat_flux long_name = soil upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1105,7 +1105,7 @@ standard_name = canopy_upward_latent_heat_flux long_name = canopy upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1114,7 +1114,7 @@ standard_name = snow_deposition_sublimation_upward_latent_heat_flux long_name = latent heat flux from snow depo/subl units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1123,7 +1123,7 @@ standard_name = surface_snow_area_fraction long_name = surface snow area fraction units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1132,7 +1132,7 @@ standard_name = soil_moisture_content long_name = soil moisture units = kg m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1141,7 +1141,7 @@ standard_name = snow_freezing_rain_upward_latent_heat_flux long_name = latent heat flux due to snow and frz rain units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1150,7 +1150,7 @@ standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point long_name = wilting point (volumetric) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1159,7 +1159,7 @@ standard_name = threshold_volume_fraction_of_condensed_water_in_soil long_name = soil moisture threshold (volumetric) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1168,7 +1168,7 @@ standard_name = normalized_soil_wetness long_name = normalized soil wetness units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1177,7 +1177,7 @@ standard_name = temperature_at_2m_from_noahmp long_name = 2 meter temperature from noahmp units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1186,7 +1186,7 @@ standard_name = specific_humidity_at_2m_from_noahmp long_name = 2 meter specific humidity from noahmp units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 44e132293..2c32ca106 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -118,7 +118,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = x_wind_at_lowest_model_layer long_name = x component of surface layer wind units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -136,7 +136,7 @@ standard_name = y_wind_at_lowest_model_layer long_name = y component of surface layer wind units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -145,7 +145,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = surface layer mean temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -154,7 +154,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = surface layer mean specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -163,7 +163,7 @@ standard_name = sea_surface_reference_temperature long_name = reference/foundation temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -172,7 +172,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -181,7 +181,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -190,7 +190,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = surface layer mean pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -199,7 +199,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -208,7 +208,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the ground surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -217,7 +217,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_layer long_name = dimensionless Exner function at the lowest model layer units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -226,7 +226,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -234,7 +234,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -243,7 +243,7 @@ standard_name = sine_of_latitude long_name = sine of latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = surface_wind_stress_over_ocean long_name = surface wind stress over ocean units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -261,7 +261,7 @@ standard_name = surface_longwave_emissivity_over_ocean_interstitial long_name = surface lw emissivity in fraction over ocean (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -270,7 +270,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ocean long_name = total sky surface downward longwave flux absorbed by the ground over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -279,7 +279,7 @@ standard_name = surface_net_downwelling_shortwave_flux long_name = total sky sfc net sw flx into ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -288,7 +288,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ocean long_name = total precipitation amount in each time step over ocean units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -323,7 +323,7 @@ standard_name = instantaneous_cosine_of_zenith_angle long_name = cosine of solar zenith angle units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -332,7 +332,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -341,7 +341,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -349,7 +349,7 @@ standard_name = flag_for_guess_run long_name = flag for guess run units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -397,7 +397,7 @@ standard_name = surface_skin_temperature_for_nsst long_name = ocean surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -406,7 +406,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -415,7 +415,7 @@ standard_name = diurnal_thermocline_layer_heat_content long_name = heat content in diurnal thermocline layer units = K m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -424,7 +424,7 @@ standard_name = sea_water_salinity long_name = salinity content in diurnal thermocline layer units = ppt m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -433,7 +433,7 @@ standard_name = diurnal_thermocline_layer_x_current long_name = u-current content in diurnal thermocline layer units = m2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -442,7 +442,7 @@ standard_name = diurnal_thermocline_layer_y_current long_name = v-current content in diurnal thermocline layer units = m2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -451,7 +451,7 @@ standard_name = diurnal_thermocline_layer_thickness long_name = diurnal thermocline layer thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -460,7 +460,7 @@ standard_name = ocean_mixed_layer_thickness long_name = mixed layer thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -469,7 +469,7 @@ standard_name = sensitivity_of_dtl_heat_content_to_surface_temperature long_name = d(xt)/d(ts) units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -478,7 +478,7 @@ standard_name = sensitivity_of_dtl_thickness_to_surface_temperature long_name = d(xz)/d(ts) units = m K-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -487,7 +487,7 @@ standard_name = sub_layer_cooling_amount long_name = sub-layer cooling amount units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -496,7 +496,7 @@ standard_name = sub_layer_cooling_thickness long_name = sub-layer cooling thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -505,7 +505,7 @@ standard_name = coefficient_c_0 long_name = coefficient1 to calculate d(tz)/d(ts) units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -514,7 +514,7 @@ standard_name = coefficient_c_d long_name = coefficient2 to calculate d(tz)/d(ts) units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -523,7 +523,7 @@ standard_name = coefficient_w_0 long_name = coefficient3 to calculate d(tz)/d(ts) units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -532,7 +532,7 @@ standard_name = coefficient_w_d long_name = coefficient4 to calculate d(tz)/d(ts) units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -541,7 +541,7 @@ standard_name = free_convection_layer_thickness long_name = thickness of free convection layer units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -550,7 +550,7 @@ standard_name = index_of_dtlm_start long_name = index to start dtlm run or not units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -559,7 +559,7 @@ standard_name = sensible_heat_flux_due_to_rainfall long_name = sensible heat flux due to rainfall units = W - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -568,7 +568,7 @@ standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -577,7 +577,7 @@ standard_name = upward_heat_flux_in_soil_over_ocean long_name = soil heat flux over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -586,7 +586,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean long_name = momentum exchange coefficient over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -595,7 +595,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean long_name = thermal exchange coefficient over ocean units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -604,7 +604,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -613,7 +613,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -622,7 +622,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_ocean long_name = surface upward potential latent heat flux over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -667,7 +667,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -675,7 +675,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -684,7 +684,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -693,7 +693,7 @@ standard_name = surface_skin_temperature_for_nsst long_name = ocean surface skin temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -702,7 +702,7 @@ standard_name = diurnal_thermocline_layer_heat_content long_name = heat content in diurnal thermocline layer units = K m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -711,7 +711,7 @@ standard_name = diurnal_thermocline_layer_thickness long_name = diurnal thermocline layer thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -720,7 +720,7 @@ standard_name = sub_layer_cooling_amount long_name = sub-layer cooling amount units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -729,7 +729,7 @@ standard_name = sub_layer_cooling_thickness long_name = sub-layer cooling thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -738,7 +738,7 @@ standard_name = sea_surface_reference_temperature long_name = reference/foundation temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -755,7 +755,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -826,7 +826,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -834,7 +834,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -842,7 +842,7 @@ standard_name = orography long_name = orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -851,7 +851,7 @@ standard_name = orography_unfiltered long_name = unfiltered orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -884,7 +884,7 @@ standard_name = diurnal_thermocline_layer_heat_content long_name = heat content in diurnal thermocline layer units = K m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -893,7 +893,7 @@ standard_name = diurnal_thermocline_layer_thickness long_name = diurnal thermocline layer thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -902,7 +902,7 @@ standard_name = sub_layer_cooling_amount long_name = sub-layer cooling amount units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -911,7 +911,7 @@ standard_name = sub_layer_cooling_thickness long_name = sub-layer cooling thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -920,7 +920,7 @@ standard_name = sea_surface_reference_temperature long_name = reference/foundation temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -929,7 +929,7 @@ standard_name = longitude long_name = longitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -938,7 +938,7 @@ standard_name = surface_skin_temperature_after_iteration_over_ocean long_name = surface skin temperature after iteration over ocean units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -947,7 +947,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -964,7 +964,7 @@ standard_name = mean_change_over_depth_in_sea_water_temperature long_name = mean of dT(z) (zsea1 to zsea2) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index 95b9aa37d..afdea6c3f 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -55,7 +55,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -64,7 +64,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = surface layer mean temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -73,7 +73,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = surface layer mean specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -82,7 +82,7 @@ standard_name = surface_skin_temperature_over_ocean_interstitial long_name = surface skin temperature over ocean (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -91,7 +91,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ocean long_name = surface exchange coeff for momentum over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -100,7 +100,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean long_name = surface exchange coeff heat & moisture over ocean units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -109,7 +109,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = surface layer mean pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -118,7 +118,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -127,7 +127,7 @@ standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -135,7 +135,7 @@ standard_name = flag_nonzero_lake_surface_fraction long_name = flag indicating presence of some lake surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -143,7 +143,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -152,7 +152,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -160,7 +160,7 @@ standard_name = surface_specific_humidity_over_ocean long_name = surface air saturation specific humidity over ocean units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -169,7 +169,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ocean long_name = momentum exchange coefficient over ocean units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -178,7 +178,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ocean long_name = thermal exchange coefficient over ocean units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -187,7 +187,7 @@ standard_name = upward_heat_flux_in_soil_over_ocean long_name = soil heat flux over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -196,7 +196,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ocean long_name = kinematic surface upward latent heat flux over ocean units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -205,7 +205,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ocean long_name = kinematic surface upward sensible heat flux over ocean units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -214,7 +214,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_ocean long_name = surface upward potential latent heat flux over ocean units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index 10fcfb6ab..4ce931bac 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -117,7 +117,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -126,7 +126,7 @@ standard_name = air_temperature_at_lowest_model_layer long_name = surface layer mean temperature units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -135,7 +135,7 @@ standard_name = water_vapor_specific_humidity_at_lowest_model_layer long_name = surface layer mean specific humidity units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -153,7 +153,7 @@ standard_name = surface_longwave_emissivity_over_ice_interstitial long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -162,7 +162,7 @@ standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_ice long_name = total sky surface downward longwave flux absorbed by the ground over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -171,7 +171,7 @@ standard_name = surface_net_downwelling_shortwave_flux long_name = total sky sfc netsw flx into ground units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -180,7 +180,7 @@ standard_name = surface_downwelling_shortwave_flux long_name = total sky sfc downward sw flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -189,7 +189,7 @@ standard_name = flag_for_precipitation_type long_name = snow/rain flag for precipitation units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -198,7 +198,7 @@ standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice long_name = surface exchange coeff for momentum over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -207,7 +207,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice long_name = surface exchange coeff heat & moisture over ice units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -216,7 +216,7 @@ standard_name = air_pressure_at_lowest_model_layer long_name = surface layer mean pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -225,7 +225,7 @@ standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer long_name = Exner function ratio bt midlayer and interface at 1st layer units = ratio - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -234,7 +234,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_interface long_name = dimensionless Exner function at the ground surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -243,7 +243,7 @@ standard_name = dimensionless_exner_function_at_lowest_model_layer long_name = dimensionless Exner function at the lowest model layer units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -252,7 +252,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -261,7 +261,7 @@ standard_name = flag_for_iteration long_name = flag for iteration units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -285,7 +285,7 @@ standard_name = sea_ice_thickness long_name = sea-ice thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -294,7 +294,7 @@ standard_name = sea_ice_concentration long_name = sea-ice concentration [0,1] units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -303,7 +303,7 @@ standard_name = sea_ice_temperature_interstitial long_name = sea-ice surface temperature use as interstitial units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -312,7 +312,7 @@ standard_name = water_equivalent_accumulated_snow_depth_over_ice long_name = water equiv of acc snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -321,7 +321,7 @@ standard_name = surface_skin_temperature_over_ice_interstitial long_name = surface skin temperature over ice (temporary use as interstitial) units = K - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -330,7 +330,7 @@ standard_name = nonnegative_lwe_thickness_of_precipitation_amount_on_dynamics_timestep_over_ice long_name = total precipitation amount in each time step over ice units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -339,7 +339,7 @@ standard_name = internal_ice_temperature long_name = sea ice internal temperature units = K - dimensions = (horizontal_dimension,ice_vertical_dimension) + dimensions = (horizontal_loop_extent,ice_vertical_dimension) type = real kind = kind_phys intent = inout @@ -348,7 +348,7 @@ standard_name = surface_upward_potential_latent_heat_flux_over_ice long_name = surface upward potential latent heat flux over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -357,7 +357,7 @@ standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice units = mm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -366,7 +366,7 @@ standard_name = surface_specific_humidity_over_ice long_name = surface air saturation specific humidity over ice units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -375,7 +375,7 @@ standard_name = surface_snow_melt long_name = snow melt during timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -384,7 +384,7 @@ standard_name = upward_heat_flux_in_soil_over_ice long_name = soil heat flux over ice units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -393,7 +393,7 @@ standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice long_name = momentum exchange coefficient over ice units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -402,7 +402,7 @@ standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice long_name = thermal exchange coefficient over ice units = kg m-2 s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -411,7 +411,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_over_ice long_name = kinematic surface upward latent heat flux over ice units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -420,7 +420,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice long_name = kinematic surface upward sensible heat flux over ice units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -437,7 +437,7 @@ standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = logical intent = in optional = F @@ -445,7 +445,7 @@ standard_name = sea_land_ice_mask_cice long_name = sea/land/ice mask cice (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -471,7 +471,7 @@ standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean units = frac - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index 3fe29f5ef..7986d28f8 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -197,7 +197,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between midlayers units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -206,7 +206,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -215,7 +215,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -224,7 +224,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -233,7 +233,7 @@ standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -242,7 +242,7 @@ standard_name = ice_water_mixing_ratio_convective_transport_tracer long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -251,7 +251,7 @@ standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -260,7 +260,7 @@ standard_name = air_temperature_updated_by_physics long_name = temperature updated by physics units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -269,7 +269,7 @@ standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -278,7 +278,7 @@ standard_name = y_wind_updated_by_physics long_name = meridional wind updated by physics units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -287,7 +287,7 @@ standard_name = lwe_thickness_of_shallow_convective_precipitation_amount long_name = shallow convective rainfall amount on physics timestep units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -296,7 +296,7 @@ standard_name = vertical_index_at_cloud_base long_name = index for cloud base units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -304,7 +304,7 @@ standard_name = vertical_index_at_cloud_top long_name = index for cloud top units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -312,7 +312,7 @@ standard_name = flag_deep_convection long_name = deep convection: 0=no, 1=yes units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = inout optional = F @@ -320,7 +320,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -328,7 +328,7 @@ standard_name = omega long_name = layer mean vertical velocity units = Pa s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -345,7 +345,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = pbl height units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -354,7 +354,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -363,7 +363,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -372,7 +372,7 @@ standard_name = instantaneous_atmosphere_updraft_convective_mass_flux long_name = (updraft mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -381,7 +381,7 @@ standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux long_name = (detrainment mass flux) * delt units = kg m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -390,7 +390,7 @@ standard_name = convective_cloud_water_mixing_ratio long_name = moist convective cloud water mixing ratio units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -399,7 +399,7 @@ standard_name = convective_cloud_cover long_name = convective cloud cover units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 4a557f253..d4b7b3c5e 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -27,7 +27,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -45,7 +45,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -54,7 +54,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -99,7 +99,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -108,7 +108,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -117,7 +117,7 @@ standard_name = tendency_of_tracers_due_to_model_physics long_name = updated tendency of the tracers due to model physics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -158,7 +158,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -167,7 +167,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -176,7 +176,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -212,7 +212,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -221,7 +221,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -230,7 +230,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -238,7 +238,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -247,7 +247,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -256,7 +256,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -265,7 +265,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -337,7 +337,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -346,7 +346,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -355,7 +355,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -364,7 +364,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -382,7 +382,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -390,7 +390,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -399,7 +399,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -408,7 +408,7 @@ standard_name = cell_size long_name = size of the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index ae228bfe8..64212b0ac 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -27,7 +27,7 @@ standard_name = x_wind long_name = x component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -36,7 +36,7 @@ standard_name = y_wind long_name = y component of layer wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -45,7 +45,7 @@ standard_name = air_temperature long_name = layer mean air temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -54,7 +54,7 @@ standard_name = tracer_concentration long_name = model layer mean tracer concentration units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -63,7 +63,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -72,7 +72,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -81,7 +81,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = Exner function at layers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -90,7 +90,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = updated tendency of the y wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -99,7 +99,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -108,7 +108,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = updated tendency of the temperature units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -117,7 +117,7 @@ standard_name = tendency_of_tracers_due_to_model_physics long_name = updated tendency of the tracers due to model physics units = kg kg-1 s-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout @@ -126,7 +126,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -135,7 +135,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -144,7 +144,7 @@ standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -185,7 +185,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -194,7 +194,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -203,7 +203,7 @@ standard_name = surface_air_pressure long_name = surface pressure units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -212,7 +212,7 @@ standard_name = surface_roughness_length long_name = surface roughness length in cm units = cm - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -221,7 +221,7 @@ standard_name = surface_wind_stress long_name = surface wind stress units = m2 s-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -230,7 +230,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -239,7 +239,7 @@ standard_name = Monin_Obukhov_similarity_function_for_momentum long_name = Monin-Obukhov similarity function for momentum units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -248,7 +248,7 @@ standard_name = Monin_Obukhov_similarity_function_for_heat long_name = Monin-Obukhov similarity function for heat units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -257,7 +257,7 @@ standard_name = sea_land_ice_mask long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -265,7 +265,7 @@ standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -274,7 +274,7 @@ standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -283,7 +283,7 @@ standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -292,7 +292,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -364,7 +364,7 @@ standard_name = instantaneous_surface_x_momentum_flux long_name = x momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -373,7 +373,7 @@ standard_name = instantaneous_surface_y_momentum_flux long_name = y momentum flux units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -382,7 +382,7 @@ standard_name = instantaneous_surface_upward_sensible_heat_flux long_name = surface upward sensible heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -391,7 +391,7 @@ standard_name = instantaneous_surface_upward_latent_heat_flux long_name = surface upward latent heat flux units = W m-2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -409,7 +409,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = PBL top model level index units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = out optional = F @@ -417,7 +417,7 @@ standard_name = x_wind_at_10m long_name = x component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -426,7 +426,7 @@ standard_name = y_wind_at_10m long_name = y component of wind at 10 m units = m s-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in From 28f96f925488d201395699b3a8b080c3a244a60c Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 10 Sep 2020 09:01:26 -0600 Subject: [PATCH 049/274] initialize correct_unit branch --- physics/GFS_DCNV_generic.meta | 6 +++--- physics/GFS_rrtmg_pre.meta | 20 ++++++++++---------- physics/GFS_rrtmg_setup.meta | 16 ++++++++-------- physics/GFS_rrtmgp_setup.meta | 16 ++++++++-------- 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 507643661..ac632b09c 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -445,7 +445,7 @@ [upd_mf] standard_name = cumulative_atmosphere_updraft_convective_mass_flux long_name = cumulative updraft mass flux - units = Pa + units = kg m-1 s-2 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -454,7 +454,7 @@ [dwn_mf] standard_name = cumulative_atmosphere_downdraft_convective_mass_flux long_name = cumulative downdraft mass flux - units = Pa + units = kg m-1 s-2 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -463,7 +463,7 @@ [det_mf] standard_name = cumulative_atmosphere_detrainment_convective_mass_flux long_name = cumulative detrainment mass flux - units = Pa + units = kg m-1 s-2 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index dd1825e08..245d97d18 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -444,7 +444,7 @@ standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -453,7 +453,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -462,7 +462,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -471,7 +471,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -480,7 +480,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = inout @@ -489,7 +489,7 @@ standard_name = cloud_rain_water_path long_name = cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -498,7 +498,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -507,7 +507,7 @@ standard_name = cloud_snow_water_path long_name = cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -516,7 +516,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake units = micron - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out @@ -534,7 +534,7 @@ standard_name = instantaneous_3d_cloud_fraction long_name = instantaneous 3D cloud fraction for all MPs units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 8377807d8..8793f7393 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -113,32 +113,32 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation - long_name = sw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation + long_name = control flag for cloud overlapping method for SW units = flag dimensions = () type = integer intent = in optional = F [iovr_lw] - standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation - long_name = lw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation + long_name = control flag for cloud overlapping method for LW units = flag dimensions = () type = integer intent = in optional = F [isubc_sw] - standard_name = flag_for_sw_clouds_without_sub_grid_approximation - long_name = flag for sw clouds without sub-grid approximation + standard_name = flag_for_subcolumn_cloud_approximation_for_shortwave_radiation + long_name = flag for subcolumn cloud approximation for shortwave radiation units = flag dimensions = () type = integer intent = in optional = F [isubc_lw] - standard_name = flag_for_lw_clouds_without_sub_grid_approximation - long_name = flag for lw clouds without sub-grid approximation + standard_name = flag_for_subcolumn_cloud_approximation_for_longwave_radiation + long_name = flag for subcolumn cloud approximation for longwave radiation units = flag dimensions = () type = integer diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 430226dbc..c0c192c62 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -161,32 +161,32 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation - long_name = sw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation + long_name = control flag for cloud overlapping method for SW units = flag dimensions = () type = integer intent = in optional = F [iovr_lw] - standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation - long_name = lw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation + long_name = control flag for cloud overlapping method for SW units = flag dimensions = () type = integer intent = in optional = F [isubc_sw] - standard_name = flag_for_sw_clouds_without_sub_grid_approximation - long_name = flag for sw clouds without sub-grid approximation + standard_name = flag_for_subcolumn_cloud_approximation_for_shortwave_radiation + long_name = flag for subcolumn cloud approximation for shortwave radiation units = flag dimensions = () type = integer intent = in optional = F [isubc_lw] - standard_name = flag_for_lw_clouds_without_sub_grid_approximation - long_name = flag for lw clouds without sub-grid approximation + standard_name = flag_for_subcolumn_cloud_approximation_for_longwave_radiation + long_name = flag for subcolumn cloud approximation for longwave radiation units = flag dimensions = () type = integer From 3204a42d25317ae84cded60d8b10f4f79ea05097 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Thu, 10 Sep 2020 21:34:37 +0000 Subject: [PATCH 050/274] Bug fix -- Sept. 10 --- physics/drag_suite.F90 | 3 ++- physics/unified_ugwp.F90 | 6 +++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 76c2a85aa..0b0ef03a0 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -199,8 +199,9 @@ subroutine drag_suite_run( & & dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & & slmsk,br1,hpbl, & & g, cp, rd, rv, fv, pi, imx, cdmbgwd, me, master, & + & lprnt, ipr, rdxzb, dx, gwd_opt, & & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & - & lprnt, ipr, rdxzb, dx, gwd_opt, errmsg, errflg ) + & errmsg, errflg ) ! ******************************************************************** ! -----> I M P L E M E N T A T I O N V E R S I O N <---------- diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index de1b147a9..cff34ab8c 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -340,9 +340,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fvirt,con_pi,lonr, & - cdmbgwd(1:2),me,master,do_gsl_drag_ls_bl, & - do_gsl_drag_ss,do_gsl_drag_tofd,lprnt,ipr,rdxzb,dx, & - gwd_opt,errmsg,errflg) + cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & + errmsg,errflg) else if ( do_ugwp_v1.or.do_ugwp_v1_orog_only ) then From 5ee932a5c672a1654bda8b654c94845b893aba24 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Sun, 13 Sep 2020 03:03:40 +0000 Subject: [PATCH 051/274] Sept. 12 bug fix --- physics/unified_ugwp.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index cff34ab8c..203bf9c48 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -106,7 +106,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & write(errmsg,'(*(a))') "Logic error: Only one large-scale& &/blocking scheme (do_ugwp_v0,do_ugwp_v0_orog_only,& - do_gsl_drag_ls_bl,do_ugwp_v1 or& + &do_gsl_drag_ls_bl,do_ugwp_v1 or & &do_ugwp_v1_orog_only) can be chosen" errflg = 1 return @@ -117,16 +117,18 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if (is_initialized) return - if ( do_ugwp_v0 .and. (do_ugwp .or. cdmbgwd(3) > 0.0) ) then - if (do_ugwp .or. cdmbgwd(3) > 0.0) then + if ( do_ugwp_v0 ) then + ! if (do_ugwp .or. cdmbgwd(3) > 0.0) then (deactivate effect of do_ugwp) + if (cdmbgwd(3) > 0.0) then call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + else + write(errmsg,'(*(a))') "Logic error: cires_ugwp_mod_init called but & + &do_ugwp_v0 is true and cdmbgwd(3) <= 0" + errflg = 1 + return end if - else - write(errmsg,'(*(a))') "Logic error: cires_ugwp_init called but do_ugwp is false and cdmbgwd(3) <= 0" - errflg = 1 - return end if From b38a49a08d332e091407bb8ca6105ab8358a5cc7 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Mon, 14 Sep 2020 09:37:19 -0600 Subject: [PATCH 052/274] unit fix --- physics/GFS_rrtmg_pre.F90 | 5 +--- physics/GFS_rrtmg_pre.meta | 44 +++------------------------- physics/GFS_rrtmgp_gfdlmp_pre.meta | 12 ++++---- physics/GFS_rrtmgp_zhaocarr_pre.meta | 12 ++++---- physics/GFS_time_vary_pre.fv3.meta | 2 +- physics/gfdl_cloud_microphys.meta | 2 +- physics/module_SGSCloud_RadPre.meta | 4 +-- physics/mp_fer_hires.F90 | 5 ++-- physics/mp_fer_hires.meta | 9 ------ physics/radlw_main.meta | 8 ++--- physics/radsw_main.meta | 8 ++--- physics/rrtmgp_lw_cloud_optics.meta | 8 ++--- physics/rrtmgp_sw_cloud_optics.meta | 8 ++--- 13 files changed, 39 insertions(+), 88 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 31099819c..bdc1e7544 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -22,7 +22,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Coupling, & Radtend, & ! input/output imfdeepcnv, imfdeepcnv_gf, & - f_ice, f_rain, f_rimef, flgmin, cwm, & ! F-A mp scheme only + flgmin, & ! F-A mp scheme only lm, im, lmk, lmp, & ! input kd, kt, kb, raddt, delp, dz, plvl, plyr, & ! output tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & @@ -95,9 +95,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input integer, intent(out) :: kd, kt, kb ! F-A mp scheme only - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(in) :: f_ice, & - f_rain, f_rimef - real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP), intent(out) :: cwm real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: flgmin real(kind=kind_phys), intent(out) :: raddt diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 245d97d18..e9b6229f6 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -71,33 +71,6 @@ type = GFS_radtend_type intent = inout optional = F -[f_ice] - standard_name = fraction_of_ice_water_cloud - long_name = fraction of ice water cloud - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[f_rain] - standard_name = fraction_of_rain_water_cloud - long_name = fraction of rain water cloud - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[f_rimef] - standard_name = rime_factor - long_name = rime factor - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [flgmin] standard_name = minimum_large_ice_fraction long_name = minimum large ice fraction in F-A mp scheme @@ -107,15 +80,6 @@ kind = kind_phys intent = in optional = F -[cwm] - standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics - long_name = total cloud condensate mixing ratio (except water vapor) updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F [lm] standard_name = number_of_vertical_layers_for_radiation_calculations long_name = number of vertical layers for radiation calculation @@ -461,7 +425,7 @@ [clouds3] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys @@ -479,7 +443,7 @@ [clouds5] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys @@ -497,7 +461,7 @@ [clouds7] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop - units = micron + units = um dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys @@ -515,7 +479,7 @@ [clouds9] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake - units = micron + units = um dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 7e0797538..033e723d2 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -58,7 +58,7 @@ [effr_in] standard_name = flag_for_cloud_effective_radii long_name = flag for cloud effective radii calculations in GFDL microphysics - units = + units = flag dimensions = () type = logical intent = in @@ -275,7 +275,7 @@ [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -293,7 +293,7 @@ [cld_reice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -311,7 +311,7 @@ [cld_resnow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -329,7 +329,7 @@ [cld_rerain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -387,4 +387,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/GFS_rrtmgp_zhaocarr_pre.meta b/physics/GFS_rrtmgp_zhaocarr_pre.meta index 11aac8437..e13b79d79 100644 --- a/physics/GFS_rrtmgp_zhaocarr_pre.meta +++ b/physics/GFS_rrtmgp_zhaocarr_pre.meta @@ -58,7 +58,7 @@ [effr_in] standard_name = flag_for_cloud_effective_radii long_name = flag for cloud effective radii calculations in GFDL microphysics - units = + units = flag dimensions = () type = logical intent = in @@ -305,7 +305,7 @@ [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -323,7 +323,7 @@ [cld_reice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -341,7 +341,7 @@ [cld_resnow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -359,7 +359,7 @@ [cld_rerain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -408,4 +408,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta index f1a088245..d5dd57020 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -228,7 +228,7 @@ [ipt] standard_name = index_for_diagnostic_printout long_name = horizontal index for point used for diagnostic printout - units = + units = index dimensions = () type = integer intent = out diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index 3c9a53606..d5b8fddbc 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -427,7 +427,7 @@ [effr_in] standard_name = flag_for_cloud_effective_radii long_name = flag for cloud effective radii calculations in GFDL microphysics - units = + units = flag dimensions = () type = logical intent = in diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index e74f5f7ee..5e1b9cae9 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -211,7 +211,7 @@ [clouds3] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -229,7 +229,7 @@ [clouds5] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index 95e521141..c4ed18977 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -121,7 +121,7 @@ end subroutine mp_fer_hires_init SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ,SLMSK & ,PRSI,P_PHY & - ,T,Q,CWM & + ,T,Q & ,TRAIN,SR & ,F_ICE,F_RAIN,F_RIMEF & ,QC,QR,QI,QG & ! wet mixing ratio @@ -159,7 +159,6 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys), intent(in ) :: epsq,r_d,p608,cp,g real(kind_phys), intent(inout) :: t(1:ncol,1:nlev) real(kind_phys), intent(inout) :: q(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: cwm(1:ncol,1:nlev) real(kind_phys), intent(inout) :: train(1:ncol,1:nlev) real(kind_phys), intent(out ) :: sr(1:ncol) real(kind_phys), intent(inout) :: f_ice(1:ncol,1:nlev) @@ -185,7 +184,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & integer :: I,J,K,N integer :: lowlyr(1:ncol) integer :: dx1 - !real(kind_phys) :: mprates(1:ncol,1:nlev,d_ss) + real(kind_phys) :: cwm(1:ncol,1:nlev) real(kind_phys) :: DTPHS,PCPCOL,RDTPHS,TNEW real(kind_phys) :: ql(1:nlev),tl(1:nlev) real(kind_phys) :: rainnc(1:ncol),rainncv(1:ncol) diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index a0591ade8..17b164766 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -214,15 +214,6 @@ kind = kind_phys intent = inout optional = F -[cwm] - standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics - long_name = total cloud condensate mixing ratio (except water vapor) updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [train] standard_name = accumulated_change_of_air_temperature_due_to_FA_scheme long_name = accumulated change of air temperature due to FA MP scheme diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 05fcf1de6..1bc1d5e00 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -317,7 +317,7 @@ [cld_ref_liq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -335,7 +335,7 @@ [cld_ref_ice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -353,7 +353,7 @@ [cld_ref_rain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -371,7 +371,7 @@ [cld_ref_snow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index 30e1d850c..ee4a88686 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -386,7 +386,7 @@ [cld_ref_liq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -404,7 +404,7 @@ [cld_ref_ice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -422,7 +422,7 @@ [cld_ref_rain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -440,7 +440,7 @@ [cld_ref_snow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 34ce77ad3..e03133985 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -186,7 +186,7 @@ [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real intent = in @@ -202,7 +202,7 @@ [cld_reice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real intent = in @@ -218,7 +218,7 @@ [cld_resnow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow flake - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real intent = in @@ -234,7 +234,7 @@ [cld_rerain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain drop - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real intent = in diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index 08fd7f3fd..d750990fa 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -188,7 +188,7 @@ [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -206,7 +206,7 @@ [cld_reice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -224,7 +224,7 @@ [cld_resnow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -242,7 +242,7 @@ [cld_rerain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys From 278b70660f5b53e6d34c97b7b467ed520737cac3 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Mon, 14 Sep 2020 15:49:25 +0000 Subject: [PATCH 053/274] Sept. 14 state --- physics/unified_ugwp.F90 | 7 +++++-- physics/unified_ugwp.meta | 16 ++++++++++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 203bf9c48..aa9be0492 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -153,10 +153,11 @@ end subroutine unified_ugwp_init !! \htmlinclude unified_ugwp_finalize.html !! #endif - subroutine unified_ugwp_finalize(errmsg, errflg) + subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v1,errmsg, errflg) implicit none ! + logical, intent (in) :: do_ugwp_v0, do_ugwp_v1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -166,7 +167,9 @@ subroutine unified_ugwp_finalize(errmsg, errflg) if (.not.is_initialized) return - call cires_ugwp_finalize() + if ( do_ugwp_v0 ) call cires_ugwp_mod_finalize() + + if ( do_ugwp_v1 ) call cires_ugwp_finalize() is_initialized = .false. diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index e45625e9e..23610f99c 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -239,6 +239,22 @@ [ccpp-arg-table] name = unified_ugwp_finalize type = scheme +[do_ugwp_v0] + standard_name = do_ugwp_v0 + long_name = flag to activate ver 0 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1] + standard_name = do_ugwp_v1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 4c2d7588ca7d47b62646de833ffc0cdb8b6cee56 Mon Sep 17 00:00:00 2001 From: Xia Sun Date: Tue, 15 Sep 2020 20:18:50 -0600 Subject: [PATCH 054/274] change from horizontal_loop_content to horizontal_dimension in init section --- physics/mp_fer_hires.meta | 4 ++-- physics/mp_thompson.meta | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 0e790d71c..702015adc 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -8,8 +8,8 @@ name = mp_fer_hires_init type = scheme [ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent + standard_name = horizontal_dimension + long_name = horizontal dimension units = count dimensions = () type = integer diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index f290639a6..4cfee6afc 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -8,8 +8,8 @@ name = mp_thompson_init type = scheme [ncol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent + standard_name = horizontal_dimension + long_name = horizontal dimension units = count dimensions = () type = integer From 862b4644cd8101901a1758b67e494d1fa5ee11d0 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Wed, 16 Sep 2020 09:41:32 -0600 Subject: [PATCH 055/274] unit fix --- physics/m_micro.meta | 14 +++++++------- physics/rrtmgp_lw_aerosol_optics.meta | 2 +- physics/rrtmgp_sw_aerosol_optics.meta | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/physics/m_micro.meta b/physics/m_micro.meta index f61e6511f..8b16276f1 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -777,25 +777,25 @@ [aerfld_i] standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration - units = kg-1? + units = kg-1 dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys intent = in optional = F [naai_i] - standard_name = in_number_concentration - long_name = IN number concentration - units = kg-1? + standard_name = ice_nucleation_number + long_name = ice nucleation number in MG MP + units = kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in optional = F [npccn_i] - standard_name = ccn_number_concentration - long_name = CCN number concentration - units = kg-1? + standard_name = tendency_of_ccn_activated_number + long_name = tendency of ccn activated number + units = kg-1 s-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index 8df363cb6..e182dc45e 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -113,7 +113,7 @@ [aerfld] standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration - units = kg-1? + units = kg-1 dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 68979ae5b..8acfc0611 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -129,7 +129,7 @@ [aerfld] standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration - units = kg-1? + units = kg-1 dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys From f6fd209bc0199f5996a9f9092e87035d85d69c05 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Thu, 17 Sep 2020 23:18:12 +0000 Subject: [PATCH 056/274] Sept. 17 -- debugging --- physics/cires_ugwp.F90 | 33 +++++++++++++++++++++++ physics/gwdps.f | 6 +++++ physics/unified_ugwp.F90 | 57 +++++++++++++++++++++++++++++++++++++++- 3 files changed, 95 insertions(+), 1 deletion(-) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index df0116cd0..51f2b9504 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -77,6 +77,8 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if (is_initialized) return if (do_ugwp .or. cdmbgwd(3) > 0.0) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in cires_ugwp_init calling cires_ugwp_mod_init" call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) @@ -224,6 +226,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr errmsg = '' errflg = 0 + ! Temporary line + if ( me == master ) write (41,*) "ahoj svete: qgrs(:,:,1) = ", qgrs(:,:,1) + ! 1) ORO stationary GWs ! ------------------ ! wrap everything in a do_ugwp 'if test' in order not to break the namelist functionality @@ -241,6 +246,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr zlwb(:) = 0. + ! Temporary line + if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling GWDPS_V0" + call GWDPS_V0(im, levs, lonr, do_tofd, Pdvdt, Pdudt, Pdtdt, Pkdis, & ugrs, vgrs, tgrs, qgrs(:,:,1), kpbl, prsi,del,prsl, prslk, phii, phil, & dtp, kdt, sgh30, hprime, oc, oa4, clx, theta, sigma, gamma, elvmax, & @@ -250,6 +258,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr else ! calling old GFS gravity wave drag as is + ! Temporary line + if ( me == master ) print *, "ahoj svete: in cires_ugwp_run possibly about to call gwdps_run" + do k=1,levs do i=1,im Pdvdt(i,k) = 0.0 @@ -260,6 +271,8 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr enddo if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling gwdps_run" call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs, vgrs, tgrs, qgrs, & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & @@ -271,6 +284,17 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr if (errflg/=0) return endif + if ( me == master ) write (51,*) "ahoj svete: in cires after & + &gwdps_run ", kdt, " Pdudt = ", Pdudt + if ( me == master ) write (53,*) "ahoj svete: in cires after & + &gwdps_run ", kdt, " Pdvdt = ", Pdvdt + if ( me == master ) write (55,*) "ahoj svete: in cires after & + &gwdps_run ", kdt, " Pdtdt = ", Pdtdt + if ( me == master ) write (57,*) "ahoj svete: in cires after & + &gwdps_run ", kdt, " hprime =", hprime + if ( me == master ) write (59,*) "ahoj svete: in cires after & + &gwdps_run ", kdt, " elvmax =", elvmax + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 if (ldiag_ugwp) then du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 @@ -292,6 +316,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr if (cdmbgwd(3) > 0.0) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling slat_geos5_tamp" + ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) @@ -330,6 +357,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr enddo endif + ! Temporary line + if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling fv3_ugwp_solv2_v0" + call fv3_ugwp_solv2_v0(im, levs, dtp, tgrs, ugrs, vgrs,qgrs(:,:,1), & prsl, prsi, phil, xlat_d, sinlat, coslat, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_ngw, me, master, kdt) @@ -349,6 +379,9 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr else + ! Temporary line + if ( me == master ) print *, "ahoj svete: in cires_ugwp_run, didn't call ngw schemes" + do k=1,levs do i=1,im gw_dtdt(i,k) = Pdtdt(i,k) diff --git a/physics/gwdps.f b/physics/gwdps.f index b09413f02..63e9a7f7b 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -443,6 +443,9 @@ subroutine gwdps_run( & LCAP = KM LCAPP1 = LCAP + 1 ! +! Temporary line + if ( me == 0 ) print *, "ahoj svete: in gwdps_run, nmtvr =", nmtvr +! ! IF ( NMTVR == 14) then ! ---- for lm and gwd calculation points @@ -456,6 +459,9 @@ subroutine gwdps_run( & if (ipr == i) npr = npt ENDIF ENDDO + ! Temporary line + if (npt == 0 .and. me==0) print *, "ahoj svete: in gwdps_run ", + & kdt, " npt =", npt IF (npt == 0) RETURN ! No gwd/mb calculation done! ! ! if (lprnt) print *,' npt=',npt,' npr=',npr,' ipr=',ipr,' im=',im diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index aa9be0492..f97e218d1 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -120,6 +120,8 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if ( do_ugwp_v0 ) then ! if (do_ugwp .or. cdmbgwd(3) > 0.0) then (deactivate effect of do_ugwp) if (cdmbgwd(3) > 0.0) then + ! Temporary line + if ( me==master ) print *, "ahoj svete: in unified_ugwp_init calling cires_ugwp_mod_init" call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) @@ -133,6 +135,8 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if ( do_ugwp_v1 ) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_ugwp_init calling cires_ugwp_init_v1" call cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) @@ -295,6 +299,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ! switches that activate impact of OGWs and NGWs (WL* how to deal with them? *WL) real(kind=kind_phys), parameter :: pogw=1., pngw=1., pked=1. real(kind=kind_phys), parameter :: fw1_tau=1.0 + integer :: nmtvr_temp real(kind=kind_phys), dimension(:,:), allocatable :: tke real(kind=kind_phys), dimension(:), allocatable :: turb_fac, tem @@ -330,11 +335,25 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, zlwb(:) = 0. + ! Temporary lines + if ( me == master ) write (80,*) "ahoj svete: in unified beginning ", & + kdt, " elvmax =", elvmax + if ( me == master ) write (81,*) "ahoj svete: in unified beginning ", & + kdt, " sigma =", sigma + if ( me == master ) write (82,*) "ahoj svete: in unified beginning ", & + kdt, " oc =", oc + + + ! Temporary line + if ( me == master ) write (40,*) "ahoj svete: q1 = ", q1 + ! Run the appropriate large-scale (large-scale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_ugwp_run calling drag_suite_run" call drag_suite_run(im,levs,dvdt,dudt,dtdt,ugrs,vgrs,tgrs,q1, & kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & @@ -351,6 +370,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, else if ( do_ugwp_v1.or.do_ugwp_v1_orog_only ) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_ugwp_run calling gwdps_oro_v1" + ! Valery's TOFD ! topo paras ! w/ orographic effects @@ -378,6 +400,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, else if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_ugwp_run getting ready to call something" + do k=1,levs do i=1,im Pdvdt(i,k) = 0.0 @@ -388,17 +413,37 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, enddo if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_ugwp_run calling gwdps_run" + + ! Override nmtvr with nmtvr_temp = 14 for passing into gwdps_run if necessary + if ( nmtvr == 24 ) then ! gwd_opt = 2, 22, 3, or 33 + nmtvr_temp = 14 + else + nmtvr_temp = nmtvr + end if call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs, vgrs, tgrs, q1, & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & hprime, oc, oa4, clx, theta, sigma, gamma, & elvmax, dusfcg, dvsfcg, & con_g, con_cp, con_rd, con_rv, lonr, & - nmtvr, cdmbgwd, me, lprnt, ipr, rdxzb, & + nmtvr_temp, cdmbgwd, me, lprnt, ipr, rdxzb, & errmsg, errflg) if (errflg/=0) return endif + if ( me == master ) write (52,*) "ahoj svete: in unified after & + &gwdps_run ", kdt, " Pdudt = ", Pdudt + if ( me == master ) write (54,*) "ahoj svete: in unified after & + &gwdps_run ", kdt, " Pdvdt = ", Pdvdt + if ( me == master ) write (56,*) "ahoj svete: in unified after & + &gwdps_run ", kdt, " Pdtdt = ", Pdtdt + if ( me == master ) write (58,*) "ahoj svete: in unified after & + &gwdps_run ", kdt, " hprime =", hprime + if ( me == master ) write (60,*) "ahoj svete: in unified after & + &gwdps_run ", kdt, " elvmax =", elvmax + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 if (ldiag_ugwp) then du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 @@ -430,6 +475,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if (cdmbgwd(3) > 0.0) then + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_drag_run calling slat_geos5_tamp" + + ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) @@ -468,6 +517,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, enddo endif + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_drag_run calling fv3_ugwp_solv2_v0" + call fv3_ugwp_solv2_v0(im, levs, dtp, tgrs, ugrs, vgrs, q1, & prsl, prsi, phil, xlat_d, sinlat, coslat, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_ngw, me, master, kdt) @@ -487,6 +539,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, else ! .not.(cdmbgwd(3) > 0.0) + ! Temporary line + if ( me == master ) print *, "ahoj svete: in unified_ugwp_run not calling slat_geos5_tamp" + do k=1,levs do i=1,im gw_dtdt(i,k) = Pdtdt(i,k) From bd921f53aadce0afe0a9744afc4042ff027accd1 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Fri, 18 Sep 2020 17:17:41 +0000 Subject: [PATCH 057/274] Bug fixes -- Sept. 18 --- physics/GFS_GWD_generic.F90 | 4 +++ physics/cires_ugwp.F90 | 33 ------------------------ physics/gwdps.f | 6 ----- physics/unified_ugwp.F90 | 50 ++----------------------------------- 4 files changed, 6 insertions(+), 87 deletions(-) diff --git a/physics/GFS_GWD_generic.F90 b/physics/GFS_GWD_generic.F90 index ed3ff4484..2ab0fb37a 100644 --- a/physics/GFS_GWD_generic.F90 +++ b/physics/GFS_GWD_generic.F90 @@ -93,6 +93,10 @@ subroutine GFS_GWD_generic_pre_run( & clx(:,2) = mntvar(:,8) clx(:,3) = mntvar(:,9) clx(:,4) = mntvar(:,10) + theta(:) = mntvar(:,11) + gamma(:) = mntvar(:,12) + sigma(:) = mntvar(:,13) + elvmax(:) = mntvar(:,14) varss(:) = mntvar(:,15) ocss(:) = mntvar(:,16) oa4ss(:,1) = mntvar(:,17) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 51f2b9504..df0116cd0 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -77,8 +77,6 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if (is_initialized) return if (do_ugwp .or. cdmbgwd(3) > 0.0) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in cires_ugwp_init calling cires_ugwp_mod_init" call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) @@ -226,9 +224,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr errmsg = '' errflg = 0 - ! Temporary line - if ( me == master ) write (41,*) "ahoj svete: qgrs(:,:,1) = ", qgrs(:,:,1) - ! 1) ORO stationary GWs ! ------------------ ! wrap everything in a do_ugwp 'if test' in order not to break the namelist functionality @@ -246,9 +241,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr zlwb(:) = 0. - ! Temporary line - if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling GWDPS_V0" - call GWDPS_V0(im, levs, lonr, do_tofd, Pdvdt, Pdudt, Pdtdt, Pkdis, & ugrs, vgrs, tgrs, qgrs(:,:,1), kpbl, prsi,del,prsl, prslk, phii, phil, & dtp, kdt, sgh30, hprime, oc, oa4, clx, theta, sigma, gamma, elvmax, & @@ -258,9 +250,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr else ! calling old GFS gravity wave drag as is - ! Temporary line - if ( me == master ) print *, "ahoj svete: in cires_ugwp_run possibly about to call gwdps_run" - do k=1,levs do i=1,im Pdvdt(i,k) = 0.0 @@ -271,8 +260,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr enddo if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling gwdps_run" call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs, vgrs, tgrs, qgrs, & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & @@ -284,17 +271,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr if (errflg/=0) return endif - if ( me == master ) write (51,*) "ahoj svete: in cires after & - &gwdps_run ", kdt, " Pdudt = ", Pdudt - if ( me == master ) write (53,*) "ahoj svete: in cires after & - &gwdps_run ", kdt, " Pdvdt = ", Pdvdt - if ( me == master ) write (55,*) "ahoj svete: in cires after & - &gwdps_run ", kdt, " Pdtdt = ", Pdtdt - if ( me == master ) write (57,*) "ahoj svete: in cires after & - &gwdps_run ", kdt, " hprime =", hprime - if ( me == master ) write (59,*) "ahoj svete: in cires after & - &gwdps_run ", kdt, " elvmax =", elvmax - tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 if (ldiag_ugwp) then du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 @@ -316,9 +292,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr if (cdmbgwd(3) > 0.0) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling slat_geos5_tamp" - ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) @@ -357,9 +330,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr enddo endif - ! Temporary line - if ( me == master ) print *, "ahoj svete: in cires_ugwp_run calling fv3_ugwp_solv2_v0" - call fv3_ugwp_solv2_v0(im, levs, dtp, tgrs, ugrs, vgrs,qgrs(:,:,1), & prsl, prsi, phil, xlat_d, sinlat, coslat, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_ngw, me, master, kdt) @@ -379,9 +349,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr else - ! Temporary line - if ( me == master ) print *, "ahoj svete: in cires_ugwp_run, didn't call ngw schemes" - do k=1,levs do i=1,im gw_dtdt(i,k) = Pdtdt(i,k) diff --git a/physics/gwdps.f b/physics/gwdps.f index 63e9a7f7b..b09413f02 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -443,9 +443,6 @@ subroutine gwdps_run( & LCAP = KM LCAPP1 = LCAP + 1 ! -! Temporary line - if ( me == 0 ) print *, "ahoj svete: in gwdps_run, nmtvr =", nmtvr -! ! IF ( NMTVR == 14) then ! ---- for lm and gwd calculation points @@ -459,9 +456,6 @@ subroutine gwdps_run( & if (ipr == i) npr = npt ENDIF ENDDO - ! Temporary line - if (npt == 0 .and. me==0) print *, "ahoj svete: in gwdps_run ", - & kdt, " npt =", npt IF (npt == 0) RETURN ! No gwd/mb calculation done! ! ! if (lprnt) print *,' npt=',npt,' npr=',npr,' ipr=',ipr,' im=',im diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index f97e218d1..2c4c2a856 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -120,8 +120,6 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if ( do_ugwp_v0 ) then ! if (do_ugwp .or. cdmbgwd(3) > 0.0) then (deactivate effect of do_ugwp) if (cdmbgwd(3) > 0.0) then - ! Temporary line - if ( me==master ) print *, "ahoj svete: in unified_ugwp_init calling cires_ugwp_mod_init" call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) @@ -135,8 +133,6 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if ( do_ugwp_v1 ) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_ugwp_init calling cires_ugwp_init_v1" call cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) @@ -335,25 +331,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, zlwb(:) = 0. - ! Temporary lines - if ( me == master ) write (80,*) "ahoj svete: in unified beginning ", & - kdt, " elvmax =", elvmax - if ( me == master ) write (81,*) "ahoj svete: in unified beginning ", & - kdt, " sigma =", sigma - if ( me == master ) write (82,*) "ahoj svete: in unified beginning ", & - kdt, " oc =", oc - - - ! Temporary line - if ( me == master ) write (40,*) "ahoj svete: q1 = ", q1 - ! Run the appropriate large-scale (large-scale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd ) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_ugwp_run calling drag_suite_run" call drag_suite_run(im,levs,dvdt,dudt,dtdt,ugrs,vgrs,tgrs,q1, & kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & @@ -370,9 +352,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, else if ( do_ugwp_v1.or.do_ugwp_v1_orog_only ) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_ugwp_run calling gwdps_oro_v1" - ! Valery's TOFD ! topo paras ! w/ orographic effects @@ -400,9 +379,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, else if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_ugwp_run getting ready to call something" - do k=1,levs do i=1,im Pdvdt(i,k) = 0.0 @@ -413,15 +389,14 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, enddo if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_ugwp_run calling gwdps_run" ! Override nmtvr with nmtvr_temp = 14 for passing into gwdps_run if necessary if ( nmtvr == 24 ) then ! gwd_opt = 2, 22, 3, or 33 nmtvr_temp = 14 else - nmtvr_temp = nmtvr + nmtvr_temp = nmtvr end if + call gwdps_run(im, levs, Pdvdt, Pdudt, Pdtdt, & ugrs, vgrs, tgrs, q1, & kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt, & @@ -433,17 +408,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if (errflg/=0) return endif - if ( me == master ) write (52,*) "ahoj svete: in unified after & - &gwdps_run ", kdt, " Pdudt = ", Pdudt - if ( me == master ) write (54,*) "ahoj svete: in unified after & - &gwdps_run ", kdt, " Pdvdt = ", Pdvdt - if ( me == master ) write (56,*) "ahoj svete: in unified after & - &gwdps_run ", kdt, " Pdtdt = ", Pdtdt - if ( me == master ) write (58,*) "ahoj svete: in unified after & - &gwdps_run ", kdt, " hprime =", hprime - if ( me == master ) write (60,*) "ahoj svete: in unified after & - &gwdps_run ", kdt, " elvmax =", elvmax - tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 if (ldiag_ugwp) then du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 @@ -475,10 +439,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if (cdmbgwd(3) > 0.0) then - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_drag_run calling slat_geos5_tamp" - - ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) @@ -517,9 +477,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, enddo endif - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_drag_run calling fv3_ugwp_solv2_v0" - call fv3_ugwp_solv2_v0(im, levs, dtp, tgrs, ugrs, vgrs, q1, & prsl, prsi, phil, xlat_d, sinlat, coslat, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_ngw, me, master, kdt) @@ -539,9 +496,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, else ! .not.(cdmbgwd(3) > 0.0) - ! Temporary line - if ( me == master ) print *, "ahoj svete: in unified_ugwp_run not calling slat_geos5_tamp" - do k=1,levs do i=1,im gw_dtdt(i,k) = Pdtdt(i,k) From a96775edd755b13ed28f2d9f700eb3283372bb24 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Tue, 29 Sep 2020 14:37:18 +0000 Subject: [PATCH 058/274] Sept. 28 bug fix --- physics/unified_ugwp.F90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 2c4c2a856..bdd0fbb70 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -350,7 +350,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & errmsg,errflg) - else if ( do_ugwp_v1.or.do_ugwp_v1_orog_only ) then + end if + + if ( do_ugwp_v1.or.do_ugwp_v1_orog_only ) then ! Valery's TOFD ! topo paras @@ -377,7 +379,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & du3dt_mtb, du3dt_ogw, du3dt_tms) - else if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then + end if + + if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then do k=1,levs do i=1,im From 423c6bd0e932a463818096ce16051fb498d38291 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Thu, 1 Oct 2020 09:24:30 -0600 Subject: [PATCH 059/274] revert some changes per Doms comments --- physics/GFS_rrtmg_setup.meta | 16 ++++++++-------- physics/GFS_rrtmgp_setup.meta | 16 ++++++++-------- physics/mp_fer_hires.F90 | 5 +++-- physics/mp_fer_hires.meta | 9 +++++++++ 4 files changed, 28 insertions(+), 18 deletions(-) diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 8793f7393..8377807d8 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -113,32 +113,32 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation - long_name = control flag for cloud overlapping method for SW + standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation + long_name = sw: max-random overlap clouds units = flag dimensions = () type = integer intent = in optional = F [iovr_lw] - standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation - long_name = control flag for cloud overlapping method for LW + standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation + long_name = lw: max-random overlap clouds units = flag dimensions = () type = integer intent = in optional = F [isubc_sw] - standard_name = flag_for_subcolumn_cloud_approximation_for_shortwave_radiation - long_name = flag for subcolumn cloud approximation for shortwave radiation + standard_name = flag_for_sw_clouds_without_sub_grid_approximation + long_name = flag for sw clouds without sub-grid approximation units = flag dimensions = () type = integer intent = in optional = F [isubc_lw] - standard_name = flag_for_subcolumn_cloud_approximation_for_longwave_radiation - long_name = flag for subcolumn cloud approximation for longwave radiation + standard_name = flag_for_lw_clouds_without_sub_grid_approximation + long_name = flag for lw clouds without sub-grid approximation units = flag dimensions = () type = integer diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index c0c192c62..430226dbc 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -161,32 +161,32 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation - long_name = control flag for cloud overlapping method for SW + standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation + long_name = sw: max-random overlap clouds units = flag dimensions = () type = integer intent = in optional = F [iovr_lw] - standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation - long_name = control flag for cloud overlapping method for SW + standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation + long_name = lw: max-random overlap clouds units = flag dimensions = () type = integer intent = in optional = F [isubc_sw] - standard_name = flag_for_subcolumn_cloud_approximation_for_shortwave_radiation - long_name = flag for subcolumn cloud approximation for shortwave radiation + standard_name = flag_for_sw_clouds_without_sub_grid_approximation + long_name = flag for sw clouds without sub-grid approximation units = flag dimensions = () type = integer intent = in optional = F [isubc_lw] - standard_name = flag_for_subcolumn_cloud_approximation_for_longwave_radiation - long_name = flag for subcolumn cloud approximation for longwave radiation + standard_name = flag_for_lw_clouds_without_sub_grid_approximation + long_name = flag for lw clouds without sub-grid approximation units = flag dimensions = () type = integer diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index c4ed18977..95e521141 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -121,7 +121,7 @@ end subroutine mp_fer_hires_init SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ,SLMSK & ,PRSI,P_PHY & - ,T,Q & + ,T,Q,CWM & ,TRAIN,SR & ,F_ICE,F_RAIN,F_RIMEF & ,QC,QR,QI,QG & ! wet mixing ratio @@ -159,6 +159,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys), intent(in ) :: epsq,r_d,p608,cp,g real(kind_phys), intent(inout) :: t(1:ncol,1:nlev) real(kind_phys), intent(inout) :: q(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: cwm(1:ncol,1:nlev) real(kind_phys), intent(inout) :: train(1:ncol,1:nlev) real(kind_phys), intent(out ) :: sr(1:ncol) real(kind_phys), intent(inout) :: f_ice(1:ncol,1:nlev) @@ -184,7 +185,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & integer :: I,J,K,N integer :: lowlyr(1:ncol) integer :: dx1 - real(kind_phys) :: cwm(1:ncol,1:nlev) + !real(kind_phys) :: mprates(1:ncol,1:nlev,d_ss) real(kind_phys) :: DTPHS,PCPCOL,RDTPHS,TNEW real(kind_phys) :: ql(1:nlev),tl(1:nlev) real(kind_phys) :: rainnc(1:ncol),rainncv(1:ncol) diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 17b164766..a0591ade8 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -214,6 +214,15 @@ kind = kind_phys intent = inout optional = F +[cwm] + standard_name = total_cloud_condensate_mixing_ratio_updated_by_physics + long_name = total cloud condensate mixing ratio (except water vapor) updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [train] standard_name = accumulated_change_of_air_temperature_due_to_FA_scheme long_name = accumulated change of air temperature due to FA MP scheme From 0f08d1e693423e1925e1eaf0ef49c0bd35c42976 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 2 Oct 2020 17:31:59 -0600 Subject: [PATCH 060/274] Fix legacy warnings: remove old CCPP arg table hooks for empty subroutines without entries in the metadata files --- physics/GFS_MP_generic.F90 | 21 ++++--------- physics/GFS_rad_time_vary.fv3.F90 | 5 +-- physics/GFS_rad_time_vary.scm.F90 | 4 --- physics/GFS_rrtmg_post.F90 | 4 --- physics/GFS_rrtmg_pre.F90 | 4 --- physics/GFS_rrtmg_pre.meta | 2 +- physics/cires_ugwp_post.F90 | 8 ----- physics/cnvc90.f | 7 ----- physics/cs_conv.F90 | 14 --------- physics/cu_gf_driver.F90 | 5 --- physics/cu_ntiedtke.F90 | 5 --- physics/dcyc2.f | 7 ----- physics/drag_suite.F90 | 5 +-- physics/get_prs_fv3.F90 | 16 ---------- physics/gwdc.f | 51 ++++++++++++------------------- physics/gwdc.meta | 35 ++++++++++++++++----- physics/gwdps.f | 5 --- physics/h2ophys.f | 8 ----- physics/m_micro.F90 | 4 --- physics/m_micro_interstitial.F90 | 18 ----------- physics/mp_fer_hires.F90 | 2 -- physics/ozphys.f | 5 --- physics/ozphys_2015.f | 5 --- physics/precpd.f | 7 ----- physics/radlw_main.meta | 2 +- physics/radsw_main.meta | 2 +- physics/rayleigh_damp.f | 6 ---- physics/rrtmg_lw_post.F90 | 7 ----- physics/rrtmg_lw_pre.F90 | 4 --- physics/rrtmg_sw_post.F90 | 8 +---- physics/rrtmg_sw_pre.F90 | 4 --- physics/samfdeepcnv.f | 9 ------ physics/samfshalcnv.f | 10 ------ physics/sascnvn.F | 6 +--- physics/sfc_nst.f | 11 ------- physics/sfc_ocean.F | 4 --- physics/shalcnv.F | 6 +--- 37 files changed, 62 insertions(+), 264 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 8810cc7cf..435a80509 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -6,13 +6,9 @@ module GFS_MP_generic_pre contains - -!! \section arg_table_GFS_MP_generic_pre_init Argument Table -!! - subroutine GFS_MP_generic_pre_init + subroutine GFS_MP_generic_pre_init() end subroutine GFS_MP_generic_pre_init - !> \section arg_table_GFS_MP_generic_pre_run Argument Table !! \htmlinclude GFS_MP_generic_pre_run.html !! @@ -64,9 +60,7 @@ subroutine GFS_MP_generic_pre_run(im, levs, ldiag3d, qdiag3d, do_aw, ntcw, nncl, end subroutine GFS_MP_generic_pre_run -!> \section arg_table_GFS_MP_generic_pre_finalize Argument Table -!! - subroutine GFS_MP_generic_pre_finalize + subroutine GFS_MP_generic_pre_finalize() end subroutine GFS_MP_generic_pre_finalize end module GFS_MP_generic_pre @@ -77,9 +71,7 @@ end module GFS_MP_generic_pre module GFS_MP_generic_post contains -!! \section arg_table_GFS_MP_generic_post_init Argument Table -!! - subroutine GFS_MP_generic_post_init + subroutine GFS_MP_generic_post_init() end subroutine GFS_MP_generic_post_init !>\defgroup gfs_calpreciptype GFS Precipitation Type Diagnostics Module @@ -405,11 +397,10 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, dtdtr(1:im,:) = dtdtr(1:im,:) + dtdtc(1:im,:)*dtf endif - end subroutine GFS_MP_generic_post_run + end subroutine GFS_MP_generic_post_run !> @} -!> \section arg_table_GFS_MP_generic_post_finalize Argument Table -!! - subroutine GFS_MP_generic_post_finalize + subroutine GFS_MP_generic_post_finalize() end subroutine GFS_MP_generic_post_finalize + end module GFS_MP_generic_post diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/GFS_rad_time_vary.fv3.F90 index 9a4583dc4..f30bf93f9 100644 --- a/physics/GFS_rad_time_vary.fv3.F90 +++ b/physics/GFS_rad_time_vary.fv3.F90 @@ -10,8 +10,6 @@ module GFS_rad_time_vary contains -!! \section arg_table_GFS_rad_time_vary_init Argument Table -!! subroutine GFS_rad_time_vary_init end subroutine GFS_rad_time_vary_init @@ -100,8 +98,7 @@ subroutine GFS_rad_time_vary_run (Model, Data, nthrds, errmsg, errflg) end subroutine GFS_rad_time_vary_run !> @} -!> \section arg_table_GFS_rad_time_vary_finalize Argument Table -!! subroutine GFS_rad_time_vary_finalize() end subroutine GFS_rad_time_vary_finalize + end module GFS_rad_time_vary diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 13ae5e14b..9d7302beb 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -13,8 +13,6 @@ module GFS_rad_time_vary !>\defgroup GFS_rad_time_vary GFS RRTMG Update !!\ingroup RRTMG !! @{ -!! \section arg_table_GFS_rad_time_vary_init Argument Table -!! subroutine GFS_rad_time_vary_init end subroutine GFS_rad_time_vary_init @@ -86,8 +84,6 @@ subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) end subroutine GFS_rad_time_vary_run -!> \section arg_table_GFS_rad_time_vary_finalize Argument Table -!! subroutine GFS_rad_time_vary_finalize() end subroutine GFS_rad_time_vary_finalize !! @} diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index 7f80ca4c3..bcc336fa7 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -5,8 +5,6 @@ module GFS_rrtmg_post !>\defgroup GFS_rrtmg_post GFS RRTMG Scheme Post !! @{ -!> \section arg_table_GFS_rrtmg_post_init Argument Table -!! subroutine GFS_rrtmg_post_init () end subroutine GFS_rrtmg_post_init @@ -198,8 +196,6 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & ! end subroutine GFS_rrtmg_post_run -!> \section arg_table_GFS_rrtmg_post_finalize Argument Table -!! subroutine GFS_rrtmg_post_finalize () end subroutine GFS_rrtmg_post_finalize diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 9c5b84d5f..623508407 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -8,8 +8,6 @@ module GFS_rrtmg_pre !> \defgroup GFS_rrtmg_pre GFS RRTMG Scheme Pre !! @{ -!! \section arg_table_GFS_rrtmg_pre_init Argument Table -!! subroutine GFS_rrtmg_pre_init () end subroutine GFS_rrtmg_pre_init @@ -982,8 +980,6 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input end subroutine GFS_rrtmg_pre_run -!> \section arg_table_GFS_rrtmg_pre_finalize Argument Table -!! subroutine GFS_rrtmg_pre_finalize () end subroutine GFS_rrtmg_pre_finalize diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 6b2097322..a3c4e3972 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -568,7 +568,7 @@ standard_name = cloud_overlap_decorrelation_parameter long_name = cloud overlap decorrelation parameter units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = out diff --git a/physics/cires_ugwp_post.F90 b/physics/cires_ugwp_post.F90 index 612db2c0e..68c90bc55 100644 --- a/physics/cires_ugwp_post.F90 +++ b/physics/cires_ugwp_post.F90 @@ -6,19 +6,13 @@ module cires_ugwp_post !>\defgroup cires_ugwp_post CIRES UGWP Scheme Post !! @{ -!> \section arg_table_cires_ugwp_post_init Argument Table -!! subroutine cires_ugwp_post_init () end subroutine cires_ugwp_post_init !>@brief The subroutine initializes the CIRES UGWP -#if 0 !> \section arg_table_cires_ugwp_post_run Argument Table !! \htmlinclude cires_ugwp_post_run.html !! -#endif - - subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & gw_dtdt, gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & tau_ngw, zmtb, zlwb, zogw, dudt_mtb, dudt_ogw, dudt_tms, & @@ -74,8 +68,6 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & end subroutine cires_ugwp_post_run -!> \section arg_table_cires_ugwp_post_finalize Argument Table -!! subroutine cires_ugwp_post_finalize () end subroutine cires_ugwp_post_finalize diff --git a/physics/cnvc90.f b/physics/cnvc90.f index 9bef0ebf9..fe3601ce2 100644 --- a/physics/cnvc90.f +++ b/physics/cnvc90.f @@ -6,9 +6,6 @@ module cnvc90 contains - -!! \section arg_table_cnvc90_init Argument Table -!! subroutine cnvc90_init() end subroutine cnvc90_init @@ -130,12 +127,8 @@ SUBROUTINE cnvc90_run(CLSTP,IM,RN,KBOT,KTOP,KM,PRSI, & END SUBROUTINE cnvc90_run !> @} - -!! \section arg_table_cnvc90_finalize Argument Table -!! subroutine cnvc90_finalize() end subroutine cnvc90_finalize - end module cnvc90 diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index 386349422..a7b03d387 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -4,21 +4,15 @@ module cs_conv_pre contains -!! \section arg_table_cs_conv_pre_init Argument Table -!! subroutine cs_conv_pre_init() end subroutine cs_conv_pre_init -!! \section arg_table_cs_conv_pre_finalize Argument Table -!! subroutine cs_conv_pre_finalize() end subroutine cs_conv_pre_finalize -#if 0 !! \section arg_table_cs_conv_pre_run Argument Table !! \htmlinclude cs_conv_pre_run.html !! -#endif subroutine cs_conv_pre_run(im, levs, ntrac, ncld, q, clw1, clw2, & & work1, work2, cs_parm1, cs_parm2, wcbmax, & & fswtr, fscav, save_q1, save_q2, save_q3, & @@ -78,13 +72,9 @@ end module cs_conv_pre module cs_conv_post contains -!! \section arg_table_cs_conv_post_init Argument Table -!! subroutine cs_conv_post_init() end subroutine cs_conv_post_init -!! \section arg_table_cs_conv_post_finalize Argument Table -!! subroutine cs_conv_post_finalize() end subroutine cs_conv_post_finalize @@ -218,13 +208,9 @@ module cs_conv contains -!> \section arg_table_cs_conv_init Argument Table -!! subroutine cs_conv_init() end subroutine cs_conv_init -!> \section arg_table_cs_conv_finalize Argument Table -!! subroutine cs_conv_finalize() end subroutine cs_conv_finalize diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index 150f9f6c0..8e81cf8ab 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -46,11 +46,6 @@ subroutine cu_gf_driver_init(mpirank, mpiroot, errmsg, errflg) end subroutine cu_gf_driver_init - -!> \brief Brief description of the subroutine -!! -!! \section arg_table_cu_gf_driver_finalize Argument Table -!! subroutine cu_gf_driver_finalize() end subroutine cu_gf_driver_finalize ! diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index a824c6af4..a39930d77 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -129,11 +129,6 @@ subroutine cu_ntiedtke_init(mpirank, mpiroot, errmsg, errflg) end subroutine cu_ntiedtke_init - -!> \brief Brief description of the subroutine -!! -!! \section arg_table_cu_ntiedtke_finalize Argument Table -!! subroutine cu_ntiedtke_finalize() end subroutine cu_ntiedtke_finalize ! diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 6dca65cf5..22eece516 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -16,19 +16,12 @@ module dcyc2t3 contains -!! \section arg_table_dcyc2t3_init Argument Table -!! subroutine dcyc2t3_init() end subroutine dcyc2t3_init -!! \section arg_table_dcyc2t3_finalize Argument Table -!! subroutine dcyc2t3_finalize() end subroutine dcyc2t3_finalize - - - ! ===================================================================== ! ! description: ! ! ! diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 55ef9c268..66bf7fcb5 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -7,8 +7,6 @@ module drag_suite contains -!> \section arg_table_drag_suite_init Argument Table -!! subroutine drag_suite_init() end subroutine drag_suite_init @@ -1299,8 +1297,7 @@ subroutine drag_suite_run( & end subroutine drag_suite_run !------------------------------------------------------------------- ! -!> \section arg_table_drag_suite_finalize Argument Table -!! + subroutine drag_suite_finalize() end subroutine drag_suite_finalize diff --git a/physics/get_prs_fv3.F90 b/physics/get_prs_fv3.F90 index 352a61895..224c8c853 100644 --- a/physics/get_prs_fv3.F90 +++ b/physics/get_prs_fv3.F90 @@ -12,13 +12,9 @@ module get_prs_fv3 contains - -!! \section arg_table_get_prs_fv3_init Argument Table -!! subroutine get_prs_fv3_init() end subroutine get_prs_fv3_init - !! \section arg_table_get_prs_fv3_run Argument Table !! \htmlinclude get_prs_fv3_run.html !! @@ -56,17 +52,12 @@ subroutine get_prs_fv3_run(ix, levs, phii, prsi, tgrs, qgrs1, del, del_gz, errms end subroutine get_prs_fv3_run - -!! \section arg_table_get_prs_fv3_finalize Argument Table -!! subroutine get_prs_fv3_finalize() end subroutine get_prs_fv3_finalize - end module get_prs_fv3 - module get_phi_fv3 use machine, only: kind_phys @@ -82,12 +73,9 @@ module get_phi_fv3 contains -!! \section arg_table_get_phi_fv3_init Argument Table -!! subroutine get_phi_fv3_init() end subroutine get_phi_fv3_init - !! \section arg_table_get_phi_fv3_run Argument Table !! \htmlinclude get_phi_fv3_run.html !! @@ -127,13 +115,9 @@ subroutine get_phi_fv3_run(ix, levs, gt0, gq01, del_gz, phii, phil, errmsg, errf end subroutine get_phi_fv3_run - -!! \section arg_table_get_phi_fv3_finalize Argument Table -!! subroutine get_phi_fv3_finalize() end subroutine get_phi_fv3_finalize - end module get_phi_fv3 diff --git a/physics/gwdc.f b/physics/gwdc.f index 5c6f8ecd7..fc81373ce 100644 --- a/physics/gwdc.f +++ b/physics/gwdc.f @@ -7,10 +7,6 @@ module gwdc_pre contains -! \brief Brief description of the subroutine -! -!> \section arg_table_gwdc_pre_init Argument Table -!! subroutine gwdc_pre_init() end subroutine gwdc_pre_init @@ -22,7 +18,7 @@ end subroutine gwdc_pre_init subroutine gwdc_pre_run ( & & im, cgwf, dx, work1, work2, dlength, cldf, & & levs, kbot, ktop, dtp, gt0, gt0_init, del, cumabs, & - & do_cnvgwd, errmsg, errflg ) + & errmsg, errflg ) use machine, only : kind_phys implicit none @@ -38,7 +34,6 @@ subroutine gwdc_pre_run ( & real(kind=kind_phys), intent(out) :: & & dlength(:), cldf(:), cumabs(:) - logical, intent(in) :: do_cnvgwd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -50,14 +45,6 @@ subroutine gwdc_pre_run ( & errmsg = '' errflg = 0 - ! DH* - if (.not. do_cnvgwd) then - write(0,*) "ERROR: , GWDC_PRE CALLED BUT DO_CNVGWD FALSE" - call sleep(5) - stop - end if - ! *DH - do i = 1, im tem1 = dx(i) tem2 = tem1 @@ -85,10 +72,6 @@ subroutine gwdc_pre_run ( & end subroutine gwdc_pre_run -! \brief Brief description of the subroutine -! -!> \section arg_table_gwdc_pre_finalize Argument Table -!! subroutine gwdc_pre_finalize () end subroutine gwdc_pre_finalize @@ -103,8 +86,26 @@ module gwdc ! \brief Brief description of the subroutine ! !> \section arg_table_gwdc_init Argument Table +!! \htmlinclude gwdc_init.html !! - subroutine gwdc_init() + subroutine gwdc_init(do_cnvgwd, errmsg, errflg) + + implicit none + + logical, intent(in) :: do_cnvgwd + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. do_cnvgwd) then + errmsg = "Logic error: gwdc called but do_cnvgwd is false" + errflg = 1 + return + end if + end subroutine gwdc_init !> \defgroup GFS_gwdc_run GFS Convective Gravity Wave Drag Scheme Module @@ -1437,10 +1438,6 @@ subroutine gwdc_run (im,km,lat,u1,v1,t1,q1,deltim, & end subroutine gwdc_run !> @} -! \brief Brief description of the subroutine -! -!> \section arg_table_gwdc_finalize Argument Table -!! subroutine gwdc_finalize() end subroutine gwdc_finalize @@ -1452,10 +1449,6 @@ module gwdc_post contains -! \brief Brief description of the subroutine -! -!> \section arg_table_gwdc_post_init Argument Table -!! subroutine gwdc_post_init() end subroutine gwdc_post_init @@ -1522,10 +1515,6 @@ subroutine gwdc_post_run( & end subroutine gwdc_post_run -! \brief Brief description of the subroutine -! -!> \section arg_table_gwdc_post_finalize Argument Table -!! subroutine gwdc_post_finalize() end subroutine gwdc_post_finalize diff --git a/physics/gwdc.meta b/physics/gwdc.meta index 5c3fa63d6..2fde9c2aa 100644 --- a/physics/gwdc.meta +++ b/physics/gwdc.meta @@ -138,6 +138,34 @@ kind = kind_phys intent = out optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-table-properties] + name = gwdc + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = gwdc_init + type = scheme [do_cnvgwd] standard_name = flag_for_convective_gravity_wave_drag long_name = flag for convective gravity wave drag (gwd) @@ -164,12 +192,6 @@ intent = out optional = F -######################################################################## -[ccpp-table-properties] - name = gwdc - type = scheme - dependencies = machine.F - ######################################################################## [ccpp-arg-table] name = gwdc_run @@ -630,4 +652,3 @@ type = integer intent = out optional = F - diff --git a/physics/gwdps.f b/physics/gwdps.f index b09413f02..c6d9ab584 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -7,8 +7,6 @@ module gwdps contains -!> \section arg_table_gwdps_init Argument Table -!! subroutine gwdps_init() end subroutine gwdps_init @@ -1309,9 +1307,6 @@ subroutine gwdps_run( & end subroutine gwdps_run !> @} -! -!> \section arg_table_gwdps_finalize Argument Table -!! subroutine gwdps_finalize() end subroutine gwdps_finalize diff --git a/physics/h2ophys.f b/physics/h2ophys.f index b3bdd279f..8222638ae 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -12,10 +12,6 @@ module h2ophys contains -! \brief Brief description of the subroutine -! -!> \section arg_table_h2ophys_init Argument Table -!! subroutine h2ophys_init() end subroutine h2ophys_init @@ -136,10 +132,6 @@ subroutine h2ophys_run(im, levs, kh2o, dt, h2o, ph2o, prsl, & end subroutine h2ophys_run !> @} -! \brief Brief description of the subroutine -! -!> \section arg_table_h2ophys_finalize Argument Table -!! subroutine h2ophys_finalize() end subroutine h2ophys_finalize diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 69690d52e..77b51ed62 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -95,10 +95,6 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, end subroutine m_micro_init -! \brief Brief description of the subroutine -! -!> \section arg_table_m_micro_finalize Argument Table -!! subroutine m_micro_finalize end subroutine m_micro_finalize diff --git a/physics/m_micro_interstitial.F90 b/physics/m_micro_interstitial.F90 index 930b32b3d..55b2bbe93 100644 --- a/physics/m_micro_interstitial.F90 +++ b/physics/m_micro_interstitial.F90 @@ -7,20 +7,14 @@ module m_micro_pre contains -! \brief Brief description of the subroutine -! -!> \section arg_table_m_micro_pre_init Argument Table -!! subroutine m_micro_pre_init() end subroutine m_micro_pre_init ! \brief Brief description of the subroutine !! -#if 0 !! \section arg_table_m_micro_pre_run Argument Table !! \htmlinclude m_micro_pre_run.html !! -#endif subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq0_ice, gq0_water, gq0_rain, & gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, gq0_graupel_nc, cld_shoc, cnvc, cnvw, tcr, tcrf, gt0, & qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, clw_water, clw_ice, clcn, errmsg, errflg ) @@ -143,10 +137,6 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq end subroutine m_micro_pre_run -! \brief Brief description of the subroutine -! -!> \section arg_table_m_micro_pre_finalize Argument Table -!! subroutine m_micro_pre_finalize () end subroutine m_micro_pre_finalize @@ -160,10 +150,6 @@ module m_micro_post contains -! \brief Brief description of the subroutine -! -!> \section arg_table_m_micro_post_init Argument Table -!! subroutine m_micro_post_init() end subroutine m_micro_post_init @@ -285,10 +271,6 @@ subroutine m_micro_post_run( & end subroutine m_micro_post_run -! \brief Brief description of the subroutine -! -!> \section arg_table_m_micro_post_finalize Argument Table -!! subroutine m_micro_post_finalize() end subroutine m_micro_post_finalize diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index 95e521141..0330afe47 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -393,8 +393,6 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & end subroutine mp_fer_hires_run -!> \section arg_table_mp_fer_hires_finalize Argument Table -!! subroutine mp_fer_hires_finalize () end subroutine mp_fer_hires_finalize diff --git a/physics/ozphys.f b/physics/ozphys.f index f8da58760..3d3c1d004 100644 --- a/physics/ozphys.f +++ b/physics/ozphys.f @@ -31,14 +31,9 @@ subroutine ozphys_init(oz_phys, errmsg, errflg) end subroutine ozphys_init -! \brief Brief description of the subroutine -! -!> \section arg_table_ozphys_finalize Argument Table -!! subroutine ozphys_finalize() end subroutine ozphys_finalize - !>\defgroup GFS_ozphys GFS ozphys Main !! \brief The operational GFS currently parameterizes ozone production and !! destruction based on monthly mean coefficients (\c global_o3prdlos.f77) provided by Naval diff --git a/physics/ozphys_2015.f b/physics/ozphys_2015.f index 238a8fb21..cc60ed2b4 100644 --- a/physics/ozphys_2015.f +++ b/physics/ozphys_2015.f @@ -29,14 +29,9 @@ subroutine ozphys_2015_init(oz_phys_2015, errmsg, errflg) end subroutine ozphys_2015_init -! \brief Brief description of the subroutine -! -!> \section arg_table_ozphys_2015_finalize Argument Table -!! subroutine ozphys_2015_finalize() end subroutine ozphys_2015_finalize - !>\defgroup GFS_ozphys_2015 GFS Ozone Photochemistry (2015) Scheme Module !! \brief The operational GFS currently parameterizes ozone production and !! destruction based on monthly mean coefficients ( diff --git a/physics/precpd.f b/physics/precpd.f index 0e330558b..c64474c01 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -6,10 +6,6 @@ module zhaocarr_precpd contains -!! \brief Brief description of the subroutine -!! -!! \section arg_table_zhaocarr_precpd_init Argument Table -!! subroutine zhaocarr_precpd_init () end subroutine zhaocarr_precpd_init @@ -702,10 +698,7 @@ subroutine zhaocarr_precpd_run (im,km,dt,del,prsl,q,cwm,t,rn & end subroutine zhaocarr_precpd_run !> @} -!! \section arg_table_zhaocarr_precpd_finalize Argument Table -!! subroutine zhaocarr_precpd_finalize end subroutine zhaocarr_precpd_finalize - end module zhaocarr_precpd diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 47d852031..48e7b8581 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -217,7 +217,7 @@ standard_name = cloud_overlap_decorrelation_parameter long_name = cloud overlap decorrelation parameter units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index 3b94dc19b..b2f1b5eec 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -244,7 +244,7 @@ standard_name = cloud_overlap_decorrelation_parameter long_name = cloud overlap decorrelation parameter units = frac - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys intent = in diff --git a/physics/rayleigh_damp.f b/physics/rayleigh_damp.f index a56a85e8c..8d05f8b0b 100644 --- a/physics/rayleigh_damp.f +++ b/physics/rayleigh_damp.f @@ -6,8 +6,6 @@ module rayleigh_damp contains -!> \section arg_table_rayleigh_damp_init Argument Table -!! subroutine rayleigh_damp_init () end subroutine rayleigh_damp_init @@ -135,11 +133,7 @@ subroutine rayleigh_damp_run ( & end subroutine rayleigh_damp_run !> @} - -!! \section arg_table_rayleigh_damp_finalize Argument Table -!! subroutine rayleigh_damp_finalize () end subroutine rayleigh_damp_finalize - end module rayleigh_damp diff --git a/physics/rrtmg_lw_post.F90 b/physics/rrtmg_lw_post.F90 index af83c5cc7..815de4975 100644 --- a/physics/rrtmg_lw_post.F90 +++ b/physics/rrtmg_lw_post.F90 @@ -5,17 +5,12 @@ module rrtmg_lw_post !>\defgroup rrtmg_lw_post GFS RRTMG scheme post !! @{ -!> \section arg_table_rrtmg_lw_post_init Argument Table -!! subroutine rrtmg_lw_post_init() end subroutine rrtmg_lw_post_init -! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing -#ifndef __PGI !> \section arg_table_rrtmg_lw_post_run Argument Table !! \htmlinclude rrtmg_lw_post_run.html !! -#endif subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & im, ltp, lm, kd, tsfa, htlwc, htlw0, errmsg, errflg) @@ -78,8 +73,6 @@ subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & end subroutine rrtmg_lw_post_run -!> \section arg_table_rrtmg_lw_post_finalize Argument Table -!! subroutine rrtmg_lw_post_finalize () end subroutine rrtmg_lw_post_finalize diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 7de02eed1..29a039a89 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -6,8 +6,6 @@ module rrtmg_lw_pre !>\defgroup rrtmg_lw_pre GFS RRTMG scheme pre !! @{ -!> \section arg_table_rrtmg_lw_pre_init Argument Table -!! subroutine rrtmg_lw_pre_init () end subroutine rrtmg_lw_pre_init @@ -49,8 +47,6 @@ subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa, errm end subroutine rrtmg_lw_pre_run -!> \section arg_table_rrtmg_lw_pre_finalize Argument Table -!! subroutine rrtmg_lw_pre_finalize () end subroutine rrtmg_lw_pre_finalize !! @} diff --git a/physics/rrtmg_sw_post.F90 b/physics/rrtmg_sw_post.F90 index b0ab31129..122b16b02 100644 --- a/physics/rrtmg_sw_post.F90 +++ b/physics/rrtmg_sw_post.F90 @@ -5,16 +5,12 @@ module rrtmg_sw_post !>\defgroup rrtmg_sw_post GFS RRTMG scheme post !! @{ -!> \section arg_table_rrtmg_sw_post_init Argument Table -!! subroutine rrtmg_sw_post_init () end subroutine rrtmg_sw_post_init -! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing -#ifndef __PGI + !> \section arg_table_rrtmg_sw_post_run Argument Table !! \htmlinclude rrtmg_sw_post_run.html !! -#endif subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & im, ltp, nday, lm, kd, htswc, htsw0, & sfcalb1, sfcalb2, sfcalb3, sfcalb4, scmpsw, errmsg, errflg) @@ -126,8 +122,6 @@ subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & end subroutine rrtmg_sw_post_run -!> \section arg_table_rrtmg_sw_post_finalize Argument Table -!! subroutine rrtmg_sw_post_finalize () end subroutine rrtmg_sw_post_finalize !! @} diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 5bdaab56b..25c4e34ba 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -6,8 +6,6 @@ module rrtmg_sw_pre !>\defgroup rrtmg_sw_pre GFS RRTMG scheme Pre !! @{ -!> \section arg_table_rrtmg_sw_pre_init Argument Table -!! subroutine rrtmg_sw_pre_init () end subroutine rrtmg_sw_pre_init @@ -104,8 +102,6 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & end subroutine rrtmg_sw_pre_run -!> \section arg_table_rrtmg_sw_pre_finalize Argument Table -!! subroutine rrtmg_sw_pre_finalize () end subroutine rrtmg_sw_pre_finalize diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 67576af15..7e31abd9c 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -10,18 +10,9 @@ module samfdeepcnv contains -!> \brief Brief description of the subroutine -!! -!! \section arg_table_samfdeepcnv_init Argument Table -!! subroutine samfdeepcnv_init() end subroutine samfdeepcnv_init - -!> \brief Brief description of the subroutine -!! -!! \section arg_table_samfdeepcnv_finalize Argument Table -!! subroutine samfdeepcnv_finalize() end subroutine samfdeepcnv_finalize diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index e48962822..ce6ae62c4 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -9,22 +9,12 @@ module samfshalcnv contains -!> \brief Brief description of the subroutine -!! -!! \section arg_table_samfshalcnv_init Argument Table -!! subroutine samfshalcnv_init() end subroutine samfshalcnv_init - -!> \brief Brief description of the subroutine -!! -!! \section arg_table_samfshalcnv_finalize Argument Table -!! subroutine samfshalcnv_finalize() end subroutine samfshalcnv_finalize - !> \defgroup SAMF_shal GFS Scale-Aware Mass-Flux Shallow Convection Scheme Module !! @{ !> \brief This subroutine contains the entirety of the SAMF shallow convection diff --git a/physics/sascnvn.F b/physics/sascnvn.F index ac59b9c5c..f9d91578b 100644 --- a/physics/sascnvn.F +++ b/physics/sascnvn.F @@ -44,11 +44,7 @@ subroutine sascnvn_init(imfdeepcnv,imfdeepcnv_sas,errmsg,errflg) ! end subroutine sascnvn_init -! \brief This subroutine is empty since there are no procedures that need to be done to finalize the sascnvn code. -!! -!! \section arg_table_sascnvn_finalize Argument Table -!! - subroutine sascnvn_finalize + subroutine sascnvn_finalize() end subroutine sascnvn_finalize !> \brief This subroutine contains the entirety of the SAS deep convection scheme. diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 5920f375c..9e6a1c0cc 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -8,15 +8,12 @@ module sfc_nst ! \brief This subroutine is empty since there are no procedures that need to be done to initialize the GFS NSST code. !! This subroutine is empty since there are no procedures that need to be done to initialize the GFS NSST code. -!! -!! \section arg_table_sfc_nst_init Argument Table !! subroutine sfc_nst_init end subroutine sfc_nst_init ! \brief This subroutine is empty since there are no procedures that need to be done to finalize the GFS NSST code. !! This subroutine is empty since there are no procedures that need to be done to finalize the GFS NSST code. -!! \section arg_table_sfc_nst_finalize Argument Table !! subroutine sfc_nst_finalize end subroutine sfc_nst_finalize @@ -658,14 +655,10 @@ module sfc_nst_pre !! The NSST scheme is one of the three schemes used to represent the !! surface in the GFS physics suite. The other two are the Noah land !! surface model and the sice simplified ice model. -!! -!! \section arg_table_sfc_nst_init Argument Table !! subroutine sfc_nst_pre_init end subroutine sfc_nst_pre_init -!! \section arg_table_sfc_nst_finalize Argument Table -!! subroutine sfc_nst_pre_finalize end subroutine sfc_nst_pre_finalize @@ -761,15 +754,11 @@ module sfc_nst_post ! \defgroup GFS_NSST_POST GFS Near-Surface Sea Temperature Post !! \brief Brief description of the parameterization -!! -!! \section arg_table_sfc_nst_post_init Argument Table !! subroutine sfc_nst_post_init end subroutine sfc_nst_post_init ! \brief Brief description of the subroutine -!! -!! \section arg_table_sfc_nst_post_finalize Argument Table !! subroutine sfc_nst_post_finalize end subroutine sfc_nst_post_finalize diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 20c8cdf02..8da60bb01 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -11,13 +11,9 @@ module sfc_ocean contains -!! \section arg_table_sfc_ocean_init Argument Table -!! subroutine sfc_ocean_init() end subroutine sfc_ocean_init -!! \section arg_table_sfc_ocean_finalize Argument Table -!! subroutine sfc_ocean_finalize() end subroutine sfc_ocean_finalize diff --git a/physics/shalcnv.F b/physics/shalcnv.F index 2a8918985..4cb485548 100644 --- a/physics/shalcnv.F +++ b/physics/shalcnv.F @@ -47,11 +47,7 @@ subroutine shalcnv_init(do_shoc,shal_cnv,imfshalcnv, & ! end subroutine shalcnv_init -! \brief This subroutine is empty since there are no procedures that need to be done to finalize the shalcnv code. -!! -!! \section arg_table_shalcnv_finalize Argument Table -!! - subroutine shalcnv_finalize + subroutine shalcnv_finalize() end subroutine shalcnv_finalize !> \brief This subroutine contains the entirety of the SAS shallow convection scheme. From a2728b5ee1ae08519a76155aa39f5d66aede55fc Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Tue, 6 Oct 2020 01:59:28 +0000 Subject: [PATCH 061/274] updating tasks 1 --- physics/unified_ugwp.meta | 6 ++++++ physics/unified_ugwp_post.meta | 6 ++++++ 2 files changed, 12 insertions(+) diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 23610f99c..038384044 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1,3 +1,9 @@ +[ccpp-table-properties] + name = unified_ugwp + type = scheme + dependencies = machine.F + +######################################################################## [ccpp-arg-table] name = unified_ugwp_init type = scheme diff --git a/physics/unified_ugwp_post.meta b/physics/unified_ugwp_post.meta index 807584e94..501e91b8f 100644 --- a/physics/unified_ugwp_post.meta +++ b/physics/unified_ugwp_post.meta @@ -1,3 +1,9 @@ +[ccpp-table-properties] + name = unified_ugwp_post + type = scheme + dependencies = machine.F + +######################################################################## [ccpp-arg-table] name = unified_ugwp_post_init type = scheme From 5aaa8db7889c9ac8f7bb41dcd0100c262276c86b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 5 Oct 2020 20:47:32 -0600 Subject: [PATCH 062/274] Add missing arguments to physics/GFS_rrtmg_pre.* after merge --- physics/GFS_rrtmg_pre.F90 | 11 ++++++----- physics/GFS_rrtmg_pre.meta | 26 ++++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 5 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 79f34bbce..5168f113b 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -22,10 +22,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ntclamt, nleffr, nieffr, nseffr, lndp_type, kdt, imp_physics, & imp_physics_thompson, imp_physics_gfdl, imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, imp_physics_mg, imp_physics_wsm6, & - imp_physics_fer_hires, lndp_var_list, lsswr, lslwr, & + imp_physics_fer_hires, julian, yearlen, lndp_var_list, lsswr, lslwr, & ltaerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf, lmfshal, & lmfdeep2, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & - rog, rocp, con_rd, xlat, xlon, coslat, sinlat, tsfc, slmsk, & + rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, tsfc, slmsk, & prsi, prsl, prslk, tgrs, sfc_wts, phy_f3d_mg_cld, phy_f3d_reffr, & phy_f3d_cnvw, phy_f3d_cnvc, qgrs, aer_nm, & !inputs from here and above coszen, coszdg, phy_f3d_leffr, phy_f3d_ieffr, phy_f3d_seffr, & @@ -83,7 +83,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, & imp_physics_mg, imp_physics_wsm6, & - imp_physics_fer_hires + imp_physics_fer_hires, & + yearlen character(len=3), dimension(:), intent(in) :: lndp_var_list @@ -91,10 +92,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & uni_cld, effr_in, do_mynnedmf, & lmfshal, lmfdeep2 - real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian real(kind=kind_phys), intent(in) :: eps, epsm1, fvirt, rog, rocp, con_rd - real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & + real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & coslat, sinlat, tsfc, & slmsk diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 6b6799314..49caca6a0 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -321,6 +321,23 @@ type = integer intent = in optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F [lndp_var_list] standard_name = variables_to_be_perturbed_for_landperts long_name = variables to be perturbed for landperts @@ -492,6 +509,15 @@ kind = kind_phys intent = in optional = F +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [xlat] standard_name = latitude long_name = latitude From 8ee53ccd15671deeb580cc4217b1fc0f48407b1c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 6 Oct 2020 14:56:14 -0600 Subject: [PATCH 063/274] Bugfixes in physics/GFS_rrtmg_pre.meta that creeped in during the merge --- physics/GFS_rrtmg_pre.meta | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index bdf873bab..e9b301d33 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -220,7 +220,7 @@ [nleffr] standard_name = index_for_cloud_liquid_water_effective_radius long_name = the index of cloud liquid water effective radius in phy_f3d - units = + units = index dimensions = () type = integer intent = in @@ -228,7 +228,7 @@ [nieffr] standard_name = index_for_ice_effective_radius long_name = the index of ice effective radius in phy_f3d - units = + units = index dimensions = () type = integer intent = in @@ -236,7 +236,7 @@ [nseffr] standard_name = index_for_snow_effective_radius long_name = the index of snow effective radius in phy_f3d - units = + units = index dimensions = () type = integer intent = in @@ -390,7 +390,7 @@ [effr_in] standard_name = flag_for_cloud_effective_radii long_name = flag for cloud effective radii calculations in GFDL microphysics - units = + units = flag dimensions = () type = logical intent = in @@ -665,7 +665,7 @@ [aer_nm] standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology long_name = GOCART aerosol climatology number concentration - units = kg-1? + units = kg-1 dimensions = (horizontal_loop_extent,vertical_dimension,number_of_aerosol_tracers_MG) type = real kind = kind_phys From 807dd0b0aa72d071451082144dac7218a7f0fb86 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 7 Oct 2020 08:55:55 -0600 Subject: [PATCH 064/274] Update HWRF physics (except FA) after merge, add CCPP dependencies to metadata --- physics/GFS_rrtmg_pre.F90 | 11 +++++++---- physics/GFS_rrtmg_setup.meta | 2 +- physics/gfdl_sfc_layer.meta | 10 ++++++++-- physics/radiation_clouds.f | 2 +- physics/sfc_noah_wrfv4.meta | 6 ++++++ physics/sfc_noah_wrfv4_interstitial.meta | 14 +++++++++++++- 6 files changed, 36 insertions(+), 9 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 3b57878bb..9852a77b8 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -172,6 +172,9 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDSW,NF_AESW) ::faersw real(kind=kind_phys), dimension(size(Grid%xlon,1),lm+LTP,NBDLW,NF_AELW) ::faerlw + integer :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte real(kind=kind_phys) :: qvs ! !===> ... begin here @@ -937,7 +940,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! clouds, cldsa, mtopa, mbota, de_lgth) ! --- outputs endif - elseif(Model%imp_physics == 6 .or. Model%imp_physics == 15) then + elseif(Model%imp_physics == 15) then if (Model%kdt == 1) then Tbd%phy_f3d(:,:,Model%nleffr) = 10. Tbd%phy_f3d(:,:,Model%nieffr) = 50. @@ -947,12 +950,12 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input call progcld5 (plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,tracer1, & ! --- inputs Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & +!mz ntsw-1,ntgl-1, & im, lmk, lmp, Model%icloud,Model%uni_cld, & Model%lmfshal,Model%lmfdeep2, & cldcov(:,1:LMK),Tbd%phy_f3d(:,:,1), & Tbd%phy_f3d(:,:,2), Tbd%phy_f3d(:,:,3), & - clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs - + clouds,cldsa,mtopa,mbota, de_lgth) ! --- outputs elseif(Model%imp_physics == Model%imp_physics_thompson) then ! Thompson MP @@ -975,7 +978,7 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input else ! MYNN PBL or GF convective are not used - call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs Grid%xlat,Grid%xlon,Sfcprop%slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index 8f7b650dc..03e2bd602 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,radlw_main.f,radlw_param.f,radsw_main.f,radsw_param.f + dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f ######################################################################## [ccpp-arg-table] diff --git a/physics/gfdl_sfc_layer.meta b/physics/gfdl_sfc_layer.meta index 5a245cd69..77024c813 100644 --- a/physics/gfdl_sfc_layer.meta +++ b/physics/gfdl_sfc_layer.meta @@ -1,3 +1,9 @@ +[ccpp-table-properties] + name = gfdl_sfc_layer + type = scheme + dependencies = machine.F,module_sf_exchcoef.f90,namelist_soilveg_ruc.F90,noahmp_tables.f90 + +######################################################################## [ccpp-arg-table] name = gfdl_sfc_layer_init type = scheme @@ -98,7 +104,7 @@ [xlat] standard_name = latitude long_name = latitude - units = radians + units = radian dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -107,7 +113,7 @@ [xlon] standard_name = longitude long_name = longitude - units = radians + units = radian dimensions = (horizontal_loop_extent) type = real kind = kind_phys diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index b9dc9f9da..9f80824f1 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -246,7 +246,7 @@ module module_radiation_clouds public progcld1, progcld2, progcld3, progcld4, progclduni, & & cld_init, progcld5, progcld6, progcld4o, cal_cldfra3, & & find_cloudLayers, adjust_cloudIce, adjust_cloudH2O, & - & adjust_cloudFinal, get_alpha_dcorr, get_alpha_exp + & adjust_cloudFinal, gethml, get_alpha_dcorr, get_alpha_exp ! ================= diff --git a/physics/sfc_noah_wrfv4.meta b/physics/sfc_noah_wrfv4.meta index 781a21d3b..1895c56bf 100644 --- a/physics/sfc_noah_wrfv4.meta +++ b/physics/sfc_noah_wrfv4.meta @@ -1,3 +1,9 @@ +[ccpp-table-properties] + name = sfc_noah_wrfv4 + type = scheme + dependencies = machine.F,module_sf_noahlsm_glacial_only.F90,module_sf_noahlsm.F90 + +######################################################################## [ccpp-arg-table] name = sfc_noah_wrfv4_init type = scheme diff --git a/physics/sfc_noah_wrfv4_interstitial.meta b/physics/sfc_noah_wrfv4_interstitial.meta index e993780fd..b6ebcfe39 100644 --- a/physics/sfc_noah_wrfv4_interstitial.meta +++ b/physics/sfc_noah_wrfv4_interstitial.meta @@ -1,3 +1,9 @@ +[ccpp-table-properties] + name = sfc_noah_wrfv4_pre + type = scheme + dependencies = machine.F + +######################################################################## [ccpp-arg-table] name = sfc_noah_wrfv4_pre_init type = scheme @@ -683,7 +689,13 @@ type = integer intent = out optional = F - + +######################################################################## +[ccpp-table-properties] + name = sfc_noah_wrfv4_post + type = scheme + dependencies = machine.F + ######################################################################## [ccpp-arg-table] name = sfc_noah_wrfv4_post_run From 06b7a076c76d777bce22ba80f817e756041b4a1d Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Wed, 7 Oct 2020 15:08:28 +0000 Subject: [PATCH 065/274] Updated unified_ugwp.meta to include dependencies. --- physics/unified_ugwp.meta | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 038384044..80a4f56d6 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1,7 +1,10 @@ [ccpp-table-properties] name = unified_ugwp type = scheme - dependencies = machine.F + dependencies = machine.F,cires_ugwp_module.F90,cires_ugwp_module_v1.F90,gwdps.f,drag_suite.F90 + dependencies = cires_ugwp_orolm97_v1.F90,cires_ugwp_triggers_v1.F90,cires_ugwp_solv2_v1_mod.F90 + dependencies = cires_ugwp_module.F90,cires_ugwp_module_v1.F90,cires_ugwp_initialize_v1.F90 + dependencies = cires_ugwp_initialize.F90,cires_orowam2017.F90,cires_vert_orodis_v1.F90 ######################################################################## [ccpp-arg-table] From 94aa9b1ce6b11e01ff526db070c5493ddc71ec4f Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Wed, 7 Oct 2020 18:00:55 +0000 Subject: [PATCH 066/274] Finalized unified_ugwp.meta dependencies --- physics/unified_ugwp.meta | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 80a4f56d6..96eb8b97e 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -3,8 +3,9 @@ type = scheme dependencies = machine.F,cires_ugwp_module.F90,cires_ugwp_module_v1.F90,gwdps.f,drag_suite.F90 dependencies = cires_ugwp_orolm97_v1.F90,cires_ugwp_triggers_v1.F90,cires_ugwp_solv2_v1_mod.F90 - dependencies = cires_ugwp_module.F90,cires_ugwp_module_v1.F90,cires_ugwp_initialize_v1.F90 - dependencies = cires_ugwp_initialize.F90,cires_orowam2017.F90,cires_vert_orodis_v1.F90 + dependencies = cires_ugwp_initialize_v1.F90,cires_ugwp_initialize.F90 + dependencies = cires_orowam2017.F90,cires_vert_orodis_v1.F90,cires_ugwp_utils.F90 + dependencies = cires_ugwp_triggers.F90,cires_ugwp_solvers.F90 ######################################################################## [ccpp-arg-table] From a33954bd628e4fb48643a12e244949e2ab5fd607 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 7 Oct 2020 14:48:40 -0600 Subject: [PATCH 067/274] Change names of phy_f3d variables in physics/GFS_rrtmg_pre.* --- physics/GFS_rrtmg_pre.F90 | 64 ++++++++++++++++++-------------------- physics/GFS_rrtmg_pre.meta | 14 ++++----- 2 files changed, 38 insertions(+), 40 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 5168f113b..1fcdd2a29 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -26,9 +26,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ltaerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf, lmfshal, & lmfdeep2, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, tsfc, slmsk, & - prsi, prsl, prslk, tgrs, sfc_wts, phy_f3d_mg_cld, phy_f3d_reffr, & - phy_f3d_cnvw, phy_f3d_cnvc, qgrs, aer_nm, & !inputs from here and above - coszen, coszdg, phy_f3d_leffr, phy_f3d_ieffr, phy_f3d_seffr, & + prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, & + cnvw_in, cnvc_in, qgrs, aer_nm, & !inputs from here and above + coszen, coszdg, effrl_inout, effri_inout, effrs_inout, & clouds1, clouds2, clouds3, clouds4, clouds5, & !in/out from here and above kd, kt, kb, mtopa, mbota, raddt, tsfg, tsfa, de_lgth, alb1d, delp, dz, & !output from here and below plvl, plyr, tlvl, tlyr, qlyr, olyr, gasvmr_co2, gasvmr_n2o, gasvmr_ch4,& @@ -101,18 +101,16 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, prslk, & tgrs, sfc_wts, & - phy_f3d_mg_cld, & - phy_f3d_reffr, & - phy_f3d_cnvw, & - phy_f3d_cnvc + mg_cld, effrr_in, & + cnvw_in, cnvc_in real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs, aer_nm real(kind=kind_phys), dimension(:), intent(inout) :: coszen, coszdg - real(kind=kind_phys), dimension(:,:), intent(inout) :: phy_f3d_leffr, & - phy_f3d_ieffr, & - phy_f3d_seffr + real(kind=kind_phys), dimension(:,:), intent(inout) :: effrl_inout, & + effri_inout, & + effrs_inout real(kind=kind_phys), dimension(im,lm+LTP), intent(inout) :: clouds1, & clouds2, clouds3, & clouds4, clouds5 @@ -683,18 +681,18 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do k=1,lm k1 = k + kd do i=1,im - cldcov(i,k1) = phy_f3d_mg_cld(i,k) - effrl(i,k1) = phy_f3d_leffr(i,k) - effri(i,k1) = phy_f3d_ieffr(i,k) - effrr(i,k1) = phy_f3d_reffr(i,k) - effrs(i,k1) = phy_f3d_seffr(i,k) + cldcov(i,k1) = mg_cld(i,k) + effrl(i,k1) = effrl_inout(i,k) + effri(i,k1) = effri_inout(i,k) + effrr(i,k1) = effrr_in(i,k) + effrs(i,k1) = effrs_inout(i,k) enddo enddo else do k=1,lm k1 = k + kd do i=1,im - cldcov(i,k1) = phy_f3d_mg_cld(i,k) + cldcov(i,k1) = mg_cld(i,k) enddo enddo endif @@ -720,10 +718,10 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do k=1,lm k1 = k + kd do i=1,im - effrl(i,k1) = phy_f3d_leffr(i,k) - effri(i,k1) = phy_f3d_ieffr(i,k) - effrr(i,k1) = phy_f3d_reffr(i,k) - effrs(i,k1) = phy_f3d_seffr(i,k) + effrl(i,k1) = effrl_inout(i,k) + effri(i,k1) = effri_inout(i,k) + effrr(i,k1) = effrr_in(i,k) + effrs(i,k1) = effrs_inout(i,k) ! if(me==0) then ! if(effrl(i,k1)> 5.0) then ! write(6,*) 'rad driver:cloud radii:',kdt, i,k1, & @@ -783,9 +781,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do k=1,lm k1 = k + kd do i=1,im - phy_f3d_leffr(i,k) = effrl(i,k1) - phy_f3d_ieffr(i,k) = effri(i,k1) - phy_f3d_seffr(i,k) = effrs(i,k1) + effrl_inout(i,k) = effrl(i,k1) + effri_inout(i,k) = effri(i,k1) + effrs_inout(i,k) = effrs(i,k1) enddo enddo else ! all other cases @@ -806,8 +804,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & !GJF: this is not consistent with GFS_typedefs, ! but it looks like the Zhao-Carr-PDF scheme is not in the CCPP deltaq(i,k1) = 0.0!Tbd%phy_f3d(i,k,5) !GJF: this variable is not in phy_f3d anymore - cnvw (i,k1) = phy_f3d_cnvw(i,k) - cnvc (i,k1) = phy_f3d_cnvc(i,k) + cnvw (i,k1) = cnvw_in(i,k) + cnvc (i,k1) = cnvc_in(i,k) enddo enddo elseif ((npdf3d == 0) .and. (ncnvcld3d == 1)) then ! same as imp_physics=99 @@ -815,7 +813,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & k1 = k + kd do i=1,im deltaq(i,k1) = 0.0 - cnvw (i,k1) = phy_f3d_cnvw(i,k) + cnvw (i,k1) = cnvw_in(i,k) cnvc (i,k1) = 0.0 enddo enddo @@ -904,9 +902,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & elseif(imp_physics == imp_physics_wsm6 .or. imp_physics == imp_physics_fer_hires) then if (kdt == 1) then - phy_f3d_leffr(:,:) = 10. - phy_f3d_ieffr(:,:) = 50. - phy_f3d_seffr(:,:) = 250. + effrl_inout(:,:) = 10. + effri_inout(:,:) = 50. + effrs_inout(:,:) = 250. endif call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs @@ -914,8 +912,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, & - cldcov(:,1:LMK),phy_f3d_leffr(:,:), & - phy_f3d_ieffr(:,:), phy_f3d_seffr(:,:), & + cldcov(:,1:LMK),effrl_inout(:,:), & + effri_inout(:,:), effrs_inout(:,:), & dzb, xlat_d, julian, yearlen, & clouds,cldsa,mtopa,mbota, de_lgth, alpha) ! --- outputs @@ -946,8 +944,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & im, lmk, lmp, uni_cld, lmfshal, lmfdeep2, & - cldcov(:,1:LMK), phy_f3d_leffr(:,:), & - phy_f3d_ieffr(:,:), phy_f3d_seffr(:,:), & + cldcov(:,1:LMK), effrl_inout(:,:), & + effri_inout(:,:), effrs_inout(:,:), & dzb, xlat_d, julian, yearlen, & clouds, cldsa, mtopa ,mbota, de_lgth, alpha) ! --- outputs endif ! MYNN PBL or GF diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index e9b301d33..0ffa78ee5 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -617,7 +617,7 @@ kind = kind_phys intent = in optional = F -[phy_f3d_mg_cld] +[mg_cld] standard_name = cloud_fraction_for_MG long_name = cloud fraction used by Morrison-Gettelman MP units = frac @@ -626,7 +626,7 @@ kind = kind_phys intent = in optional = F -[phy_f3d_reffr] +[effrr_in] standard_name = effective_radius_of_stratiform_cloud_rain_particle_in_um long_name = effective radius of cloud rain particle in micrometers units = um @@ -635,7 +635,7 @@ kind = kind_phys intent = in optional = F -[phy_f3d_cnvw] +[cnvw_in] standard_name = convective_cloud_water_mixing_ratio_in_phy_f3d long_name = convective cloud water mixing ratio in the phy_f3d array units = kg kg-1 @@ -644,7 +644,7 @@ kind = kind_phys intent = in optional = F -[phy_f3d_cnvc] +[cnvc_in] standard_name = convective_cloud_cover_in_phy_f3d long_name = convective cloud cover in the phy_f3d array units = frac @@ -689,7 +689,7 @@ kind = kind_phys intent = inout optional = F -[phy_f3d_leffr] +[effrl_inout] standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer units = um @@ -698,7 +698,7 @@ kind = kind_phys intent = inout optional = F -[phy_f3d_ieffr] +[effri_inout] standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer units = um @@ -707,7 +707,7 @@ kind = kind_phys intent = inout optional = F -[phy_f3d_seffr] +[effrs_inout] standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers units = um From d6cd89caf61195be12d480ef0c1b6c03ea48cadc Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Thu, 8 Oct 2020 03:20:40 +0000 Subject: [PATCH 068/274] Another unified_ugwp.meta bugfix --- physics/unified_ugwp.meta | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 96eb8b97e..28aa196d3 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1,11 +1,13 @@ [ccpp-table-properties] name = unified_ugwp type = scheme - dependencies = machine.F,cires_ugwp_module.F90,cires_ugwp_module_v1.F90,gwdps.f,drag_suite.F90 - dependencies = cires_ugwp_orolm97_v1.F90,cires_ugwp_triggers_v1.F90,cires_ugwp_solv2_v1_mod.F90 - dependencies = cires_ugwp_initialize_v1.F90,cires_ugwp_initialize.F90 - dependencies = cires_orowam2017.F90,cires_vert_orodis_v1.F90,cires_ugwp_utils.F90 - dependencies = cires_ugwp_triggers.F90,cires_ugwp_solvers.F90 + dependencies = machine.F,cires_ugwp_module.F90,ugwp_driver_v0.F,cires_ugwp_triggers.F90 + dependencies = cires_ugwp_initialize.F90,cires_ugwp_solvers.F90,cires_ugwp_utils.F90 + dependencies = cires_orowam2017.f,cires_vert_lsatdis.F90,cires_vert_orodis.F90 + dependencies = cires_vert_wmsdis.F90,cires_ugwp_module_v1.F90,cires_ugwp_triggers_v1.F90 + dependencies = cires_ugwp_initialize_v1.F90,cires_ugwp_solv2_v1_mod.F90 + dependencies = cires_ugwp_orolm97_v1.F90,cires_orowam2017.F90,cires_vert_orodis_v1.F90 + dependencies = gwdps.f,drag_suite.F90 ######################################################################## [ccpp-arg-table] From 2ad28e61cf226a86dc006fceeec1130f1f629094 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 10 Oct 2020 15:08:54 -0600 Subject: [PATCH 069/274] Apply boundds to znt_ocn in physics/gfdl_sfc_layer.F90 before trying to divide by it --- physics/gfdl_sfc_layer.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/physics/gfdl_sfc_layer.F90 b/physics/gfdl_sfc_layer.F90 index 6bd969ac3..b74d16161 100644 --- a/physics/gfdl_sfc_layer.F90 +++ b/physics/gfdl_sfc_layer.F90 @@ -617,6 +617,9 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & !GJF: or WRF module_sf_gfdl.F: !tstrc(i) = tskin_ocn(i) + ! DH* 20201009: these bounds on ocean roughness lengths are from Chunxi Zhang's module_sf_sfclayrev.f90 (in cm) + znt_ocn(i)=min(2.85e-1,max(znt_ocn(i),1.27e-5)) + !GJF: from WRF's module_sf_gfdl.F if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then wind10(i)=wspd(i)*alog(10.0/(0.01*znt_ocn(i)))/alog(z1(i)/(0.01*znt_ocn(i))) From fce80a170a02f85c0ced5412768a5badb2090133 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 10 Oct 2020 15:14:54 -0600 Subject: [PATCH 070/274] physics/module_mp_thompson.F90: adjust lower bounds of cloud effective radii to work with HWRF RRTMG settings --- physics/module_mp_thompson.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 304afc6d5..5c2a2acb5 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1452,17 +1452,17 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & IF (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) THEN do k = kts, kte - re_qc1d(k) = 2.49E-6 - re_qi1d(k) = 4.99E-6 - re_qs1d(k) = 9.99E-6 + re_qc1d(k) = 2.50E-6 ! 2.49E-6 + re_qi1d(k) = 5.00E-6 ! 4.99E-6 + re_qs1d(k) = 1.00E-5 ! 9.99E-6 enddo !> - Call calc_effectrad() call calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & re_qc1d, re_qi1d, re_qs1d, kts, kte) do k = kts, kte - re_cloud(i,k,j) = MAX(2.49E-6, MIN(re_qc1d(k), 50.E-6)) - re_ice(i,k,j) = MAX(4.99E-6, MIN(re_qi1d(k), 125.E-6)) - re_snow(i,k,j) = MAX(9.99E-6, MIN(re_qs1d(k), 999.E-6)) + re_cloud(i,k,j) = MAX(2.50E-6, MIN(re_qc1d(k), 50.E-6)) ! MAX(2.49E-6, MIN(re_qc1d(k), 50.E-6)) + re_ice(i,k,j) = MAX(5.00E-6, MIN(re_qi1d(k), 125.E-6)) ! MAX(4.99E-6, MIN(re_qi1d(k), 125.E-6)) + re_snow(i,k,j) = MAX(1.00E-5, MIN(re_qs1d(k), 999.E-6)) ! MAX(9.99E-6, MIN(re_qs1d(k), 999.E-6)) enddo ENDIF @@ -5277,9 +5277,9 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & ! as before this change, use the WRF v3.8.1 settings throughout. #if 1 !ifdef WRF381 - re_qc1d(:) = 2.49E-6 - re_qi1d(:) = 4.99E-6 - re_qs1d(:) = 9.99E-6 + re_qc1d(:) = 2.50E-6 ! 2.49E-6 + re_qi1d(:) = 5.00E-6 ! 4.99E-6 + re_qs1d(:) = 1.00E-5 ! 9.99E-6 #else re_qc1d(:) = 2.49E-6 re_qi1d(:) = 2.49E-6 @@ -5375,7 +5375,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & smoc = a_ * smo2**b_ #if 1 !ifdef WRF381 - re_qs1d(k) = MAX(10.E-6, MIN(0.5*(smoc/smob), 999.E-6)) + re_qs1d(k) = MAX(1.01E-5, MIN(0.5*(smoc/smob), 999.E-6)) #else re_qs1d(k) = MAX(5.01E-6, MIN(0.5*(smoc/smob), 999.E-6)) #endif From 030dcfd2cb3fd95a38c7f720d300af13543e635c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 10 Oct 2020 15:17:00 -0600 Subject: [PATCH 071/274] Add CCPP dependencies to physics/radlw_main.meta and physics/radsw_main.meta; remove trailing whitespaces in physics/mp_fer_hires.F90 --- physics/mp_fer_hires.F90 | 46 ++++++++++++++++++++-------------------- physics/radlw_main.meta | 2 +- physics/radsw_main.meta | 2 +- 3 files changed, 25 insertions(+), 25 deletions(-) diff --git a/physics/mp_fer_hires.F90 b/physics/mp_fer_hires.F90 index cebf53b74..576f7fdab 100644 --- a/physics/mp_fer_hires.F90 +++ b/physics/mp_fer_hires.F90 @@ -1,9 +1,9 @@ !>\file mp_fer_hires.F90 -!! This file contains the Ferrier-Aligo microphysics scheme driver. +!! This file contains the Ferrier-Aligo microphysics scheme driver. ! module mp_fer_hires - + use machine, only : kind_phys use module_mp_fer_hires, only : ferrier_init_hr, FER_HIRES, & @@ -12,11 +12,11 @@ module mp_fer_hires implicit none public :: mp_fer_hires_init, mp_fer_hires_run, mp_fer_hires_finalize - + private logical :: is_initialized = .False. - + ! * T_ICE - temperature (C) threshold at which all remaining liquid water ! is glaciated to ice ! * T_ICE_init - maximum temperature (C) at which ice nucleation occurs @@ -66,7 +66,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & ! Initialize the CCPP error handling variables errmsg = '' errflg = 0 - + if (is_initialized) return ! Set internal dimensions @@ -74,7 +74,7 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & ime = ncol lm = nlev - ! MZ* temporary + ! MZ* temporary if (mpirank==mpiroot) then write(0,*) ' -----------------------------------------------' write(0,*) ' --- !!! WARNING !!! ---' @@ -90,9 +90,9 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & errflg = 1 return end if - + !MZ: fer_hires_init() in HWRF - if (mpirank==mpiroot) write (0,*) 'F-A: F_ICE,F_RAIN AND F_RIMEF IS REINITIALIZED' + if (mpirank==mpiroot) write (0,*) 'F-A: F_ICE, F_RAIN AND F_RIMEF ARE REINITIALIZED' DO K = 1,lm DO I= ims,ime F_ICE(i,k)=0. @@ -101,16 +101,16 @@ subroutine mp_fer_hires_init(ncol, nlev, dtp, imp_physics, & ENDDO ENDDO !MZ: fer_hires_init() in HWRF - + if (mpirank==mpiroot) write (0,*) 'F-A: calling FERRIER_INIT_HR ...' CALL FERRIER_INIT_HR(dtp,mpicomm,mpirank,mpiroot,threads,errmsg,errflg) if (mpirank==mpiroot) write (0,*)'F-A: FERRIER_INIT_HR finished ...' if (errflg /= 0 ) return - + is_initialized = .true. - + end subroutine mp_fer_hires_init !>\defgroup hafs_famp HWRF Ferrier-Aligo Microphysics Scheme @@ -124,8 +124,8 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ,T,Q,CWM & ,TRAIN,SR & ,F_ICE,F_RAIN,F_RIMEF & - ,QC,QR,QI,QG & - ,PREC & + ,QC,QR,QI,QG & + ,PREC & ,mpirank, mpiroot, threads & ,refl_10cm & ,RHGRD,dx & @@ -162,7 +162,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & real(kind_phys), intent(inout) :: train(1:ncol,1:nlev) real(kind_phys), intent(out ) :: sr(1:ncol) real(kind_phys), intent(inout) :: f_ice(1:ncol,1:nlev) - real(kind_phys), intent(inout) :: f_rain(1:ncol,1:nlev) + real(kind_phys), intent(inout) :: f_rain(1:ncol,1:nlev) real(kind_phys), intent(inout) :: f_rimef(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qc(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qr(1:ncol,1:nlev) @@ -205,7 +205,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & write(errmsg, fmt='((a))') 'mp_fer_hires_run called before mp_fer_hires_init' errflg = 1 return - end if + end if ! Set internal dimensions ims = 1 @@ -248,7 +248,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !----------------------------------------------------------------------- ! DO K=LM,1,-1 !mz* We are moving down from the top in the flipped arrays - + !*** CALL MICROPHYSICS !MZ* in HWRF @@ -274,8 +274,8 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !--------------------------------------------------------------------- !aligo - DO K = 1, LM - DO I= IMS, IME + DO K = 1, LM + DO I= IMS, IME cwm(i,k) = cwm(i,k)/(1.0_kind_phys-q(i,k)) qr(i,k) = qr(i,k)/(1.0_kind_phys-q(i,k)) qi(i,k) = qi(i,k)/(1.0_kind_phys-q(i,k)) @@ -284,7 +284,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ENDDO !aligo !--------------------------------------------------------------------- - + CALL FER_HIRES( & DT=DT,RHgrd=RHGRD & ,PRSI=prsi,P_PHY=p_phy,T_PHY=t & @@ -311,7 +311,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & qi(i,k) = qi(i,k)/(1.0_kind_phys+q(i,k)) qr(i,k) = qr(i,k)/(1.0_kind_phys+q(i,k)) ENDDO - ENDDO + ENDDO !----------------------------------------------------------- DO K=1,LM @@ -321,7 +321,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & !*** Calculate graupel from total ice array and rime factor !--------------------------------------------------------------------- -!MZ +!MZ IF (SPEC_ADV) then QG(I,K)=QI(I,K)*F_RIMEF(I,K) ENDIF @@ -345,7 +345,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & DO I=IMS,IME PCPCOL=RAINNCV(I)*1.E-3 !MZ:unit:m PREC(I)=PREC(I)+PCPCOL -!MZ ACPREC(I)=ACPREC(I)+PCPCOL !MZ: not used +!MZ ACPREC(I)=ACPREC(I)+PCPCOL !MZ: not used ! ! NOTE: RAINNC IS ACCUMULATED INSIDE MICROPHYSICS BUT NMM ZEROES IT OUT ABOVE ! SINCE IT IS ONLY A LOCAL ARRAY FOR NOW @@ -353,7 +353,7 @@ SUBROUTINE mp_fer_hires_run(NCOL, NLEV, DT ,SPEC_ADV & ENDDO !----------------------------------------------------------------------- ! - end subroutine mp_fer_hires_run + end subroutine mp_fer_hires_run !> \section arg_table_mp_fer_hires_finalize Argument Table diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index d857f665b..ef7d72c9b 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_lw type = scheme - dependencies = mersenne_twister.f,physcons.F90,physparam.f,radlw_datatb.f,radlw_param.f + dependencies = mersenne_twister.f,physcons.F90,physparam.f,radlw_datatb.f,radlw_param.f,HWRF_mcica_random_numbers.F90,HWRF_mersenne_twister.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index 9a8b1ce91..d32688ad1 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmg_sw type = scheme - dependencies = mersenne_twister.f,physcons.F90,physparam.f,radsw_datatb.f,radsw_param.f + dependencies = mersenne_twister.f,physcons.F90,physparam.f,radsw_datatb.f,radsw_param.f,HWRF_mcica_random_numbers.F90,HWRF_mersenne_twister.F90 ######################################################################## [ccpp-arg-table] From 3c012843dc5626377313af4748d29e6facc923dd Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 10 Oct 2020 15:17:24 -0600 Subject: [PATCH 072/274] Bugfix in physics/samfdeepcnv.f for uninitialized variable crtlame --- physics/samfdeepcnv.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 67576af15..47ffbb1c3 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -423,10 +423,10 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & cxlamu = 1.0e-3 else aafac = .05 - crtlame = 1.0e-4 cxlame = 1.0e-4 endif crtlamd = 1.0e-4 + crtlame = 1.0e-4 cxlamd = 1.0e-4 xlamde = 1.0e-4 xlamdd = 1.0e-4 From afa335fcaaee3722183056165cfd240153f5dfa6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 10 Oct 2020 15:19:19 -0600 Subject: [PATCH 073/274] physics/module_MP_FER_HIRES.F90: bugfixes for MPI calls in init routine --- physics/module_MP_FER_HIRES.F90 | 65 +++++++++++++++------------------ 1 file changed, 29 insertions(+), 36 deletions(-) diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index 776898f93..092a2f941 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -2405,7 +2405,7 @@ END SUBROUTINE EGCP01COLUMN_hr !----------------------------------------------------------------------- !>\ingroup hafs_famp - SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & + SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MPIRANK,MPIROOT,THREADS, & errmsg,errflg) !----------------------------------------------------------------------- !------------------------------------------------------------------------------- @@ -2463,7 +2463,7 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & ! ! VARIABLES PASSED IN REAL, INTENT(IN) :: GSMDT - INTEGER, INTENT(IN) :: MYPE + INTEGER, INTENT(IN) :: MPIRANK INTEGER, INTENT(IN) :: MPIROOT INTEGER, INTENT(IN) :: MPI_COMM_COMP INTEGER, INTENT(IN) :: THREADS @@ -2479,21 +2479,18 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & LOGICAL :: opened INTEGER :: IRTN,rc CHARACTER*80 errmess - INTEGER :: mpi_communicator,ierr - INTEGER :: good + INTEGER :: ierr, good LOGICAL :: lexist,lopen, force_read_ferhires ! !----------------------------------------------------------------------- ! - ! Assign mpicomm to module variable - mpi_communicator= mpi_comm_comp - DTPH=GSMDT !-- Time step in s + DTPH=GSMDT !-- Time step in s ! !--- Create lookup tables for saturation vapor pressure w/r/t water & ice ! - CALL GPVS_hr + CALL GPVS_hr ! !zhang: if (.NOT. ALLOCATED(ventr1)) ALLOCATE(ventr1(MDRmin:MDRmax)) @@ -2509,16 +2506,15 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & if (.NOT. ALLOCATED(vsnowi)) ALLOCATE(vsnowi(MDImin:MDImax)) if (.NOT. ALLOCATED(vel_rf)) ALLOCATE(vel_rf(2:9,0:Nrime)) +#ifdef MPI + call MPI_BARRIER(MPI_COMM_COMP,ierr) +#endif - + only_root_reads: if (MPIRANK==MPIROOT) then force_read_ferhires = .true. good = 0 INQUIRE(FILE="DETAMPNEW_DATA.expanded_rain_LE",EXIST=lexist) -#ifdef MPI - call MPI_BARRIER(mpi_communicator,ierr) -#endif - IF (lexist) THEN OPEN(63,FILE="DETAMPNEW_DATA.expanded_rain_LE", & & FORM="UNFORMATTED",STATUS="OLD",ERR=1234) @@ -2543,17 +2539,19 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & INQUIRE(63,opened=lopen) IF (lopen) THEN IF( force_read_ferhires ) THEN - write(0,*) "Error reading DETAMPNEW_DATA.expanded_rain_LE. Aborting because force_read_ferhires is .true." + errmsg = "Error reading DETAMPNEW_DATA.expanded_rain_LE. Aborting because force_read_ferhires is .true." + errflg = 1 return ENDIF CLOSE(63) ELSE IF( force_read_ferhires ) THEN - write(0,*) "Error opening DETAMPNEW_DATA.expanded_rain_LE. Aborting because force_read_ferhires is .true." + errmsg = "Error opening DETAMPNEW_DATA.expanded_rain_LE. Aborting because force_read_ferhires is .true." + errflg = 1 return ENDIF ENDIF - ELSE + ELSE INQUIRE(63,opened=lopen) IF (lopen) THEN CLOSE(63) @@ -2561,25 +2559,26 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & ENDIF ELSE IF( force_read_ferhires ) THEN - write(0,*) "Non-existent DETAMPNEW_DATA.expanded_rain_LE. Aborting because force_read_ferhires is .true." + errmsg = "Non-existent DETAMPNEW_DATA.expanded_rain_LE. Aborting because force_read_ferhires is .true." + errflg = 1 return ENDIF ENDIF - + endif only_root_reads ! #ifdef MPI - CALL MPI_BCAST(VENTR1,SIZE(VENTR1),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(VENTR2,SIZE(VENTR2),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(ACCRR,SIZE(ACCRR) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(MASSR,SIZE(MASSR) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(VRAIN,SIZE(VRAIN) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(RRATE,SIZE(RRATE) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(VENTI1,SIZE(VENTI1),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(VENTI2,SIZE(VENTI2),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(ACCRI,SIZE(ACCRI) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(MASSI,SIZE(MASSI) ,MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(VSNOWI,SIZE(VSNOWI),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) - CALL MPI_BCAST(VEL_RF,SIZE(VEL_RF),MPI_DOUBLE_PRECISION,0,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(VENTR1,SIZE(VENTR1),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(VENTR2,SIZE(VENTR2),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(ACCRR, SIZE(ACCRR), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(MASSR, SIZE(MASSR), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(VRAIN, SIZE(VRAIN), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(RRATE, SIZE(RRATE), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(VENTI1,SIZE(VENTI1),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(VENTI2,SIZE(VENTI2),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(ACCRI, SIZE(ACCRI), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(MASSI, SIZE(MASSI), MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(VSNOWI,SIZE(VSNOWI),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) + CALL MPI_BCAST(VEL_RF,SIZE(VEL_RF),MPI_DOUBLE_PRECISION,MPIROOT,MPI_COMM_COMP,IRTN) #endif ! @@ -2721,12 +2720,6 @@ SUBROUTINE FERRIER_INIT_hr (GSMDT,MPI_COMM_COMP,MYPE,mpiroot,THREADS, & RETURN ! -!----------------------------------------------------------------------- -! -9061 CONTINUE - WRITE(0,*)' module_mp_etanew: error opening ETAMPNEW_DATA.expanded_rain on unit ',etampnew_unit1 - STOP -! !----------------------------------------------------------------------- END SUBROUTINE FERRIER_INIT_hr ! From b871fb9287a13bdef8047ee143e700e49a369a82 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 10 Oct 2020 15:34:31 -0600 Subject: [PATCH 074/274] Remove trailing whitespaces from physics/gfdl_sfc_layer.F90 --- physics/gfdl_sfc_layer.F90 | 366 ++++++++++++++++++------------------- 1 file changed, 183 insertions(+), 183 deletions(-) diff --git a/physics/gfdl_sfc_layer.F90 b/physics/gfdl_sfc_layer.F90 index b74d16161..93e38c982 100644 --- a/physics/gfdl_sfc_layer.F90 +++ b/physics/gfdl_sfc_layer.F90 @@ -16,57 +16,57 @@ module gfdl_sfc_layer !> \section arg_table_gfdl_sfc_layer_init Argument Table !! \htmlinclude gfdl_sfc_layer_init.html -!! +!! subroutine gfdl_sfc_layer_init (icoef_sf, cplwav, cplwav2atm, lcurr_sf, & pert_cd, ntsflg, errmsg, errflg) - + implicit none - + integer, intent(in) :: icoef_sf, ntsflg logical, intent(in) :: cplwav, cplwav2atm, lcurr_sf, pert_cd - + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + #if HWRF==1 write(errmsg,'(*(a))') 'The GFDL surface layer scheme does not support '& //'use of the HWRF preprocessor flag in gfdl_sfc_layer.F90' errflg = 1 return -#endif - +#endif + if (icoef_sf < 0 .or. icoef_sf > 8) then write(errmsg,'(*(a))') 'The value of icoef_sf is outside of the ' & //'supported range (0-8) in gfdl_sfc_layer.F90' errflg = 1 return end if - + if (cplwav .or. cplwav2atm) then write(errmsg,'(*(a))') 'The GFDL surface layer scheme is not set up ' & //'to be coupled to waves in gfdl_sfc_layer.F90' errflg = 1 return end if - + if (lcurr_sf) then write(errmsg,'(*(a))') 'The GFDL surface layer scheme is not set up ' & //'to be used with the lcurr_sf option in gfdl_sfc_layer.F90' errflg = 1 return end if - + if (pert_cd) then write(errmsg,'(*(a))') 'The GFDL surface layer scheme is not set up ' & //'to be used with the pert_cd option in gfdl_sfc_layer.F90' errflg = 1 return end if - + if (ntsflg > 0) then !GJF: In order to enable ntsflg > 0, the variable 'tstrc' passed into MFLUX2 should be set ! to the surface_skin_temperature_over_X_interstitial rather than the average of it and @@ -75,8 +75,8 @@ subroutine gfdl_sfc_layer_init (icoef_sf, cplwav, cplwav2atm, lcurr_sf, & //' in gfdl_sfc_layer.F90' errflg = 1 return - end if - + end if + !GJF: Initialization notes: In WRF, the subroutine module_sf_myjsfc/myjsfcinit ! is called for initialization of the GFDL surface layer scheme from ! the module_physics_init subroutine. It contains the following @@ -90,7 +90,7 @@ subroutine gfdl_sfc_layer_init (icoef_sf, cplwav, cplwav2atm, lcurr_sf, & ! ENDDO ! ENDIF !also initialize surface roughness length - + end subroutine gfdl_sfc_layer_init subroutine gfdl_sfc_layer_finalize () @@ -99,7 +99,7 @@ end subroutine gfdl_sfc_layer_finalize !> \section arg_table_gfdl_sfc_layer_run Argument Table !! \htmlinclude gfdl_sfc_layer_run.html !! - subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & + subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & lsm_noah, lsm_noahmp, lsm_ruc, lsm_noah_wrfv4, icoef_sf, cplwav, & cplwav2atm, lcurr_sf, pert_Cd, ntsflg, sfenth, z1, shdmax, ivegsrc, & vegtype, sigmaf, dt, wet, dry, icy, isltyp, rd, grav, ep1, ep2, smois, & @@ -110,9 +110,9 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & fm_ocn, fm_lnd, fm_ice, fh_ocn, fh_lnd, fh_ice, fh2_ocn, fh2_lnd, & fh2_ice, ch_ocn, ch_lnd, ch_ice, fm10_ocn, fm10_lnd, fm10_ice, qss_ocn, & qss_lnd, qss_ice, errmsg, errflg) - + use funcphys, only: fpvs - + !#### GJF: temporarily grab parameters from LSM-specific modules -- should go through CCPP #### ! (fixing this involves replacing the functionality of set_soilveg and namelist_soilveg) use namelist_soilveg, only: maxsmc_noah => maxsmc, drysmc_noah => drysmc @@ -120,7 +120,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & use noahmp_tables, only: maxsmc_noahmp => smcmax_table, drysmc_noahmp => smcdry_table use module_sf_noahlsm, only: maxsmc_noah_wrfv4 => maxsmc, drysmc_noah_wrfv4 => drysmc !################################################################################################ - + implicit none integer, intent(in) :: im, nsoil, km, ivegsrc @@ -138,53 +138,53 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & real(kind=kind_phys), dimension(im), intent(in) :: psfc, prsl1, & q1, t1, u1, v1, wspd, u10, v10, gsw, glw, z1, shdmax, sigmaf, xlat, & xlon, tsurf_ocn, tsurf_lnd, tsurf_ice - - real(kind=kind_phys), intent(inout), dimension(im) :: tskin_ocn, & + + real(kind=kind_phys), intent(inout), dimension(im) :: tskin_ocn, & tskin_lnd, tskin_ice, ustar_ocn, ustar_lnd, ustar_ice, & znt_ocn, znt_lnd, znt_ice, cdm_ocn, cdm_lnd, cdm_ice, & stress_ocn, stress_lnd, stress_ice, rib_ocn, rib_lnd, rib_ice, & fm_ocn, fm_lnd, fm_ice, fh_ocn, fh_lnd, fh_ice, fh2_ocn, fh2_lnd, & fh2_ice, ch_ocn, ch_lnd, ch_ice, fm10_ocn, fm10_lnd, fm10_ice, & qss_ocn, qss_lnd, qss_ice - + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + !local variables - + integer :: i, its, ite, ims, ime - + logical :: ch_bound_excursion - + !GJF: the vonKarman constant should come in through the CCPP and be defined by the host model real (kind=kind_phys), parameter :: karman = 0.4 real (kind=kind_phys), parameter :: log01=log(0.01), log05=log(0.05), & log07=log(0.07) - + !GJF: if the following variables will be used, they should be turned into intent(in) namelist options integer :: iwavecpl, ens_random_seed, issflx logical :: diag_wind10m, diag_qss real(kind=kind_phys) :: ens_Cdamp - + real(kind=kind_phys), dimension(im) :: wetc, pspc, pkmax, tstrc, upc, & vpc, mznt, slwdc, wind10, qfx, qgh, zkmax, z1_cm, z0max, ztmax real(kind=kind_phys), dimension(im) :: u10_lnd, u10_ocn, u10_ice, & v10_lnd, v10_ocn, v10_ice - + !GJF: the following variables are identified as: !"SCURX" "Surface Currents(X)" "m s-1" !"SCURY" "Surface Currents(Y)" "m s-1 !"CHARN" "Charnock Coeff" " " !"MSANG" "Wind/Stress Angle" "Radian" real(kind=kind_phys), dimension(im) :: charn, msang, scurx, scury - + real(kind=kind_phys), dimension(im) :: fxh, fxe, fxmx, fxmy, xxfh, & xxfh2, tzot real(kind=kind_phys), dimension(1:30) :: maxsmc, drysmc real(kind=kind_phys) :: smcmax, smcdry, zhalf, cd10, & esat, fm_lnd_old, fh_lnd_old, tem1, tem2, czilc, cd_low_limit, & cd_high_limit, ch_low_limit, ch_high_limit, fh2_fh_ratio - + !#### This block will become unnecessary when maxsmc and drysmc come through the CCPP #### if (lsm == lsm_noah) then maxsmc = maxsmc_noah @@ -215,88 +215,88 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000/ end if !######################################################################## - - !GJF: This code has not been tested with iwavecpl = 1; the variables 'charn' and 'msang' (and others?) need to be input in order to use this + + !GJF: This code has not been tested with iwavecpl = 1; the variables 'charn' and 'msang' (and others?) need to be input in order to use this ! if (cplwav .or. cplwav2atm) then ! iwavecpl = 1 ! else ! iwavecpl = 0 ! end if iwavecpl = 0 - + !GJF: temporary setting of variables that should be moved to namelist is they are used ens_random_seed = 0 !used for HWRF ensemble? ens_Cdamp = 0.0 !used for HWRF ensemble? issflx = 0 !GJF: 1 = calculate surface fluxes, 0 = don't - diag_wind10m = .false. !GJF: if one wants 10m wind speeds to come from this scheme, set this to True, + diag_wind10m = .false. !GJF: if one wants 10m wind speeds to come from this scheme, set this to True, ! put [u,v]10_[lnd/ocn/ice] in the scheme argument list (and metadata), and modify ! GFS_surface_compsites to receive the individual components and calculate an all-grid value diag_qss = .false. !GJF: saturation specific humidities are calculated by LSM, sea surface, and sea ice schemes in ! GFS-based suites - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + its = 1 ims = 1 ite = im ime = im - + do i=its, ite if (flag_iter(i)) then !GJF: Perform data preparation that is the same for all surface types - + pspc(i) = psfc(i)*10. ! convert from Pa to cgs pkmax(i) = prsl1(i)*10. ! convert from Pa to cgs upc(i) = u1(i)*100. ! convert from m s-1 to cm s-1 vpc(i) = v1(i)*100. ! convert from m s-1 to cm s-1 - + !Wang: use previous u10 v10 to compute wind10, input to MFLUX2 to compute z0 (for first time step, u10 and v10 may be zero) wind10(i)=sqrt(u10(i)*u10(i)+v10(i)*v10(i)) !m s-1 - + !Wang: calulate height of the first half level ! if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then ! zhalf = -rd*t1(i)*alog(pkmax(i)/pspc(i))/grav !m ! endif - + !GJF: rather than calculate the height of the first half level, if it is precalculated ! in a different scheme, pass it in and use it; note that in FV3, calculating via the hypsometric equation ! occasionally produced values much shallower than those passed in !zkmax(i) = -rd*t1(i)*alog(pkmax(i)/pspc(i))/grav !m zkmax(i) = z1(i) z1_cm(i) = 100.0*z1(i) - + !GJF: these drag coefficient limits were suggested by Chunxi Zhang via his module_sf_sfclayrev.f90 cd_low_limit = 1.0e-5/zkmax(i) cd_high_limit = 0.1 - !GJF: use the lower of 0.1 from Chunxi Zhang or 0.05/wspd from WRF's module_sf_gfdl.F + !GJF: use the lower of 0.1 from Chunxi Zhang or 0.05/wspd from WRF's module_sf_gfdl.F ! (this will always be the latter if wspd has a minimum of 1.0 m s-1 from above) ch_low_limit = cd_low_limit ch_high_limit = min(0.1,0.05/wspd(i)) - + !slwdc... GFDL downward net flux in units of cal/(cm**2/min) !also divide by 10**4 to convert from /m**2 to /cm**2 slwdc(i)=gsw(i)+glw(i) slwdc(i)=0.239*60.*slwdc(i)*1.e-4 - + !GJF: these variables should be passed in if these options are used charn(i) = 0.0 !used with wave coupling (iwavecpl == 1) msang(i) = 0.0 !used with wave coupling (iwavecpl == 1) scurx(i) = 0.0 !used with ocean currents? (lcurr_sf == T) scury(i) = 0.0 !used with ocean currents? (lcurr_sf == T) - + if (diag_qss) then esat = fpvs(t1(i)) qgh(i) = ep2*esat/(psfc(i)-esat) end if - + !GJF: these vars are not needed in a GFS-based suite !rho1(i)=prsl1(i)/(rd*t1(i)*(1.+ep1*q1(i))) !cpm(i)=cp*(1.+0.8*q1(i)) - + !GJF: perform data preparation that depends on surface types and call the mflux2 subroutine for each surface type ! Note that this is different than the original WRF module_sf_gfdl.F where mflux2 is called once for all surface ! types, with negative roughness lengths denoting open ocean. @@ -306,24 +306,24 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & smcmax=maxsmc(isltyp(i)) wetc(i)=(smois(i,1)-smcdry)/(smcmax-smcdry) wetc(i)=amin1(1.,amax1(wetc(i),0.)) - + !GJF: the lower boundary temperature passed in to MFLUX2 either follows GFS: tstrc(i) = 0.5*(tskin_lnd(i) + tsurf_lnd(i)) !averaging tskin_lnd and tsurf_lnd as in GFS surface layer breaks ntsflg functionality !GJF: or WRF module_sf_gfdl.F: !tstrc(i) = tskin_lnd(i) - + !GJF: Roughness Length Limitation section ! The WRF version of module_sf_gfdl.F has no checks on the roughness lengths prior to entering MFLUX2. ! The following limits were placed on roughness lengths from the GFS surface layer scheme at the suggestion ! of Chunxi Zhang. Using the GFDL surface layer without such checks can lead to instability in the UFS. - + !znt_lnd is in cm, z0max/ztmax are in m at this point z0max(i) = max(1.0e-6, min(0.01 * znt_lnd(i), zkmax(i))) - + tem1 = 1.0 - shdmax(i) tem2 = tem1 * tem1 tem1 = 1.0 - tem2 - + if( ivegsrc == 1 ) then if (vegtype(i) == 10) then z0max(i) = exp( tem2*log01 + tem1*log07 ) @@ -353,7 +353,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & z0max(i) = exp( tem2*log01 + tem1*log(z0max(i)) ) endif endif - + z0max(i) = max(z0max(i), 1.0e-6) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil @@ -363,16 +363,16 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ztmax(i) = z0max(i)*exp( - tem1*tem1 & & * czilc*karman*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) ztmax(i) = max(ztmax(i), 1.0e-6) - + !GJF: from WRF's module_sf_gfdl.F if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then wind10(i)=wspd(i)*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) !m s-1 end if wind10(i)=wind10(i)*100.0 !convert from m/s to cm/s - + ztmax(i) = ztmax(i)*100.0 !convert from m to cm z0max(i) = z0max(i)*100.0 !convert from m to cm - + call mflux2 (fxh(i), fxe(i), fxmx(i), fxmy(i), cdm_lnd(i), rib_lnd(i), & xxfh(i), ztmax(i), z0max(i), tstrc(i), & pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & @@ -380,62 +380,62 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & errflg) if (errflg /= 0) return - + !GJF: this is broken when tstrc is set to an average of two variables if (ntsflg==1) then - tskin_lnd(i) = tstrc(i) ! gopal's doing + tskin_lnd(i) = tstrc(i) ! gopal's doing end if - + if (diag_wind10m) then u10_lnd(i) = u1(i)*(0.01*wind10(i)/wspd(i)) v10_lnd(i) = v1(i)*(0.01*wind10(i)/wspd(i)) end if - + !GJF: these variables are not needed in a GFS-based suite, but are found in WRF's module_sf_gfdl.F and kept in comments for legacy - !gz1oz0(i) = alog(zkmax(i)/(0.01*znt_lnd(i))) + !gz1oz0(i) = alog(zkmax(i)/(0.01*znt_lnd(i))) !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling - + cdm_lnd(i) = max(cdm_lnd(i), cd_low_limit) cdm_lnd(i) = min(cdm_lnd(i), cd_high_limit) fm_lnd(i) = karman/sqrt(cdm_lnd(i)) - + !1) try fh_lnd from MFLUX2 fh_lnd(i) = karman*xxfh(i) - + !2) calc ch_lnd from fm_lnd and fh_lnd ch_lnd(i) = karman*karman/(fm_lnd(i) * fh_lnd(i)) - + !3) check if ch_lnd is out of bounds (if so, recalculate fh_lnd from bounded value) ch_bound_excursion = .false. - if (ch_lnd(i) < ch_low_limit) then + if (ch_lnd(i) < ch_low_limit) then ch_bound_excursion = .true. ch_lnd(i) = ch_low_limit else if (ch_lnd(i) > ch_high_limit) then ch_bound_excursion = .true. ch_lnd(i) = ch_high_limit end if - + fh2_lnd(i) = karman*xxfh2(i) - + if (ch_bound_excursion) then fh2_fh_ratio = min(xxfh2(i)/xxfh(i), 1.0) fh_lnd(i) = karman*karman/(fm_lnd(i)*ch_lnd(i)) fh2_lnd(i) = fh2_fh_ratio*fh_lnd(i) end if - + !GJF: Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih !psim_lnd(i)=gz1oz0(i)-fm_lnd(i) !psih_lnd(i)=gz1oz0(i)-fh_lnd(i) - + !GJF: from WRF's module_sf_gfdl.F ustar_lnd(i) = 0.01*sqrt(cdm_lnd(i)* & (upc(i)*upc(i) + vpc(i)*vpc(i))) !GJF: from Chunxi Zhang's module_sf_sfclayrev.f90 (I'm not sure it's necessary.) ustar_lnd(i) = amax1(ustar_lnd(i),0.001) - + stress_lnd(i) = cdm_lnd(i)*wspd(i)*wspd(i) - + !GJF: from WRF's module_sf_gfdl.F ! convert cd, ch to values at 10m, for output cd10 = cdm_lnd(i) @@ -446,48 +446,48 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ! (alog(zkmax(i)/tmp9)/alog(10.0/tmp9)) end if fm10_lnd(i) = karman/sqrt(cd10) - - !GJF: conductances aren't used in other CCPP schemes, but this limit + + !GJF: conductances aren't used in other CCPP schemes, but this limit ! might be able to replace the limits on drag coefficients above - + !chs_lnd(i)=ch_lnd(i)*wspd (i) !conductance !chs2_lnd(i)=ustar_lnd(i)*karman/fh2_lnd(i) !2m conductance - + !!!2014-0922 cap CHS over land points ! chs_lnd(i)=amin1(chs_lnd(i), 0.05) ! chs2_lnd(i)=amin1(chs2_lnd(i), 0.05) ! if (chs2_lnd(i) < 0) chs2_lnd(i)=1.0e-6 - + if (diag_qss) then esat = fpvs(tskin_lnd(i)) qss_lnd(i) = ep2*esat/(psfc(i)-esat) end if - + !GJF: not used in CCPP !flhc_lnd(i)=cpm(i)*rho1(i)*chs_lnd(i) !flqc_lnd(i)=rho1(i)*chs_lnd(i) !cqs2_lnd(i)=chs2_lnd(i) end if !dry - + if (icy(i)) then !GJF: from WRF's module_sf_gfdl.F smcdry=drysmc(isltyp(i)) smcmax=maxsmc(isltyp(i)) wetc(i)=(smois(i,1)-smcdry)/(smcmax-smcdry) wetc(i)=amin1(1.,amax1(wetc(i),0.)) - - + + !GJF: the lower boundary temperature passed in to MFLUX2 either follows GFS: tstrc(i) = 0.5*(tskin_ice(i) + tsurf_ice(i)) !averaging tskin_ice and tsurf_ice as in GFS surface layer breaks ntsflg functionality !GJF: or WRF module_sf_gfdl.F: !tstrc(i) = tskin_ice(i) !averaging tskin_ice and tsurf_ice as in GFS surface layer breaks ntsflg functionality - + !GJF: Roughness Length Limitation section ! The WRF version of module_sf_gfdl.F has no checks on the roughness lengths prior to entering MFLUX2. ! The following limits were placed on roughness lengths from the GFS surface layer scheme at the suggestion ! of Chunxi Zhang. Using the GFDL surface layer without such checks can lead to instability in the UFS. - + !znt_ice is in cm, z0max/ztmax are in m at this point z0max(i) = max(1.0e-6, min(0.01 * znt_ice(i), zkmax(i))) !** xubin's new z0 over land and sea ice @@ -511,17 +511,17 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ztmax(i) = z0max(i)*exp( - tem1*tem1 & & * czilc*karman*sqrt(ustar_ice(i)*(0.01/1.5e-05))) ztmax(i) = max(ztmax(i), 1.0e-6) - - + + !GJF: from WRF's module_sf_gfdl.F if (wind10(i) <= 1.0e-10 .or. wind10(i) > 150.0) then wind10(i)=wspd(i)*alog(10.0/z0max(i))/alog(z1(i)/z0max(i)) end if wind10(i)=wind10(i)*100.0 !! m/s to cm/s - + ztmax(i) = ztmax(i)*100.0 !m to cm z0max(i) = z0max(i)*100.0 !m to cm - + call mflux2 (fxh(i), fxe(i), fxmx(i), fxmy(i), cdm_ice(i), rib_ice(i), & xxfh(i), ztmax(i), z0max(i), tstrc(i), & pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & @@ -529,61 +529,61 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & errflg) if (errflg /= 0) return - + !GJF: this is broken when tstrc is set to an average of two variables if (ntsflg==1) then - tskin_ice(i) = tstrc(i) ! gopal's doing + tskin_ice(i) = tstrc(i) ! gopal's doing end if - + if (diag_wind10m) then u10_ice(i) = u1(i)*(0.01*wind10(i)/wspd(i)) v10_ice(i) = v1(i)*(0.01*wind10(i)/wspd(i)) end if - + !GJF: these variables are not needed in a GFS-based suite, but are found in WRF's module_sf_gfdl.F and kept in comments for legacy !gz1oz0(i) = alog(zkmax(i)/znt_ice(i)) !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling - + cdm_ice(i) = max(cdm_ice(i), cd_low_limit) cdm_ice(i) = min(cdm_ice(i), cd_high_limit) fm_ice(i) = karman/sqrt(cdm_ice(i)) - + !1) try fh_ice from MFLUX2 fh_ice(i) = karman*xxfh(i) - + !2) calc ch_ice from fm_ice and fh_ice ch_ice(i) = karman*karman/(fm_ice(i) * fh_ice(i)) - + !3) check if ch_ice is out of bounds (if so, recalculate fh_ice from bounded value) ch_bound_excursion = .false. - if (ch_ice(i) < ch_low_limit) then + if (ch_ice(i) < ch_low_limit) then ch_bound_excursion = .true. ch_ice(i) = ch_low_limit else if (ch_ice(i) > ch_high_limit) then ch_bound_excursion = .true. ch_ice(i) = ch_high_limit end if - + fh2_ice(i) = karman*xxfh2(i) - + if (ch_bound_excursion) then fh2_fh_ratio = min(xxfh2(i)/xxfh(i), 1.0) fh_ice(i) = karman*karman/(fm_ice(i)*ch_ice(i)) fh2_ice(i) = fh2_fh_ratio*fh_ice(i) end if - + !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih !psim_ice(i)=gz1oz0(i)-fm_ice(i) !psih_ice(i)=gz1oz0(i)-fh_ice(i) - + ustar_ice(i) = 0.01*sqrt(cdm_ice(i)* & (upc(i)*upc(i) + vpc(i)*vpc(i))) !GJF: from Chunxi Zhang's module_sf_sfclayrev.f90 (I'm not sure it's necessary.) ustar_ice(i) = amax1(ustar_ice(i),0.001) - + stress_ice(i) = cdm_ice(i)*wspd(i)*wspd(i) - + !GJF: from WRF's module_sf_gfdl.F !!! convert cd, ch to values at 10m, for output cd10 = cdm_ice(i) @@ -594,29 +594,29 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ! (alog(zkmax(i)/tmp9)/alog(10.0/tmp9)) end if fm10_ice(i) = karman/sqrt(cd10) - + !GJF: conductances aren't used in other CCPP schemes !chs_ice(i)=ch_ice(i)*wspd (i) !conductance !chs2_ice(i)=ustar_ice(i)*karman/fh2_ice(i) !2m conductance - + if (diag_qss) then esat = fpvs(tskin_ice(i)) qss_ice(i) = ep2*esat/(psfc(i)-esat) end if - + !flhc_ice(i)=cpm(i)*rho1(i)*chs_ice(i) !flqc_ice(i)=rho1(i)*chs_ice(i) !cqs2_ice(i)=chs2_ice(i) end if !ice - + if (wet(i)) then wetc(i) = 1.0 - + !GJF: the lower boundary temperature passed in to MFLUX2 either follows GFS: tstrc(i) = 0.5*(tskin_ocn(i) + tsurf_ocn(i)) !averaging tskin_ocn and tsurf_ocn as in GFS surface layer breaks ntsflg functionality !GJF: or WRF module_sf_gfdl.F: !tstrc(i) = tskin_ocn(i) - + ! DH* 20201009: these bounds on ocean roughness lengths are from Chunxi Zhang's module_sf_sfclayrev.f90 (in cm) znt_ocn(i)=min(2.85e-1,max(znt_ocn(i),1.27e-5)) @@ -625,10 +625,10 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & wind10(i)=wspd(i)*alog(10.0/(0.01*znt_ocn(i)))/alog(z1(i)/(0.01*znt_ocn(i))) end if wind10(i)=wind10(i)*100.0 !! m/s to cm/s - + !GJF: mflux2 expects negative roughness length for ocean points znt_ocn(i) = -znt_ocn(i) - + call mflux2 (fxh(i), fxe(i), fxmx(i), fxmy(i), cdm_ocn(i), rib_ocn(i), & xxfh(i), znt_ocn(i), mznt(i), tstrc(i), & pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & @@ -636,67 +636,67 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & errflg) if (errflg /= 0) return - + !GJF: this is broken when tstrc is set to an average of two variables if (ntsflg==1) then - tskin_ocn(i) = tstrc(i) ! gopal's doing + tskin_ocn(i) = tstrc(i) ! gopal's doing end if - + znt_ocn(i)= abs(znt_ocn(i)) mznt(i)= abs(mznt(i)) - + !GJF: these bounds on ocean roughness lengths are from Chunxi Zhang's module_sf_sfclayrev.f90 (in cm) znt_ocn(i)=min(2.85e-1,max(znt_ocn(i),1.27e-5)) - + if (diag_wind10m) then u10_ocn(i) = u1(i)*(0.01*wind10(i)/wspd(i)) v10_ocn(i) = v1(i)*(0.01*wind10(i)/wspd(i)) end if - + !GJF: these variables are not needed in a GFS-based suite, but are found in WRF's module_sf_gfdl.F and kept in comments for legacy !gz1oz0(i) = alog(zkmax(i)/znt_ocn(i)) !taux(i) = fxmx(i)/10. ! gopal's doing for Ocean coupling !tauy(i) = fxmy(i)/10. ! gopal's doing for Ocean coupling - + cdm_ocn(i) = max(cdm_ocn(i), cd_low_limit) cdm_ocn(i) = min(cdm_ocn(i), cd_high_limit) fm_ocn(i) = karman/sqrt(cdm_ocn(i)) - + !1) try fh_ocn from MFLUX2 fh_ocn(i) = karman*xxfh(i) - + !2) calc ch_ocn from fm_ocn and fh_ocn ch_ocn(i) = karman*karman/(fm_ocn(i) * fh_ocn(i)) - + !3) check if ch_lnd is out of bounds (if so, recalculate fh_lnd from bounded value) ch_bound_excursion = .false. - if (ch_ocn(i) < ch_low_limit) then + if (ch_ocn(i) < ch_low_limit) then ch_bound_excursion = .true. ch_ocn(i) = ch_low_limit else if (ch_ocn(i) > ch_high_limit) then ch_bound_excursion = .true. ch_ocn(i) = ch_high_limit end if - + fh2_ocn(i) = karman*xxfh2(i) - + if (ch_bound_excursion) then fh2_fh_ratio = min(xxfh2(i)/xxfh(i), 1.0) fh_ocn(i) = karman*karman/(fm_ocn(i)*ch_ocn(i)) fh2_ocn(i) = fh2_fh_ratio*fh_ocn(i) end if - + !Other CCPP schemes (PBL) ask for fm/fh instead of psim/psih !psim_ocn(i)=gz1oz0(i)-fm_ocn(i) !psih_ocn(i)=gz1oz0(i)-fh_ocn(i) - + ustar_ocn(i) = 0.01*sqrt(cdm_ocn(i)* & (upc(i)*upc(i) + vpc(i)*vpc(i))) !GJF: from Chunxi Zhang's module_sf_sfclayrev.f90 (I'm not sure it's necessary.) ustar_ocn(i) = amax1(ustar_ocn(i),0.001) - + stress_ocn(i) = cdm_ocn(i)*wspd(i)*wspd(i) - + !GJF: from WRF's module_sf_gfdl.F !!! convert cd, ch to values at 10m, for output cd10 = cdm_ocn(i) @@ -707,23 +707,23 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ! (alog(zkmax(i)/tmp9)/alog(10.0/tmp9)) end if fm10_ocn(i) = karman/sqrt(cd10) - + !GJF: conductances aren't used in other CCPP schemes !chs_ocn(i)=ch_ocn(i)*wspd (i) !conductance !chs2_ocn(i)=ustar_ocn(i)*karman/fh2_ocn(i) !2m conductance - + if (diag_qss) then esat = fpvs(tskin_ocn(i)) qss_ocn(i) = ep2*esat/(psfc(i)-esat) end if end if !wet - + !flhc_ocn(i)=cpm(i)*rho1(i)*chs_ocn(i) !flqc_ocn(i)=rho1(i)*chs_ocn(i) !cqs2_ocn(i)=chs2_ocn(i) end if !flag_iter end do - + !GJF: this code has not been updated since GFS suites don't require this; one would need to have different values of hfx, qfx, lh for each surface type ! if (isfflx.eq.0) then ! do i=its,ite @@ -737,7 +737,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ! !water ! hfx(i)= -10.*cp*fxh(i) ! else if (islmsk == 1) then - ! hfx(i)= -10.*cp*fxh(i) + ! hfx(i)= -10.*cp*fxh(i) ! hfx(i)=amax1(hfx(i),-250.) ! end if ! qfx(j)=-10.*fxe(i) @@ -745,8 +745,8 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & ! lh(i)=xlv*qfx(i) ! enddo ! endif - - + + end subroutine gfdl_sfc_layer_run !--------------------------------- @@ -757,13 +757,13 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m pert_Cd, ens_random_seed, ens_Cdamp, & upc,vpc,tpc,rpc,dt,wind10,xxfh2,ntsflg,sfenth, & tzot, errmsg, errflg) - + !------------------------------------------------------------------------ ! -! MFLUX2 computes surface fluxes of momentum, heat,and moisture -! using monin-obukhov. the roughness length "z0" is prescribed +! MFLUX2 computes surface fluxes of momentum, heat,and moisture +! using monin-obukhov. the roughness length "z0" is prescribed ! over land and over ocean "z0" is computed using charnocks formula. -! the universal functions (from similarity theory approach) are +! the universal functions (from similarity theory approach) are ! those of hicks. This is Bob's doing. ! !------------------------------------------------------------------------ @@ -785,7 +785,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m integer,intent(in) :: icoef_sf integer,intent(in) :: iwavecpl logical,intent(in) :: lcurr_sf - logical,intent(in) :: pert_Cd + logical,intent(in) :: pert_Cd integer,intent(in) :: ens_random_seed real(kind=kind_phys),intent(in) :: ens_Cdamp @@ -818,7 +818,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: vpc real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: tpc real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: rpc - + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -844,7 +844,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real(kind=kind_phys), dimension(1 :ime) :: estsop real(kind=kind_phys), dimension(1 :ime) :: fmz1 real(kind=kind_phys), dimension(1 :ime) :: fmz10 - real(kind=kind_phys), dimension(1 :ime) :: fmz2 + real(kind=kind_phys), dimension(1 :ime) :: fmz2 real(kind=kind_phys), dimension(1 :ime) :: fmzo1 real(kind=kind_phys), dimension(1 :ime) :: foft real(kind=kind_phys), dimension(1 :ime) :: foftm @@ -858,7 +858,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real(kind=kind_phys), dimension(1 :ime) :: rstso real(kind=kind_phys), dimension(1 :ime) :: rstsop real(kind=kind_phys), dimension(1 :ime) :: sf10 - real(kind=kind_phys), dimension(1 :ime) :: sf2 + real(kind=kind_phys), dimension(1 :ime) :: sf2 real(kind=kind_phys), dimension(1 :ime) :: sfm real(kind=kind_phys), dimension(1 :ime) :: sfzo real(kind=kind_phys), dimension(1 :ime) :: sgzm @@ -879,7 +879,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real(kind=kind_phys), dimension(1 :ime) :: tss real(kind=kind_phys), dimension(1 :ime) :: ucom real(kind=kind_phys), dimension(1 :ime) :: uf10 - real(kind=kind_phys), dimension(1 :ime) :: uf2 + real(kind=kind_phys), dimension(1 :ime) :: uf2 real(kind=kind_phys), dimension(1 :ime) :: ufh real(kind=kind_phys), dimension(1 :ime) :: ufm real(kind=kind_phys), dimension(1 :ime) :: ufzo @@ -897,7 +897,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real(kind=kind_phys), dimension(1 :ime) :: xxfm real(kind=kind_phys), dimension(1 :ime) :: xxsh real(kind=kind_phys), dimension(1 :ime) :: z10 - real(kind=kind_phys), dimension(1 :ime) :: z2 + real(kind=kind_phys), dimension(1 :ime) :: z2 real(kind=kind_phys), dimension(1 :ime) :: zeta real(kind=kind_phys), dimension(1 :ime) :: zkmax @@ -913,7 +913,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real(kind=kind_phys) :: ux13, yo, y,xo,x,ux21,ugzzo,ux11,ux12,uzetao,xnum,alll real(kind=kind_phys) :: ux1,ugz,x10,uzo,uq,ux2,ux3,xtan,xden,y10,uzet1o,ugz10 - real(kind=kind_phys) :: szet2, zal2,ugz2 + real(kind=kind_phys) :: szet2, zal2,ugz2 real(kind=kind_phys) :: rovcp,boycon,cmo2,psps1,zog,enrca,rca,cmo1,amask,en,ca,a,c real(kind=kind_phys) :: sgz,zal10,szet10,fmz,szo,sq,fmzo,rzeta1,zal1g,szetao,rzeta2,zal2g real(kind=kind_phys) :: hcap,xks,pith,teps,diffot,delten,alevp,psps2,alfus,nstep @@ -928,7 +928,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m ! internal variables !----------------------------------------------------------------------- - real(kind=kind_phys), dimension (223) :: tab + real(kind=kind_phys), dimension (223) :: tab real(kind=kind_phys), dimension (223) :: table real(kind=kind_phys), dimension (101) :: tab11 real(kind=kind_phys), dimension (41) :: table4 @@ -950,7 +950,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m data amask/ -98.0/ !----------------------------------------------------------------------- -! tables used to obtain the vapor pressures or saturated vapor +! tables used to obtain the vapor pressures or saturated vapor ! pressure !----------------------------------------------------------------------- @@ -1006,7 +1006,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m data table3/.7520e+03,.7980e+03,.8470e+03,.8980e+03,.9520e+03, & &.1008e+04,.1067e+04,.1129e+04,.1194e+04,.1263e+04,.1334e+04, & &.1409e+04,.1488e+04,.1569e+04,.1656e+04,.1745e+04,.1840e+04, & - &.1937e+04,.2041e+04,.2147e+04,.2259e+04,.2375e+04,.2497e+04, & + &.1937e+04,.2041e+04,.2147e+04,.2259e+04,.2375e+04,.2497e+04, & &.2624e+04,.2756e+04,.2893e+04,.3036e+04,.3186e+04,.3340e+04, & &.3502e+04,.3670e+04,.3843e+04,.4025e+04,.4213e+04,.4408e+04, & &.4611e+04,.4821e+04,.5035e+04,.5270e+04,.5500e+04,.5740e+04, & @@ -1030,7 +1030,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real,parameter :: rgas = 2.87e6 real,parameter :: og = 1./g integer :: ntstep = 0 - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -1075,7 +1075,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m ! routine = 'mflux2' ! !------------------------------------------------------------------------ -! set water availability constant "ecof" and land mask "land". +! set water availability constant "ecof" and land mask "land". ! limit minimum wind speed to 100 cm/s !------------------------------------------------------------------------ ! constants for 10 m winds (correction for knots @@ -1165,13 +1165,13 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m enddo !------------------------------------------------------------------------ -! define constants: -! a and c = constants used in evaluating universal function for -! stable case -! ca = karmen constant -! cm01 = constant part of vertical integral of universal -! function; stable case ( 0.5 < zeta < or = 10.0) -! cm02 = constant part of vertical integral of universal +! define constants: +! a and c = constants used in evaluating universal function for +! stable case +! ca = karmen constant +! cm01 = constant part of vertical integral of universal +! function; stable case ( 0.5 < zeta < or = 10.0) +! cm02 = constant part of vertical integral of universal ! function; stable case ( zeta > 10.0) !------------------------------------------------------------------------ @@ -1207,14 +1207,14 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m if(psps1 .EQ. 0.0)then psps1 = .1 endif - rstso(i) = 0.622*estso(i)/psps1 + rstso(i) = 0.622*estso(i)/psps1 vrts (i) = 1. + boycon*ecof(i)*rstso(i) enddo !------------------------------------------------------------------------ ! check if consideration of virtual temperature changes stability. -! if so, set "dthetav" to near neutral value (1.0e-4). also check -! for very small lapse rates; if ABS(tempa1) <1.0e-4 then +! if so, set "dthetav" to near neutral value (1.0e-4). also check +! for very small lapse rates; if ABS(tempa1) <1.0e-4 then ! tempa1=1.0e-4 !------------------------------------------------------------------------ @@ -1241,13 +1241,13 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m enddo !------------------------------------------------------------------------ -! begin looping through points on line, solving wegsteins iteration +! begin looping through points on line, solving wegsteins iteration ! for zeta at each point, and using hicks functions !------------------------------------------------------------------------ !------------------------------------------------------------------------ -! set initial guess of zeta=non - dimensional height "szeta" for -! stable points +! set initial guess of zeta=non - dimensional height "szeta" for +! stable points !------------------------------------------------------------------------ rca = 1./ca @@ -1349,14 +1349,14 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m if (szet2 .LE. 0.5) then fmz2 (i) = (zal2 + a*szet2 )*rca else if (szet2 .GT. 0.5 .AND. szet2 .LE. 2.) then - rzeta2 = 1./szet2 + rzeta2 = 1./szet2 fmz2 (i) = (8.*zal2 + 4.25*rzeta2 - & 0.5*rzeta2*rzeta2 + cmo1)*rca else if (szet2 .GT. 2.) then fmz2 (i) = (c*szet2 + cmo2)*rca endif sf2 (i) = fmz2 (i) - fmzo1(i) - + sfm(i) = fmz1(i) - fmzo1(i) sfh(i) = fmz1(i) - fhzo1(i) sgz = ca*rib(istb(i))*sfm(i)*sfm(i)/ & @@ -1388,7 +1388,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m go to 130 110 continue - + write(errmsg,'(*(a))') 'NON-CONVERGENCE FOR STABLE ZETA IN gfdl_sfc_layer.F90/MFLUX2' errflg = 1 return @@ -1397,7 +1397,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m !------------------------------------------------------------------------ ! update "zo" for ocean points. "zo"cannot be updated within the ! wegsteins iteration as the scheme (for the near neutral case) -! can become unstable +! can become unstable !------------------------------------------------------------------------ 130 continue @@ -1419,7 +1419,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m ustar = sqrt( -szo / zog) restar = -ustar * szo / vis - restar = max(restar,cons_p000001) + restar = max(restar,cons_p000001) ! Rat taken from Zeng, Zhao and Dickinson 1997 rat = 2.67 * restar ** .25 - 2.57 rat = min(rat ,cons_7) !constant @@ -1428,7 +1428,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m else zot(istb(i)) = zoc(istb(i)) endif - + ! in hwrf thermal znot is loaded back into the zoc array for next step zoc(istb(i)) = szo enddo @@ -1453,7 +1453,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m endif ! the above correction done by GFDL in centi-kts!!!-change back wind10(istb(i)) = wind10(istb(i)) / 1.944 - enddo + enddo !------------------------------------------------------------------------ ! unstable points @@ -1540,7 +1540,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m ugz2 = ALOG(z2 (iutb(i))/ABS(zoc(iutb(i)))) uzet1o = ABS(z2 (iutb(i)))/zkmax(iutb(i))*uzeta(i) uzetao = ABS(zoc(iutb(i)))/zkmax(iutb(i))*uzeta(i) - ux11 = 1. - 16.*uzet1o + ux11 = 1. - 16.*uzet1o ux12 = 1. - 16.*uzetao y = SQRT(ux11) yo = SQRT(ux12) @@ -1582,7 +1582,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m 'uq is 1 ',ux2,ugz,ugzm(i),uzeta(i),uzetam(i) errflg = 1 return - + ! call MPI_CLOSE(1,routine) !------------------------------------------------------------------------ @@ -1594,7 +1594,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m !------------------------------------------------------------------------ ! update "zo" for ocean points. zo cannot be updated within the ! wegsteins iteration as the scheme (for the near neutral case) -! can become unstable. +! can become unstable. !------------------------------------------------------------------------ do i = 1,iq @@ -1639,7 +1639,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m endif ! the above correction done by GFDL in centi-kts!!!-change back wind10(iutb(i)) = wind10(iutb(i)) / 1.944 - enddo + enddo do i = 1,iq xxfm(iutb(i)) = ufm(i) @@ -1664,7 +1664,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m enddo ! do land sfc temperature prediction if ntsflg=1 -! ntsflg = 1 ! gopal's doing +! ntsflg = 1 ! gopal's doing if (ntsflg .EQ. 0) go to 370 alll = 600. @@ -1674,7 +1674,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m alfus = alll/2.39e-8 teps = 0.1 ! slwdc... in units of cal/min ???? -! slwa... in units of ergs/sec/cm*2 +! slwa... in units of ergs/sec/cm*2 ! 1 erg=2.39e-8 cal !------------------------------------------------------------------------ ! pack land and sea ice points @@ -1735,7 +1735,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m if(psps2 .EQ. 0.0)then psps2 = .1 endif - rstsop(i) = 0.622*estsop(i)/psps2 + rstsop(i) = 0.622*estsop(i)/psps2 rdiff (i) = amin1(0.0,(rkmaxp(i) - rstsop(i))) foft(i) = tss(i) + delsrad(i)*(slwa(i) - aap(i)*tsp(i)**4 - & @@ -1745,7 +1745,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m frac(i) = ABS((foft(i) - tsp(i))/tsp(i)) !------------------------------------------------------------------------ -! check for convergence of all points use wegstein iteration +! check for convergence of all points use wegstein iteration !------------------------------------------------------------------------ if (frac(i) .GE. teps) then @@ -1773,7 +1773,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m ! call MPI_CLOSE(1,routine) endif enddo - + do i = 1,ip ii = indx(i) tstrc(ii) = tsp (i) @@ -1785,7 +1785,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m 370 continue do i = its,ite -!!! +!!! if ( iwavecpl .eq. 1 .and. zoc(i) .le. 0.0 ) then windmks = wind10(i) * 0.01 call znot_wind10m(windmks,znott,znotm,icoef_sf) @@ -1819,5 +1819,5 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m ntstep = ntstep + 1 return end subroutine MFLUX2 - + end module gfdl_sfc_layer From d2573475a773ce3cece181d5b86af676229fdcce Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 10 Oct 2020 15:34:48 -0600 Subject: [PATCH 075/274] Fix error handling in physics/radlw_main.F90 --- physics/radlw_main.F90 | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index f5278ed33..b7e93d06b 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -1213,8 +1213,10 @@ subroutine rrtmg_lw_run & call cldprmc(nlay, inflglw, iceflglw, liqflglw, & & cldfmc, ciwpmc, & & clwpmc, cswpmc, reicmc, relqmc, resnmc, & - & ncbands, taucmc) - endif + & ncbands, taucmc, errmsg, errflg) + ! return immediately if cldprmc throws an error + if (errflg/=0) return + endif ! if (lprnt) then ! print *,' after cldprop' @@ -7959,7 +7961,7 @@ end subroutine rtrnmc_mcica ! ------------------------------------------------------------------------------ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & - & ciwpmc, clwpmc, cswpmc, reicmc, relqmc, resnmc, ncbands, taucmc) + & ciwpmc, clwpmc, cswpmc, reicmc, relqmc, resnmc, ncbands, taucmc, errmsg, errflg) ! ------------------------------------------------------------------------------ ! Purpose: Compute the cloud optical depth(s) for each cloudy layer. @@ -7998,9 +8000,11 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & ! ------- Output ------- - integer(kind=im), intent(out) :: ncbands ! number of cloud spectral bands - real(kind=rb), intent(inout) :: taucmc(:,:) ! cloud optical depth [mcica] + integer(kind=im), intent(out) :: ncbands ! number of cloud spectral bands + real(kind=rb), intent(inout) :: taucmc(:,:) ! cloud optical depth [mcica] ! Dimensions: (ngptlw,nlayers) + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg ! ------- Local ------- @@ -8027,7 +8031,6 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & real(kind=rb) :: radsno ! cloud snow effective size (microns) real(kind=rb), parameter :: eps = 1.e-6_rb ! epsilon real(kind=rb), parameter :: cldmin = 1.e-20_rb ! minimum value for cloud quantities - character*80 errmess ! ------- Definitions ------- @@ -8784,10 +8787,11 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & elseif (iceflag .ge. 3) then if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then - write(errmess,'(A,i5,i5,f8.2,f8.2)' ) & + write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & - & ,ig, lay, ciwpmc(ig,lay), radice - !mz call wrf_error_fatal(errmess) + & ,ig, lay, ciwpmc(ig,lay), radice + errflg = 1 + return end if ncbands = 16 factor = (radice - 2._rb)/3._rb @@ -8806,10 +8810,11 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & if (cswpmc(ig,lay).gt.0.0_rb .and. iceflag .eq. 5) then radsno = resnmc(lay) if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then - write(errmess,'(A,i5,i5,f8.2,f8.2)' ) & + write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & & ,ig, lay, cswpmc(ig,lay), radsno - !mz call wrf_error_fatal(errmess) + errflg = 1 + return end if ncbands = 16 factor = (radsno - 2._rb)/3._rb @@ -8833,8 +8838,13 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & elseif (liqflag .eq. 1) then radliq = relqmc(lay) - if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) stop & - & 'LIQUID EFFECTIVE RADIUS OUT OF BOUNDS' + if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) then + write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +& 'ERROR: LIQUID EFFECTIVE SIZE OUT OF BOUNDS' & +& ,ig, lay, clwpmc(ig,lay), radliq + errflg = 1 + return + end if index = int(radliq - 1.5_rb) if (index .eq. 0) index = 1 if (index .eq. 58) index = 57 From b018da0982bd92bc2880eda43c861566e6631957 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Tue, 13 Oct 2020 15:27:51 +0000 Subject: [PATCH 076/274] Updated unified_ugwp documentation. --- physics/docs/library.bib | 41 +++++++++++++++++++++++++++++++++++ physics/unified_ugwp.F90 | 27 +++++++++++++++++++++-- physics/unified_ugwp_post.F90 | 4 ++-- 3 files changed, 68 insertions(+), 4 deletions(-) diff --git a/physics/docs/library.bib b/physics/docs/library.bib index dd2b2042e..b96226e04 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -3197,3 +3197,44 @@ @inproceedings{yudin_et_al_2019 Booktitle = {Space Weather Workshop}, Title = {Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, Year = {2019}} + +@article{kim_and_doyle_2005, + Author = {Y.-J. Kim and J.D. Arakawa}, + Doi = {10.1256/qj.04.160}, + Url = {https://doi.org/10.1256/qj.04.160}, + Journal = {Quarterly Journal of the Royal Meteorological Society}, + Pages = {1893-1921}, + Title = {Extension of an orographic-drag parametrization scheme to incorporate orographic inisotropy and flow blocking}, + Volume = {131}, + Year = {2005}} + +@article{steeneveld_et_al_2008, + Author = {Steeneveld, G. J.,A.A. M. Holtslag, C. J. Nappo, B. J. H. van de Wiel, and L. Mahrt}, + Doi = {10.1175/2008JAMC1816.1}, + Url = {https://doi.org/10.1175/2008JAMC1816.1}, + Journal = {J. Appl. Meteor.}, + Pages = {2518-2530}, + Title = {Exploring the possible role of small-scale terrain drag on stable boundary layers over land}, + Volume = {47}, + Year = {2008}} + +@article{tsiringakis_et_al_2017, + Author = {Tsiringakis,A., G. J. Steeneveld, and A.A. M. Holtslag}, + Doi = {10.1002/qj.3021}, + Url = {https://doi.org/10.1002/qj.3021}, + Journal = {Quarterly Journal of the Royal Meteorological Society}, + Pages = {1504-1516}, + Title = {Small-scale orographic gravity wave drag in stable boundary layers and its impact on synoptic systems and near-surface meteorology}, + Volume = {143}, + Year = {2017}} + +@article{beljaars_et_al_2004, + Author = {Beljaars, A.C.M., A.R.Brown, and N.Wood}, + Doi = {10.1256/qj.03.73}, + Url = {https://doi.org/10.1256/qj.03.73}, + Journal = {Quarterly Journal of the Royal Meteorological Society}, + Pages = {1327-1347}, + Title = {A new parametrization of turbulent orographic form drag}, + Volume = {130}, + Year = {2004}} + diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index bdd0fbb70..13b9f9193 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -1,5 +1,16 @@ !> \file unified_ugwp.F90 -!! This file contains the Unified Gravity Wave Physics (UGWP) scheme by Valery Yudin (University of Colorado, CIRES) +!! This file combines three gravity wave drag schemes under one ("unified_ugwp") suite: +!! 1) The "V0 CIRES UGWP" scheme (cires_ugwp.F90) as implemented in the FV3GFSv16 atmosphere model, which includes: +!! a) the "traditional" EMC orograhic gravity wave drag and flow blocking scheme of gwdps.f +!! b) the v0 cires ugwp non-stationary GWD scheme +!! 2) The GSL orographic drag suite (drag_suite.F90), as implmeneted in the RAP/HRRR, which includes: +!! a) large-scale gravity wave drag and low-level flow blocking -- active at horizontal scales +!! down to ~5km (Kim and Arakawa, 1995 \cite kim_and_arakawa_1995; Kim and Doyle, 2005 \cite kim_and_doyle_2005) +!! b) small-scale gravity wave drag scheme -- active typically in stable PBL at horizontal grid resolutions down to ~1km +!! (Steeneveld et al, 2008 \cite steeneveld_et_al_2008; Tsiringakis et al, 2017 \cite tsiringakis_et_al_2017) +!! c) turbulent orographic form drag -- active at horizontal grid ersolutions down to ~1km +!! (Beljaars et al, 2004 \cite beljaars_et_al_2004) +!! 3) The "V1 CIRES UGWP" scheme developed by Valery Yudin (University of Colorado, CIRES) !! See Valery Yudin's presentation at 2017 NGGPS PI meeting: !! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers !! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics @@ -9,6 +20,18 @@ !! 2. GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources. !! 3. GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing). !! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf +!! +!! The unified_ugwp scheme is activated by gwd_opt = 2 in the namelist. +!! The choice of schemes is activated at runtime by the following namelist options (boolean): +!! do_ugwp_v0 -- activates V0 CIRES UGWP scheme - both orographic and non-stationary GWD +!! do_ugwp_v0_orog_only -- activates V0 CIRES UGWP scheme - orographic GWD only +!! do_gsl_drag_ls_bl -- activates RAP/HRRR (GSL) large-scale GWD and blocking +!! do_gsl_drag_ss -- activates RAP/HRRR (GSL) small-scale GWD +!! do_gsl_drag_tofd -- activates RAP/HRRR (GSL) turbulent orographic drag +!! do_ugwp_v1 -- activates V1 CIRES UGWP scheme - both orographic and non-stationary GWD +!! do_ugwp_v1_orog_only -- activates V1 CIRES UGWP scheme - orographic GWD only +!! Note that only one "large-scale" scheme can be activated at a time. +!! module unified_ugwp @@ -43,7 +66,7 @@ module unified_ugwp ! ------------------------------------------------------------------------ ! CCPP entry points for CIRES Unified Gravity Wave Physics (UGWP) scheme v0 ! ------------------------------------------------------------------------ -!>@brief The subroutine initializes the CIRES UGWP +!>@brief The subroutine initializes the unified UGWP !> \section arg_table_unified_ugwp_init Argument Table !! \htmlinclude unified_ugwp_init.html !! diff --git a/physics/unified_ugwp_post.F90 b/physics/unified_ugwp_post.F90 index ac11b4eb1..5e43f2830 100644 --- a/physics/unified_ugwp_post.F90 +++ b/physics/unified_ugwp_post.F90 @@ -4,14 +4,14 @@ module unified_ugwp_post contains -!>\defgroup unified_ugwp_post CIRES UGWP Scheme Post +!>\defgroup unified_ugwp_post unified_UGWP Scheme Post !! @{ !> \section arg_table_unified_ugwp_post_init Argument Table !! subroutine unified_ugwp_post_init () end subroutine unified_ugwp_post_init -!>@brief The subroutine initializes the CIRES UGWP +!>@brief The subroutine initializes the unified UGWP #if 0 !> \section arg_table_unified_ugwp_post_run Argument Table !! \htmlinclude unified_ugwp_post_run.html From 57d1b4d9f4a77bc5c0b8dcc797c0bfa7249a78cb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 13 Oct 2020 20:14:21 -0600 Subject: [PATCH 077/274] Bugfixes following update from master --- physics/GFS_rrtmg_pre.F90 | 10 +- physics/GFS_rrtmg_pre.meta | 10 +- physics/moninedmf.f | 4 +- physics/radiation_clouds.f | 883 +++++++++++++++++++------------------ physics/radlw_main.F90 | 2 +- 5 files changed, 466 insertions(+), 443 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 9bde61c62..109df3b65 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -27,7 +27,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & lmfdeep2, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, tsfc, slmsk, & prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, & - cnvw_in, cnvc_in, qgrs, aer_nm, dx, & !inputs from here and above + cnvw_in, cnvc_in, qgrs, aer_nm, dx, icloud, & !inputs from here and above coszen, coszdg, effrl_inout, effri_inout, effrs_inout, & clouds1, clouds2, clouds3, clouds4, clouds5, & !in/out from here and above kd, kt, kb, mtopa, mbota, raddt, tsfg, tsfa, de_lgth, alb1d, delp, dz, & !output from here and below @@ -91,7 +91,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & imp_physics_zhao_carr_pdf, & imp_physics_mg, imp_physics_wsm6, & imp_physics_fer_hires, & - yearlen + yearlen, icloud character(len=3), dimension(:), intent(in) :: lndp_var_list @@ -104,7 +104,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & coslat, sinlat, tsfc, & - slmsk + slmsk, dx real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, prslk, & tgrs, sfc_wts, & @@ -846,7 +846,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & endif !mz HWRF physics: icloud=3 - if(Model%icloud == 3) then + if(icloud == 3) then ! Set internal dimensions ids = 1 @@ -1023,7 +1023,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & else ! MYNN PBL or GF convective are not used - call progcld5 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs + call progcld6 (plyr,plvl,tlyr,qlyr,qstl,rhly,tracer1, & ! --- inputs xlat,xlon,slmsk,dz,delp, & ntrac-1, ntcw-1,ntiw-1,ntrw-1, & ntsw-1,ntgl-1, & diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index f3571b49d..2876f295d 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -675,11 +675,19 @@ standard_name = cell_size long_name = relative dx for the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[icloud] + standard_name = cloud_effect_to_optical_depth_and_cloud_fraction + long_name = cloud effect to the optical depth and cloud fraction in radiation + units = flag + dimensions = () + type = integer + intent = in + optional = F [coszen] standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period diff --git a/physics/moninedmf.f b/physics/moninedmf.f index 4951c7056..d5cb2ded3 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -65,7 +65,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & & xkzminv,moninq_fac,hurr_pbl,islimsk,var_ric, & - & coef_ric_l,coef_ric_s,lssav,ldiag3d,qdiag3d,lsidea,ntoz, & + & coef_ric_l,coef_ric_s,lssav,ldiag3d,qdiag3d,ntoz, & & du3dt_PBL,dv3dt_PBL,dt3dt_PBL,dq3dt_PBL,do3dt_PBL, & & flag_for_pbl_generic_tend,errmsg,errflg) ! @@ -82,7 +82,7 @@ subroutine hedmf_run (im,km,ntrac,ntcw,dv,du,tau,rtg, & ! arguments ! logical, intent(in) :: lprnt, hurr_pbl, lssav, ldiag3d, qdiag3d - logical, intent(in) :: lsidea, flag_for_pbl_generic_tend + logical, intent(in) :: flag_for_pbl_generic_tend integer, intent(in) :: ipr, islimsk(im) integer, intent(in) :: im, km, ntrac, ntcw, kinver(im), ntoz integer, intent(out) :: kpbl(im) diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 160b47167..552037da2 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -198,7 +198,7 @@ !! !! Sub-grid cloud approximation (namelist control parameter - \b ISUBC_LW=2, \b ISUBC_SW=2) !!\n ISUBC=0: grid averaged quantities, without sub-grid cloud approximation -!!\n ISUBC=1: with McICA sub-grid approximation (use prescribed permutation seeds) +!!\n ISUBC=1: with McICA sub-grid approximation (use prescribed permutation seeds) !!\n ISUBC=2: with McICA sub-grid approximation (use random permutation seeds) !! !!\version NCEP-Radiation_clouds v5.1 Nov 2012 @@ -206,7 +206,7 @@ !! @} !> This module computes cloud related quantities for radiation computations. - module module_radiation_clouds + module module_radiation_clouds ! use physparam, only : icldflg, iovrsw, iovrlw, & & lcrick, lcnorm, lnoprec, & @@ -657,7 +657,7 @@ subroutine progcld1 & enddo endif -!> - Compute SFC/low/middle/high cloud top pressure for each cloud +!> - Compute SFC/low/middle/high cloud top pressure for each cloud !! domain for given latitude. ! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; ! --- i=1,2 are low-lat (<45 degree) and pole regions) @@ -786,14 +786,14 @@ subroutine progcld1 & enddo endif -!> - Compute effective ice cloud droplet radius following Heymsfield +!> - Compute effective ice cloud droplet radius following Heymsfield !! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. if(.not.effr_in) then do k = 1, NLAY do i = 1, IX tem2 = tlyr(i,k) - con_ttp - + if (cip(i,k) > 0.0) then tem3 = gord * cip(i,k) * plyr(i,k) / (delp(i,k)*tvly(i,k)) @@ -840,7 +840,7 @@ subroutine progcld1 & endif !> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then + if ( iovr == 4 .or. iovr == 5 ) then call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & @@ -851,8 +851,8 @@ subroutine progcld1 & !> - Call gethml() to compute low,mid,high,total, and boundary layer !! cloud fractions and clouds top/bottom layer indices for low, mid, -!! and high clouds. The three cloud domain boundaries are defined by -!! ptopc. The cloud overlapping method is defined by control flag +!! and high clouds. The three cloud domain boundaries are defined by +!! ptopc. The cloud overlapping method is defined by control flag !! 'iovr', which may be different for lw and sw radiation programs. call gethml & ! --- inputs: @@ -893,7 +893,7 @@ end subroutine progcld1 !!\param delp (IX,NLAY), model layer pressure thickness in mb (100Pa) !!\param IX horizontal dimention !!\param NLAY,NLP1 vertical layer/level dimensions -!!\param lmfshal flag for mass-flux shallow convection scheme in the cloud fraction calculation +!!\param lmfshal flag for mass-flux shallow convection scheme in the cloud fraction calculation !!\param lmfdeep2 flag for mass-flux deep convection scheme in the cloud fraction calculation !!\param dzlay(ix,nlay) distance between model layer centers !!\param latdeg(ix) latitude (in degrees 90 -> -90) @@ -917,9 +917,9 @@ end subroutine progcld1 !> @{ subroutine progcld2 & & ( plyr,plvl,tlyr,qlyr,qstl,rhly,tvly,clw, & ! --- inputs: - & xlat,xlon,slmsk,dz,delp, & + & xlat,xlon,slmsk,dz,delp, & & ntrac, ntcw, ntiw, ntrw, & - & IX, NLAY, NLP1, lmfshal, lmfdeep2, & + & IX, NLAY, NLP1, lmfshal, lmfdeep2, & & dzlay, latdeg, julian, yearlen, & & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) @@ -1111,7 +1111,7 @@ subroutine progcld2 & enddo !> - Compute cloud ice effective radii - + do k = 1, NLAY do i = 1, IX tem2 = tlyr(i,k) - con_ttp @@ -1219,7 +1219,7 @@ subroutine progcld2 & clouds(i,k,3) = rew(i,k) clouds(i,k,4) = cip(i,k) clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson + clouds(i,k,6) = crp(i,k) ! added for Thompson clouds(i,k,7) = rer(i,k) clouds(i,k,8) = csp(i,k) ! added for Thompson clouds(i,k,9) = res(i,k) @@ -1236,7 +1236,7 @@ subroutine progcld2 & endif !> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then + if ( iovr == 4 .or. iovr == 5 ) then call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & @@ -1295,7 +1295,7 @@ end subroutine progcld2 !!\param nlay,nlp1 vertical layer/level dimensions !!\param deltaq (ix,nlay), half total water distribution width !!\param sup supersaturation -!!\param kdt +!!\param kdt !!\param me print control flag !!\param dzlay(ix,nlay) distance between model layer centers !!\param latdeg(ix) latitude (in degrees 90 -> -90) @@ -1663,7 +1663,7 @@ subroutine progcld3 & endif !> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then + if ( iovr == 4 .or. iovr == 5 ) then call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & @@ -1699,7 +1699,7 @@ end subroutine progcld3 !----------------------------------- !> \ingroup module_radiation_clouds -!> This subroutine computes cloud related quantities using +!> This subroutine computes cloud related quantities using !! GFDL Lin MP prognostic cloud microphysics scheme. !!\param plyr (ix,nlay), model layer mean pressure in mb (100Pa) !!\param plvl (ix,nlp1), model level pressure in mb (100Pa) @@ -1726,7 +1726,7 @@ end subroutine progcld3 !!\param julian day of the year (fractional julian day) !!\param yearlen current length of the year (365/366 days) !!\param clouds (ix,nlay,nf_clds), cloud profiles -!!\n clouds(:,:,1) - layer total cloud fraction +!!\n clouds(:,:,1) - layer total cloud fraction !!\n clouds(:,:,2) - layer cloud liquid water path (\f$g m^{-2}\f$) !!\n clouds(:,:,3) - mean effective radius for liquid cloud (micron) !!\n clouds(:,:,4) - layer cloud ice water path (\f$g m^{-2}\f$) @@ -1742,10 +1742,10 @@ end subroutine progcld3 !!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progcld4 progcld4 General Algorithm !! @{ - subroutine progcld4 & + subroutine progcld4 & & ( plyr,plvl,tlyr,tvly,qlyr,qstl,rhly,clw,cnvw,cnvc, & ! --- inputs: & xlat,xlon,slmsk,cldtot, dz, delp, & - & IX, NLAY, NLP1, & + & IX, NLAY, NLP1, & & dzlay, latdeg, julian, yearlen, & & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) @@ -2026,7 +2026,7 @@ subroutine progcld4 & endif !> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then + if ( iovr == 4 .or. iovr == 5 ) then call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & @@ -2102,9 +2102,9 @@ end subroutine progcld4 !!\n clouds(:,:,8) - layer snow flake water path (\f$g m^{-2}\f$) !!\n clouds(:,:,9) - mean effective radius for snow flake (micron) !>\param clds (ix,5), fraction of clouds for low, mid, hi, tot, bl -!>\param mtop (ix,3), vertical indices for low, mid, hi cloud tops +!>\param mtop (ix,3), vertical indices for low, mid, hi cloud tops !>\param mbot (ix,3), vertical indices for low, mid, hi cloud bases -!>\param de_lgth clouds decorrelation length (km) +!>\param de_lgth clouds decorrelation length (km) !!\param alpha (IX,NLAY), alpha decorrelation parameter !>\section gen_progcld4o progcld4o General Algorithm !! @{ @@ -2363,7 +2363,7 @@ subroutine progcld4o & clouds(i,k,3) = rew(i,k) clouds(i,k,4) = cip(i,k) clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) + clouds(i,k,6) = crp(i,k) clouds(i,k,7) = rer(i,k) clouds(i,k,8) = csp(i,k) clouds(i,k,9) = rei(i,k) @@ -2380,7 +2380,7 @@ subroutine progcld4o & endif !> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then + if ( iovr == 4 .or. iovr == 5 ) then call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & @@ -2513,12 +2513,12 @@ subroutine progcld5 & ! --- inputs integer, intent(in) :: IX, NLAY, NLP1, ICLOUD - integer, intent(in) :: ntrac, ntcw, ntiw, ntrw + integer, intent(in) :: ntrac, ntcw, ntiw, ntrw logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz + & tlyr, tvly, qlyr, qstl, rhly, cldcov, delp, dz, dzlay real (kind=kind_phys), dimension(:,:), intent(inout) :: & & re_cloud, re_ice, re_snow @@ -2577,9 +2577,9 @@ subroutine progcld5 & crp (i,k) = 0.0 csp (i,k) = 0.0 rew (i,k) = re_cloud(i,k) - rei (i,k) = re_ice(i,k) + rei (i,k) = re_ice(i,k) rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = re_snow(i,K) + res (i,k) = re_snow(i,K) ! tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) clwf(i,k) = 0.0 enddo @@ -2605,7 +2605,7 @@ subroutine progcld5 & do k = 1, NLAY do i = 1, IX - clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) enddo enddo !> - Find top pressure for each cloud domain for given latitude. @@ -2726,7 +2726,7 @@ subroutine progcld5 & enddo enddo endif -!mz +!mz if (icloud .ne. 0) then ! assign/calculate efective radii for cloud water, ice, rain, snow @@ -2748,7 +2748,7 @@ subroutine progcld5 & endif enddo -!> -# Compute effective ice cloud droplet radius following Heymsfield +!> -# Compute effective ice cloud droplet radius following Heymsfield !! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. do k = 1, NLAY @@ -2770,13 +2770,13 @@ subroutine progcld5 & rei(i,k) = max(25.,rei(i,k)) !mz* HWRF endif rei(i,k) = min(rei(i,k), 135.72) !- 1.0315*rei<= 140 microns - enddo - enddo + enddo + enddo -!mz +!mz !> -# Compute effective snow cloud droplet radius - do k = 1, NLAY - do i = 1, IX + do k = 1, NLAY + do i = 1, IX res(i,k) = 10.0 enddo enddo @@ -2790,14 +2790,14 @@ subroutine progcld5 & clouds(i,k,3) = rew(i,k) clouds(i,k,4) = cip(i,k) clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson + clouds(i,k,6) = crp(i,k) ! added for Thompson clouds(i,k,7) = rer(i,k) !mz inflg .ne.5 - clouds(i,k,8) = 0. + clouds(i,k,8) = 0. clouds(i,k,9) = 10. !mz for diagnostics? re_cloud(i,k) = rew(i,k) - re_ice(i,k) = rei(i,k) + re_ice(i,k) = rei(i,k) re_snow(i,k) = 10. enddo @@ -2813,7 +2813,7 @@ subroutine progcld5 & endif !> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then + if ( iovr == 4 .or. iovr == 5 ) then call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & @@ -2856,7 +2856,8 @@ subroutine progcld6 & & IX, NLAY, NLP1, & & uni_cld, lmfshal, lmfdeep2, cldcov, & & re_cloud,re_ice,re_snow, & - & clouds,clds,mtop,mbot,de_lgth & ! --- outputs: + & dzlay, latdeg, julian, yearlen, & + & clouds,clds,mtop,mbot,de_lgth,alpha & ! --- outputs: & ) ! ================= subprogram documentation block ================ ! @@ -2876,296 +2877,301 @@ subroutine progcld6 & ! subprograms called: gethml ! ! ! ! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! ! -! ==================== definition of variables ==================== ! -! ! -! ! -! input variables: ! -! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! -! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! -! tlyr (IX,NLAY) : model layer mean temperature in k ! -! tvly (IX,NLAY) : model layer virtual temperature in k ! -! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! -! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! -! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! -! clw (IX,NLAY,ntrac) : layer cloud condensate amount ! -! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! -! range, otherwise see in-line comment ! -! xlon (IX) : grid longitude in radians (not used) ! -! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! -! dz (ix,nlay) : layer thickness (km) ! -! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! -! IX : horizontal dimention ! -! NLAY,NLP1 : vertical layer/level dimensions ! -! uni_cld : logical - true for cloud fraction from shoc ! -! lmfshal : logical - true for mass flux shallow convection ! -! lmfdeep2 : logical - true for mass flux deep convection ! -! cldcov : layer cloud fraction (used when uni_cld=.true. ! -! ! -! output variables: ! -! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! -! clouds(:,:,1) - layer total cloud fraction ! -! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! -! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! -! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! -! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! -! clouds(:,:,6) - layer rain drop water path not assigned ! -! clouds(:,:,7) - mean eff radius for rain drop (micron) ! -! *** clouds(:,:,8) - layer snow flake water path not assigned ! -! clouds(:,:,9) - mean eff radius for snow flake (micron) ! -! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! -! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! -! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! -! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! -! de_lgth(ix) : clouds decorrelation length (km) ! -! ! -! module variables: ! -! ivflip : control flag of vertical index direction ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! lmfshal : mass-flux shallow conv scheme flag ! -! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! -! lcrick : control flag for eliminating CRICK ! -! =t: apply layer smoothing to eliminate CRICK ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! ! -! ==================== end of description ===================== ! -! +! language: fortran 90 ! +! machine: ibm-sp, sgi ! +! ! +! ! +! ==================== definition of variables ==================== ! +! ! +! ! +! input variables: ! +! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! +! plvl (IX,NLP1) : model level pressure in mb (100Pa) ! +! tlyr (IX,NLAY) : model layer mean temperature in k ! +! tvly (IX,NLAY) : model layer virtual temperature in k ! +! qlyr (IX,NLAY) : layer specific humidity in gm/gm ! +! qstl (IX,NLAY) : layer saturate humidity in gm/gm ! +! rhly (IX,NLAY) : layer relative humidity (=qlyr/qstl) ! +! clw (IX,NLAY,ntrac) : layer cloud condensate amount ! +! xlat (IX) : grid latitude in radians, default to pi/2 -> -pi/2! +! range, otherwise see in-line comment ! +! xlon (IX) : grid longitude in radians (not used) ! +! slmsk (IX) : sea/land mask array (sea:0,land:1,sea-ice:2) ! +! dz (ix,nlay) : layer thickness (km) ! +! delp (ix,nlay) : model layer pressure thickness in mb (100Pa) ! +! IX : horizontal dimention ! +! NLAY,NLP1 : vertical layer/level dimensions ! +! uni_cld : logical - true for cloud fraction from shoc ! +! lmfshal : logical - true for mass flux shallow convection ! +! lmfdeep2 : logical - true for mass flux deep convection ! +! cldcov : layer cloud fraction (used when uni_cld=.true. ! +! ! +! output variables: ! +! clouds(IX,NLAY,NF_CLDS) : cloud profiles ! +! clouds(:,:,1) - layer total cloud fraction ! +! clouds(:,:,2) - layer cloud liq water path (g/m**2) ! +! clouds(:,:,3) - mean eff radius for liq cloud (micron) ! +! clouds(:,:,4) - layer cloud ice water path (g/m**2) ! +! clouds(:,:,5) - mean eff radius for ice cloud (micron) ! +! clouds(:,:,6) - layer rain drop water path not assigned ! +! clouds(:,:,7) - mean eff radius for rain drop (micron) ! +! *** clouds(:,:,8) - layer snow flake water path not assigned ! +! clouds(:,:,9) - mean eff radius for snow flake (micron) ! +! *** fu's scheme need to be normalized by snow density (g/m**3/1.0e6) ! +! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! +! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! +! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! +! de_lgth(ix) : clouds decorrelation length (km) ! +! ! +! module variables: ! +! ivflip : control flag of vertical index direction ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! lmfshal : mass-flux shallow conv scheme flag ! +! lmfdeep2 : scale-aware mass-flux deep conv scheme flag ! +! lcrick : control flag for eliminating CRICK ! +! =t: apply layer smoothing to eliminate CRICK ! +! =f: do not apply layer smoothing ! +! lcnorm : control flag for in-cld condensate ! +! =t: normalize cloud condensate ! +! =f: not normalize cloud condensate ! +! ! +! ==================== end of description ===================== ! +! implicit none ! --- inputs integer, intent(in) :: IX, NLAY, NLP1 integer, intent(in) :: ntrac, ntcw, ntiw, ntrw, ntsw, ntgl - logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 - - real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & - & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, & - & re_cloud, re_ice, re_snow - - real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw - - real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & - & slmsk - -! --- outputs - real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds - - real (kind=kind_phys), dimension(:,:), intent(out) :: clds - real (kind=kind_phys), dimension(:), intent(out) :: de_lgth - - integer, dimension(:,:), intent(out) :: mtop,mbot - -! --- local variables: - real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & - & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf - - real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) + logical, intent(in) :: uni_cld, lmfshal, lmfdeep2 + + real (kind=kind_phys), dimension(:,:), intent(in) :: plvl, plyr, & + & tlyr, qlyr, qstl, rhly, cldcov, delp, dz, dzlay, & + & re_cloud, re_ice, re_snow + + real (kind=kind_phys), dimension(:,:,:), intent(in) :: clw + + real (kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, & + & slmsk + + real(kind=kind_phys), dimension(:), intent(in) :: latdeg + real(kind=kind_phys), intent(in) :: julian + integer, intent(in) :: yearlen + +! --- outputs + real (kind=kind_phys), dimension(:,:,:), intent(out) :: clouds + + real (kind=kind_phys), dimension(:,:), intent(out) :: clds + real (kind=kind_phys), dimension(:), intent(out) :: de_lgth + real (kind=kind_phys), dimension(:,:), intent(out) :: alpha + + integer, dimension(:,:), intent(out) :: mtop,mbot + +! --- local variables: + real (kind=kind_phys), dimension(IX,NLAY) :: cldtot, cldcnv, & + & cwp, cip, crp, csp, rew, rei, res, rer, tem2d, clwf + + real (kind=kind_phys) :: ptop1(IX,NK_CLDS+1), rxlat(ix) real (kind=kind_phys) :: clwmin, clwm, clwt, onemrh, value, & & tem1, tem2, tem3 integer :: i, k, id, nf - -! --- constant values -! real (kind=kind_phys), parameter :: xrc3 = 200. - real (kind=kind_phys), parameter :: xrc3 = 100. - -! -!===> ... begin here - -! - do nf=1,nf_clds - do k=1,nlay - do i=1,ix - clouds(i,k,nf) = 0.0 - enddo - enddo - enddo -! clouds(:,:,:) = 0.0 - - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = 0.0 - cldcnv(i,k) = 0.0 - cwp (i,k) = 0.0 - cip (i,k) = 0.0 - crp (i,k) = 0.0 - csp (i,k) = 0.0 - rew (i,k) = re_cloud(i,k) - rei (i,k) = re_ice(i,k) - rer (i,k) = rrain_def ! default rain radius to 1000 micron - res (i,k) = re_snow(i,K) -! tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) - clwf(i,k) = 0.0 - enddo - enddo -! -! -! if ( lcrick ) then -! do i = 1, IX -! clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) -! clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) -! enddo -! do k = 2, NLAY-1 -! do i = 1, IX -! clwf(i,K) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) -! enddo -! enddo -! else -! do k = 1, NLAY -! do i = 1, IX -! clwf(i,k) = clw(i,k) -! enddo -! enddo -! endif - - do k = 1, NLAY - do i = 1, IX - clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) - enddo - enddo -!> - Find top pressure for each cloud domain for given latitude. -!! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; -!! i=1,2 are low-lat (<45 degree) and pole regions) - - do i =1, IX - rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range -! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range - enddo - - do id = 1, 4 - tem1 = ptopc(id,2) - ptopc(id,1) - - do i =1, IX - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) - enddo - enddo - -!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . - - do k = 1, NLAY - do i = 1, IX - cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) - cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) - crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) - csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * & - & gfac * delp(i,k)) - enddo - enddo - - if (uni_cld) then ! use unified sgs clouds generated outside - do k = 1, NLAY - do i = 1, IX - cldtot(i,k) = cldcov(i,k) - enddo - enddo - - else - + +! --- constant values +! real (kind=kind_phys), parameter :: xrc3 = 200. + real (kind=kind_phys), parameter :: xrc3 = 100. + +! +!===> ... begin here + +! + do nf=1,nf_clds + do k=1,nlay + do i=1,ix + clouds(i,k,nf) = 0.0 + enddo + enddo + enddo +! clouds(:,:,:) = 0.0 + + do k = 1, NLAY + do i = 1, IX + cldtot(i,k) = 0.0 + cldcnv(i,k) = 0.0 + cwp (i,k) = 0.0 + cip (i,k) = 0.0 + crp (i,k) = 0.0 + csp (i,k) = 0.0 + rew (i,k) = re_cloud(i,k) + rei (i,k) = re_ice(i,k) + rer (i,k) = rrain_def ! default rain radius to 1000 micron + res (i,k) = re_snow(i,K) +! tem2d (i,k) = min( 1.0, max( 0.0, (con_ttp-tlyr(i,k))*0.05 ) ) + clwf(i,k) = 0.0 + enddo + enddo +! +! +! if ( lcrick ) then +! do i = 1, IX +! clwf(i,1) = 0.75*clw(i,1) + 0.25*clw(i,2) +! clwf(i,nlay) = 0.75*clw(i,nlay) + 0.25*clw(i,nlay-1) +! enddo +! do k = 2, NLAY-1 +! do i = 1, IX +! clwf(i,K) = 0.25*clw(i,k-1) + 0.5*clw(i,k) + 0.25*clw(i,k+1) +! enddo +! enddo +! else +! do k = 1, NLAY +! do i = 1, IX +! clwf(i,k) = clw(i,k) +! enddo +! enddo +! endif + + do k = 1, NLAY + do i = 1, IX + clwf(i,k) = clw(i,k,ntcw) + clw(i,k,ntiw) + clw(i,k,ntsw) + enddo + enddo +!> - Find top pressure for each cloud domain for given latitude. +!! ptopc(k,i): top presure of each cld domain (k=1-4 are sfc,L,m,h; +!! i=1,2 are low-lat (<45 degree) and pole regions) + + do i =1, IX + rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range +! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range + enddo + + do id = 1, 4 + tem1 = ptopc(id,2) - ptopc(id,1) + + do i =1, IX + ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) + enddo + enddo + +!> - Compute cloud liquid/ice condensate path in \f$ g/m^2 \f$ . + + do k = 1, NLAY + do i = 1, IX + cwp(i,k) = max(0.0, clw(i,k,ntcw) * gfac * delp(i,k)) + cip(i,k) = max(0.0, clw(i,k,ntiw) * gfac * delp(i,k)) + crp(i,k) = max(0.0, clw(i,k,ntrw) * gfac * delp(i,k)) + csp(i,k) = max(0.0, (clw(i,k,ntsw)+clw(i,k,ntgl)) * & + & gfac * delp(i,k)) + enddo + enddo + + if (uni_cld) then ! use unified sgs clouds generated outside + do k = 1, NLAY + do i = 1, IX + cldtot(i,k) = cldcov(i,k) + enddo + enddo + + else + !> - Calculate layer cloud fraction. - clwmin = 0.0 - if (.not. lmfshal) then - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) - - tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) - tem1 = 2000.0 / tem1 - -! tem1 = 1000.0 / tem1 - - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - else - do k = 1, NLAY - do i = 1, IX - clwt = 1.0e-6 * (plyr(i,k)*0.001) -! clwt = 2.0e-6 * (plyr(i,k)*0.001) - - if (clwf(i,k) > clwt) then - onemrh= max( 1.e-10, 1.0-rhly(i,k) ) - clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) -! - tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan - if (lmfdeep2) then - tem1 = xrc3 / tem1 - else - tem1 = 100.0 / tem1 - endif -! - value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(rhly(i,k)) ) - - cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) - endif - enddo - enddo - endif - - endif ! if (uni_cld) then - - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) < climit) then - cldtot(i,k) = 0.0 - cwp(i,k) = 0.0 - cip(i,k) = 0.0 - crp(i,k) = 0.0 - csp(i,k) = 0.0 - endif - enddo - enddo - - if ( lcnorm ) then - do k = 1, NLAY - do i = 1, IX - if (cldtot(i,k) >= climit) then - tem1 = 1.0 / max(climit2, cldtot(i,k)) - cwp(i,k) = cwp(i,k) * tem1 - cip(i,k) = cip(i,k) * tem1 - crp(i,k) = crp(i,k) * tem1 - csp(i,k) = csp(i,k) * tem1 - endif - enddo - enddo - endif - -! - do k = 1, NLAY - do i = 1, IX - clouds(i,k,1) = cldtot(i,k) - clouds(i,k,2) = cwp(i,k) - clouds(i,k,3) = rew(i,k) - clouds(i,k,4) = cip(i,k) - clouds(i,k,5) = rei(i,k) - clouds(i,k,6) = crp(i,k) ! added for Thompson - clouds(i,k,7) = rer(i,k) - clouds(i,k,8) = csp(i,k) ! added for Thompson - clouds(i,k,9) = res(i,k) - enddo - enddo - -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later + clwmin = 0.0 + if (.not. lmfshal) then + do k = 1, NLAY + do i = 1, IX + clwt = 1.0e-6 * (plyr(i,k)*0.001) +! clwt = 2.0e-6 * (plyr(i,k)*0.001) + + if (clwf(i,k) > clwt) then + + onemrh= max( 1.e-10, 1.0-rhly(i,k) ) + clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) + + tem1 = min(max(sqrt(sqrt(onemrh*qstl(i,k))),0.0001),1.0) + tem1 = 2000.0 / tem1 + +! tem1 = 1000.0 / tem1 + + value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhly(i,k)) ) + + cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + else + do k = 1, NLAY + do i = 1, IX + clwt = 1.0e-6 * (plyr(i,k)*0.001) +! clwt = 2.0e-6 * (plyr(i,k)*0.001) + + if (clwf(i,k) > clwt) then + onemrh= max( 1.e-10, 1.0-rhly(i,k) ) + clwm = clwmin / max( 0.01, plyr(i,k)*0.001 ) +! + tem1 = min(max((onemrh*qstl(i,k))**0.49,0.0001),1.0) !jhan + if (lmfdeep2) then + tem1 = xrc3 / tem1 + else + tem1 = 100.0 / tem1 + endif +! + value = max( min( tem1*(clwf(i,k)-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(rhly(i,k)) ) + + cldtot(i,k) = max( tem2*(1.0-exp(-value)), 0.0 ) + endif + enddo + enddo + endif + + endif ! if (uni_cld) then + + do k = 1, NLAY + do i = 1, IX + if (cldtot(i,k) < climit) then + cldtot(i,k) = 0.0 + cwp(i,k) = 0.0 + cip(i,k) = 0.0 + crp(i,k) = 0.0 + csp(i,k) = 0.0 + endif + enddo + enddo + + if ( lcnorm ) then + do k = 1, NLAY + do i = 1, IX + if (cldtot(i,k) >= climit) then + tem1 = 1.0 / max(climit2, cldtot(i,k)) + cwp(i,k) = cwp(i,k) * tem1 + cip(i,k) = cip(i,k) * tem1 + crp(i,k) = crp(i,k) * tem1 + csp(i,k) = csp(i,k) * tem1 + endif + enddo + enddo + endif + +! + do k = 1, NLAY + do i = 1, IX + clouds(i,k,1) = cldtot(i,k) + clouds(i,k,2) = cwp(i,k) + clouds(i,k,3) = rew(i,k) + clouds(i,k,4) = cip(i,k) + clouds(i,k,5) = rei(i,k) + clouds(i,k,6) = crp(i,k) ! added for Thompson + clouds(i,k,7) = rer(i,k) + clouds(i,k,8) = csp(i,k) ! added for Thompson + clouds(i,k,9) = res(i,k) + enddo + enddo + +! --- ... estimate clouds decorrelation length in km +! this is only a tentative test, need to consider change later if ( iovr == 3 ) then do i = 1, ix @@ -3173,9 +3179,19 @@ subroutine progcld6 & enddo endif +!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options + if ( iovr == 4 .or. iovr == 5 ) then + call get_alpha_exp & +! --- inputs: + & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & +! --- outputs: + & alpha & + & ) + endif + !> - Call gethml() to compute low,mid,high,total, and boundary layer -!! cloud fractions and clouds top/bottom layer indices for low, mid, -!! and high clouds. +!! cloud fractions and clouds top/bottom layer indices for low, mid, +!! and high clouds. ! --- compute low, mid, high, total, and boundary layer cloud fractions ! and clouds top/bottom layer indices for low, mid, and high clouds. ! The three cloud domain boundaries are defined by ptopc. The cloud @@ -3184,15 +3200,14 @@ subroutine progcld6 & call gethml & ! --- inputs: - & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, & + & ( plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, & & IX,NLAY, & ! --- outputs: & clds, mtop, mbot & & ) - ! - return + return !............................................ end subroutine progcld6 @@ -3233,9 +3248,9 @@ end subroutine progcld6 !!\n (:,:,3) - mean eff radius for liq cloud (micron) !!\n (:,:,4) - layer cloud ice water path \f$(g/m^2)\f$ !!\n (:,:,5) - mean eff radius for ice cloud (micron) -!!\n (:,:,6) - layer rain drop water path +!!\n (:,:,6) - layer rain drop water path !!\n (:,:,7) - mean eff radius for rain drop (micron) -!!\n (:,:,8) - layer snow flake water path +!!\n (:,:,8) - layer snow flake water path !!\n (:,:,9) - mean eff radius for snow flake (micron) !!\param clds (IX,5), fraction of clouds for low, mid, hi, tot, bl !!\param mtop (IX,3), vertical indices for low, mid, hi cloud tops @@ -3494,7 +3509,7 @@ subroutine progclduni & endif enddo -!> -# Compute effective ice cloud droplet radius following Heymsfield +!> -# Compute effective ice cloud droplet radius following Heymsfield !! and McFarquhar (1996) \cite heymsfield_and_mcfarquhar_1996. do k = 1, NLAY @@ -3562,7 +3577,7 @@ subroutine progclduni & endif !> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then + if ( iovr == 4 .or. iovr == 5 ) then call get_alpha_exp & ! --- inputs: & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & @@ -4034,18 +4049,18 @@ end subroutine gethml ! ######################################################################################### subroutine get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, & & de_lgth, cloud_overlap_param) - + integer, intent(in) :: nCol, nLev real(kind_phys), intent(in) :: con_pi real(kind_phys), dimension(nCol), intent(in) :: lat real(kind_phys), dimension(nCol,nLev),intent(in) :: deltaZ - real(kind_phys), dimension(nCol),intent(out) :: de_lgth + real(kind_phys), dimension(nCol),intent(out) :: de_lgth real(kind_phys), dimension(nCol,nLev),intent(out) :: & & cloud_overlap_param - + ! Local - integer :: iCol, iLay - + integer :: iCol, iLay + do iCol =1,nCol de_lgth(iCol) = max( 0.6, 2.78-4.6*abs(lat(iCol)/con_pi) ) do iLay=nLev,2,-1 @@ -4057,7 +4072,7 @@ subroutine get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, & enddo enddo end subroutine get_alpha_dcorr - + ! ######################################################################################### !> \ingroup module_radiation_clouds !! This program derives the exponential transition, alpha, from maximum to @@ -4065,10 +4080,10 @@ end subroutine get_alpha_dcorr !! for the exponential (EXP, iovrlp=4) or the exponential-random (ER, iovrlp=5) !! cloud overlap options for RRTMG/RRTMGP. For exponential, the transition from !! maximum to random with distance through model layers occurs without regard -!! to the configuration of clear and cloudy layers. For the ER method, each +!! to the configuration of clear and cloudy layers. For the ER method, each !! block of adjacent cloudy layers is treated with a separate transition from !! maximum to random, and blocks of cloudy layers separated by one or more -!! clear layers are correlated randomly. +!! clear layers are correlated randomly. !> /param nlon : number of model longitude points !> /param nlay : vertical layer dimension !> /param dzlay(nlon,nlay) : distance between the center of model layers @@ -4188,21 +4203,21 @@ subroutine get_alpha_exp & ! !===> ... begin here ! -! If exponential or exponential-random cloud overlap is used: +! If exponential or exponential-random cloud overlap is used: ! derive day-of-year and latitude-varying decorrelation lendth if requested; ! otherwise use the constant decorrelation length, decorr_con, specified in physcons.F90 do i = 1, nlon if (iovrlp == 4 .or. iovrlp == 5) then - if (idcor .eq. 1) then + if (idcor .eq. 1) then if (juldat .gt. 181._kind_phys) then am3 = -4._kind_phys * amr * (juldat - 272._kind_phys) & / yearlen else - am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) + am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) & / yearlen endif ! For latitude in degrees, decorr_len in km - decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 + decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 & / am4**2) else decorr_len(i) = decorr_con @@ -4294,17 +4309,17 @@ SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, & !+---+ !..First cut scale-aware. Higher resolution should require closer to -!.. saturated grid box for higher cloud fraction. Simple functions -!.. chosen based on Mocko and Cotton (1995) starting point and desire -!.. to get near 100% RH as grid spacing moves toward 1.0km, but higher -!.. RH over ocean required as compared to over land. - - RH_00L = 0.7 + SQRT(1./(25.0+gridkm*gridkm*gridkm)) - RH_00O = 0.81 + SQRT(1./(50.0+gridkm*gridkm*gridkm)) +!.. saturated grid box for higher cloud fraction. Simple functions +!.. chosen based on Mocko and Cotton (1995) starting point and desire +!.. to get near 100% RH as grid spacing moves toward 1.0km, but higher +!.. RH over ocean required as compared to over land. + + RH_00L = 0.7 + SQRT(1./(25.0+gridkm*gridkm*gridkm)) + RH_00O = 0.81 + SQRT(1./(50.0+gridkm*gridkm*gridkm)) DO j = jts,jte DO k = kts,kte - DO i = its,ite + DO i = its,ite RHI_max = 0.0 CLDFRA(I,K,J) = 0.0 @@ -4377,11 +4392,11 @@ SUBROUTINE cal_cldfra3(CLDFRA, qv, qc, qi, qs, & ENDDO ! if (debug_flag) then -! WRITE (dbg_msg,*) 'DEBUG-GT: finding cloud layers at point (', i, ', ', j, ')' +! WRITE (dbg_msg,*) 'DEBUG-GT: finding cloud layers at point (', i, ', ', j, ')' ! CALL wrf_debug (150, dbg_msg) -! endif +! endif call find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & - & debug_flag, qc1d, qi1d, qs1d, kts,kte) + & debug_flag, qc1d, qi1d, qs1d, kts,kte) DO k = kts,kte cldfra(i,k,j) = cfr1d(k) @@ -4399,7 +4414,7 @@ END SUBROUTINE cal_cldfra3 !.. unless existing LWC/IWC is already there. SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & - & debugfl, qc1d, qi1d, qs1d, kts,kte) + & debugfl, qc1d, qi1d, qs1d, kts,kte) ! IMPLICIT NONE @@ -4439,8 +4454,8 @@ SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & dz(kts) = dz(kts+1) !..Find tropopause height, best surrogate, because we would not really -!.. wish to put fake clouds into the stratosphere. The 10/1500 ratio -!.. d(Theta)/d(Z) approximates a vertical line on typical SkewT chart +!.. wish to put fake clouds into the stratosphere. The 10/1500 ratio +!.. d(Theta)/d(Z) approximates a vertical line on typical SkewT chart !.. near typical (mid-latitude) tropopause height. Since messy data !.. could give us a false signal of such a transition, do the check over !.. three K-level change, not just a level-to-level check. This method @@ -4504,103 +4519,103 @@ SUBROUTINE find_cloudLayers(qvs1d, cfr1d, T1d, P1d, R1d, entrmnt, & in_cloud = .true. k_cldt = MAX(k_cldt, k) endif - if (in_cloud) then - DO k2 = k_cldt-1, k_m12C, -1 - if (cfr1d(k2).lt.0.01 .or. k2.eq.k_m12C) then - k_cldb = k2+1 - goto 87 - endif - ENDDO - 87 continue - in_cloud = .false. - endif - if ((k_cldt - k_cldb + 1) .ge. 2) then -! if (debugfl) then + if (in_cloud) then + DO k2 = k_cldt-1, k_m12C, -1 + if (cfr1d(k2).lt.0.01 .or. k2.eq.k_m12C) then + k_cldb = k2+1 + goto 87 + endif + ENDDO + 87 continue + in_cloud = .false. + endif + if ((k_cldt - k_cldb + 1) .ge. 2) then +! if (debugfl) then ! print*, 'An ice cloud layer is found between ', k_cldt, ! k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 ! WRITE (dbg_msg,*) 'DEBUG-GT: An ice cloud layer is found between ! ', k_cldt, k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 -! CALL wrf_debug (150, dbg_msg) -! endif +! CALL wrf_debug (150, dbg_msg) +! endif call adjust_cloudIce(cfr1d, qi1d, qs1d, qvs1d, T1d,R1d,dz, & - & entrmnt, k_cldb,k_cldt,kts,kte) - k = k_cldb - else + & entrmnt, k_cldb,k_cldt,kts,kte) + k = k_cldb + else if (cfr1d(k_cldb).gt.0.and.qi1d(k_cldb).lt.1.E-6) & - & qi1d(k_cldb)=1.E-5*cfr1d(k_cldb) - endif - - - k = k - 1 - ENDDO - - - - k_cldb = k_tropo - in_cloud = .false. - k = k_m12C + 2 - DO WHILE (.not. in_cloud .AND. k.gt.kbot) - k_cldt = 0 - if (cfr1d(k).ge.0.01) then - in_cloud = .true. - k_cldt = MAX(k_cldt, k) - endif - if (in_cloud) then - DO k2 = k_cldt-1, kbot, -1 - if (cfr1d(k2).lt.0.01 .or. k2.eq.kbot) then - k_cldb = k2+1 - goto 88 - endif - ENDDO - 88 continue - in_cloud = .false. - endif - if ((k_cldt - k_cldb + 1) .ge. 2) then -! if (debugfl) then + & qi1d(k_cldb)=1.E-5*cfr1d(k_cldb) + endif + + + k = k - 1 + ENDDO + + + + k_cldb = k_tropo + in_cloud = .false. + k = k_m12C + 2 + DO WHILE (.not. in_cloud .AND. k.gt.kbot) + k_cldt = 0 + if (cfr1d(k).ge.0.01) then + in_cloud = .true. + k_cldt = MAX(k_cldt, k) + endif + if (in_cloud) then + DO k2 = k_cldt-1, kbot, -1 + if (cfr1d(k2).lt.0.01 .or. k2.eq.kbot) then + k_cldb = k2+1 + goto 88 + endif + ENDDO + 88 continue + in_cloud = .false. + endif + if ((k_cldt - k_cldb + 1) .ge. 2) then +! if (debugfl) then ! print*, 'A water cloud layer is found between ', k_cldt, ! k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 ! WRITE (dbg_msg,*) 'DEBUG-GT: A water cloud layer is found ! between ', k_cldt, k_cldb, P1d(k_cldt)*0.01, P1d(k_cldb)*0.01 -! CALL wrf_debug (150, dbg_msg) -! endif +! CALL wrf_debug (150, dbg_msg) +! endif call adjust_cloudH2O(cfr1d, qc1d, qvs1d, T1d,R1d,dz, & - & entrmnt, k_cldb,k_cldt,kts,kte) - k = k_cldb - else + & entrmnt, k_cldb,k_cldt,kts,kte) + k = k_cldb + else if (cfr1d(k_cldb).gt.0.and.qc1d(k_cldb).lt.1.E-6) & - & qc1d(k_cldb)=1.E-5*cfr1d(k_cldb) - endif - k = k - 1 - ENDDO - + & qc1d(k_cldb)=1.E-5*cfr1d(k_cldb) + endif + k = k - 1 + ENDDO + !..Do a final total column adjustment since we may have added more than -!1mm -!.. LWP/IWP for multiple cloud decks. - - call adjust_cloudFinal(cfr1d, qc1d, qi1d, R1d,dz, kts,kte,k_tropo) - -! if (debugfl) then -! print*, ' Made-up fake profile of clouds' -! do k = kte, kts, -1 +!1mm +!.. LWP/IWP for multiple cloud decks. + + call adjust_cloudFinal(cfr1d, qc1d, qi1d, R1d,dz, kts,kte,k_tropo) + +! if (debugfl) then +! print*, ' Made-up fake profile of clouds' +! do k = kte, kts, -1 ! write(*,'(i3, 2x, f8.2, 2x, f9.2, 2x, f6.2, 2x, f15.7, 2x, -! f15.7)') & +! f15.7)') & ! & K, T1d(k)-273.15, P1d(k)*0.01, cfr1d(k)*100., -! qc1d(k)*1000.,qi1d(k)*1000. -! enddo -! WRITE (dbg_msg,*) 'DEBUG-GT: Made-up fake profile of clouds' -! CALL wrf_debug (150, dbg_msg) -! do k = kte, kts, -1 +! qc1d(k)*1000.,qi1d(k)*1000. +! enddo +! WRITE (dbg_msg,*) 'DEBUG-GT: Made-up fake profile of clouds' +! CALL wrf_debug (150, dbg_msg) +! do k = kte, kts, -1 ! write(dbg_msg,'(f8.2, 2x, f9.2, 2x, f6.2, 2x, f15.7, 2x, -! f15.7)') & +! f15.7)') & ! & T1d(k)-273.15, P1d(k)*0.01, cfr1d(k)*100., -! qc1d(k)*1000.,qi1d(k)*1000. -! CALL wrf_debug (150, dbg_msg) -! enddo -! endif - - - END SUBROUTINE find_cloudLayers - +! qc1d(k)*1000.,qi1d(k)*1000. +! CALL wrf_debug (150, dbg_msg) +! enddo +! endif + + + END SUBROUTINE find_cloudLayers + !+---+-----------------------------------------------------------------+ SUBROUTINE adjust_cloudIce(cfr,qi,qs,qvs, T,Rho,dz, entr, k1,k2, & diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index 0bfc332ab..daa20e45d 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -1713,7 +1713,7 @@ end subroutine rlwinit !> @{ subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & nlay, nlp1, ipseed, dz, de_lgth, iovrlw, alpha & + & nlay, nlp1, ipseed, dz, de_lgth, iovrlw, alpha, & & cldfmc, taucld & ! --- outputs & ) From b580c58233620793d530e419d17604b592a9eb7f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 16 Oct 2020 09:14:10 -0600 Subject: [PATCH 078/274] Always calculate Julian day, since it is getting used by more and more parameterizations --- physics/GFS_time_vary_pre.fv3.F90 | 67 +++++++++++++++--------------- physics/GFS_time_vary_pre.scm.F90 | 68 +++++++++++++++---------------- 2 files changed, 65 insertions(+), 70 deletions(-) diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/GFS_time_vary_pre.fv3.F90 index dc9332bb9..27e36b649 100644 --- a/physics/GFS_time_vary_pre.fv3.F90 +++ b/physics/GFS_time_vary_pre.fv3.F90 @@ -121,41 +121,38 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lkm, lsm, lsm_noahmp, nsswr, fhour = (sec + dtp)/con_hr kdt = nint((sec + dtp)/dtp) - if(lsm == lsm_noahmp .or. lkm == 1) then -! flake need this too - !GJF* These calculations were originally in GFS_physics_driver.F90 for - ! NoahMP. They were moved to this routine since they only depend - ! on time (not space). Note that this code is included as-is from - ! GFS_physics_driver.F90, but it may be simplified by using more - ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day - ! of year and W3DIFDAT to determine the integer number of days in - ! a given year). *GJF - ! Julian day calculation (fcst day of the year) - ! we need yearln and julian to - ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 - ! jdat is changing - ! - - jd1 = iw3jdn(jdat(1),jdat(2),jdat(3)) - jd0 = iw3jdn(jdat(1),1,1) - fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 - - julian = float(jd1-jd0) + fjd - - ! - ! Year length - ! - ! what if the integration goes from one year to another? - ! iyr or jyr ? from 365 to 366 or from 366 to 365 - ! - ! is this against model's noleap yr assumption? - if (mod(jdat(1),4) == 0) then - yearlen = 366 - if (mod(jdat(1),100) == 0) then - yearlen = 365 - if (mod(jdat(1),400) == 0) then - yearlen = 366 - endif + !GJF* These calculations were originally in GFS_physics_driver.F90 for + ! NoahMP. They were moved to this routine since they only depend + ! on time (not space). Note that this code is included as-is from + ! GFS_physics_driver.F90, but it may be simplified by using more + ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day + ! of year and W3DIFDAT to determine the integer number of days in + ! a given year). *GJF + ! Julian day calculation (fcst day of the year) + ! we need yearln and julian to + ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 + ! jdat is changing + ! + + jd1 = iw3jdn(jdat(1),jdat(2),jdat(3)) + jd0 = iw3jdn(jdat(1),1,1) + fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 + + julian = float(jd1-jd0) + fjd + + ! + ! Year length + ! + ! what if the integration goes from one year to another? + ! iyr or jyr ? from 365 to 366 or from 366 to 365 + ! + ! is this against model's noleap yr assumption? + if (mod(jdat(1),4) == 0) then + yearlen = 366 + if (mod(jdat(1),100) == 0) then + yearlen = 365 + if (mod(jdat(1),400) == 0) then + yearlen = 366 endif endif endif diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index 2fa352710..ad98b14e3 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -122,44 +122,42 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & fhour = (sec + dtp)/con_hr kdt = nint((sec + dtp)/dtp) - if(lsm == lsm_noahmp) then - !GJF* These calculations were originally in GFS_physics_driver.F90 for - ! NoahMP. They were moved to this routine since they only depends - ! on time (not space). Note that this code is included as-is from - ! GFS_physics_driver.F90, but it may be simplified by using more - ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day - ! of year and W3DIFDAT to determine the integer number of days in - ! a given year). *GJF - ! Julian day calculation (fcst day of the year) - ! we need yearln and julian to - ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 - ! jdat is changing - ! - - jd1 = iw3jdn(jdat(1),jdat(2),jdat(3)) - jd0 = iw3jdn(jdat(1),1,1) - fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 - - julian = float(jd1-jd0) + fjd - - ! - ! Year length - ! - ! what if the integration goes from one year to another? - ! iyr or jyr ? from 365 to 366 or from 366 to 365 - ! - ! is this against model's noleap yr assumption? - if (mod(jdat(1),4) == 0) then - yearlen = 366 - if (mod(jdat(1),100) == 0) then - yearlen = 365 - if (mod(jdat(1),400) == 0) then - yearlen = 366 - endif + !GJF* These calculations were originally in GFS_physics_driver.F90 for + ! NoahMP. They were moved to this routine since they only depends + ! on time (not space). Note that this code is included as-is from + ! GFS_physics_driver.F90, but it may be simplified by using more + ! NCEP W3 library calls (e.g., see W3DOXDAT, W3FS13 for Julian day + ! of year and W3DIFDAT to determine the integer number of days in + ! a given year). *GJF + ! Julian day calculation (fcst day of the year) + ! we need yearln and julian to + ! pass to noah mp sflx, idate is init, jdat is fcst;idate = jdat when kdt=1 + ! jdat is changing + ! + + jd1 = iw3jdn(jdat(1),jdat(2),jdat(3)) + jd0 = iw3jdn(jdat(1),1,1) + fjd = float(jdat(5))/24.0 + float(jdat(6))/1440.0 + + julian = float(jd1-jd0) + fjd + + ! + ! Year length + ! + ! what if the integration goes from one year to another? + ! iyr or jyr ? from 365 to 366 or from 366 to 365 + ! + ! is this against model's noleap yr assumption? + if (mod(jdat(1),4) == 0) then + yearlen = 366 + if (mod(jdat(1),100) == 0) then + yearlen = 365 + if (mod(jdat(1),400) == 0) then + yearlen = 366 endif endif endif - + ipt = 1 lprnt = .false. lssav = .true. From 590d110c28cefa0829516bfbb26d299f3f9eda55 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 16 Oct 2020 22:05:36 +0000 Subject: [PATCH 079/274] Reinstated sea ice option in RUC LSM. Additional CALL to LSMRUC for sea ice is added to sfc_drv_ruc.F90. --- physics/GFS_surface_composites.F90 | 2 +- physics/sfc_drv_ruc.F90 | 1014 ++++++++++++++++++---------- physics/sfc_drv_ruc.meta | 796 ++++++++++++++-------- 3 files changed, 1163 insertions(+), 649 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index b3000b008..fda69bfa2 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -574,7 +574,7 @@ subroutine GFS_surface_composites_post_run ( tsfco(i) = tsfc(i) endif tsfcl(i) = tsfc(i) - do k=1,kice ! store tiice in stc to reduce output in the nonfrac grid case + do k=1,min(kice,km) ! store tiice in stc to reduce output in the nonfrac grid case stc(i,k)=tiice(i,k) end do endif diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 7af8c3497..02d197fbd 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -191,7 +191,6 @@ end subroutine lsm_ruc_finalize ! soiltyp - integer, soil type (integer index) im ! ! vegtype - integer, vegetation type (integer index) im ! ! sigmaf - real, areal fractional cover of green vegetation im ! -! sfcemis - real, sfc lw emissivity ( fraction ) im ! ! dlwflx - real, total sky sfc downward lw flux ( w/m**2 ) im ! ! dswflx - real, total sky sfc downward sw flux ( w/m**2 ) im ! ! snet - real, total sky sfc netsw flx into ground(w/m**2) im ! @@ -252,25 +251,44 @@ end subroutine lsm_ruc_finalize !! !>\section gen_lsmruc GSD RUC LSM General Algorithm subroutine lsm_ruc_run & ! inputs - & ( iter, me, master, kdt, im, nlev, lsoil_ruc, lsoil, zs, & + & ( iter, me, master, delt, kdt, im, nlev, lsm_ruc, lsm, & + & imp_physics, imp_physics_gfdl, imp_physics_thompson, & + & do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, & & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & - & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & + & dlwflx, dswsfc, snet, tg3, & + & land, icy, lake, & + & rainnc, rainc, ice, snow, graupel, & & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & - & snoalb, sfalb, flag_iter, flag_guess, isot, ivegsrc, fice, & - & smc, stc, slc, lsm_ruc, lsm, land, islimsk, rdlai, & - & imp_physics, imp_physics_gfdl, imp_physics_thompson, & - & smcwlt2, smcref2, do_mynnsfclay, & - & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, con_fvirt,& ! constants - & weasd, snwdph, tskin, tskin_wat, & ! in/outs - & rainnc, rainc, ice, snow, graupel, & ! in - & srflag, smois, tslb, sh2o, keepfr, smfrkeep, & ! in/outs, on RUC levels - & canopy, trans, tsurf, tsnow, zorl, & - & sfcqc, sfcdew, tice, sfcqv, & - & sncovr1, qsurf, gflux, drain, evap, hflx, & ! outputs - & rhosnf, runof, runoff, srunoff, & - & chh, cmm, evbs, evcw, sbsno, stm, wetness, & - & acsnow, snowfallac, & - & flag_init, flag_restart, errmsg, errflg & + & srflag, snoalb, isot, ivegsrc, fice, smcwlt2, smcref2, & + & smc, stc, slc, & + ! --- constants + & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, & + & con_fvirt, & + ! for water + & ch_wat, tskin_wat, & + ! --- in/outs for ice and land + & semis_lnd, semis_ice, & + & sncovr1_lnd, weasd_lnd, snwdph_lnd, tskin_lnd, sfalb_lnd, & + & sncovr1_ice, weasd_ice, snwdph_ice, tskin_ice, sfalb_ice, & + ! for land + & smois, tsice, tslb, sh2o, keepfr, smfrkeep, & ! on RUC levels + & canopy, trans, tsurf_lnd, tsnow_lnd, z0rl_lnd, & + & sfcqc_lnd, sfcdew_lnd, sfcqv_lnd, & + & qsurf_lnd, gflux_lnd, evap_lnd, hflx_lnd, & + & runof, runoff, srunoff, drain, & + & cm_lnd, ch_lnd, evbs, evcw, stm, wetness, & + & snowfallac_lnd, & + ! for ice + & sfcqc_ice, sfcdew_ice, sfcqv_ice, & + & tice, tsurf_ice, tsnow_ice, z0rl_ice, & + & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, & + & cm_ice, ch_ice, snowfallac_ice, & + ! --- out + & acsnow, rhosnf, sbsno, & + & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & + ! + & flag_iter, flag_guess, flag_init, flag_restart, & + & flag_cice, frac_grid, errmsg, errflg & & ) implicit none @@ -278,6 +296,9 @@ subroutine lsm_ruc_run & ! inputs ! --- constant parameters: real(kind=kind_phys), parameter :: rhoh2o = 1000.0 real(kind=kind_phys), parameter :: stbolt = 5.670400e-8 + real(kind=kind_phys), parameter :: cimin = 0.15 !--- in GFS + !real(kind=kind_phys), parameter :: cimin = 0.02 !--- minimum ice concentration, 0.15 in GFS + real(kind=kind_phys), parameter :: con_tice = 271.2 ! --- input: integer, intent(in) :: me, master @@ -287,20 +308,26 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: smc,stc,slc - real (kind=kind_phys), dimension(im), intent(in) :: & - & t1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & - & ch, prsl1, wind, shdmin, shdmax, & - & snoalb, alvwf, alnwf, zf, qc, q1 - - real (kind=kind_phys), dimension(:), intent(in) :: laixy + real (kind=kind_phys), dimension(im), intent(in) :: & + & t1, sigmaf, laixy, dlwflx, dswsfc, snet, tg3, & + & prsl1, wind, shdmin, shdmax, & + & snoalb, alvwf, alnwf, zf, qc, q1, & + ! for land + & cm_lnd, ch_lnd, & + ! for water + & ch_wat, tskin_wat, & + ! for ice + & cm_ice, ch_ice real (kind=kind_phys), intent(in) :: delt - real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & - con_pi, con_rd, & + real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & + con_pi, con_rd, & con_hvap, con_fvirt - logical, dimension(im), intent(in) :: flag_iter, flag_guess, land - integer, dimension(im), intent(in) :: islimsk ! sea/land/ice mask (=0/1/2) + logical, dimension(im), intent(in) :: flag_iter, flag_guess + logical, dimension(im), intent(in) :: land, icy, lake + logical, dimension(im), intent(in) :: flag_cice + logical, intent(in) :: frac_grid logical, intent(in) :: do_mynnsfclay logical, intent(in) :: rdlai @@ -308,61 +335,97 @@ subroutine lsm_ruc_run & ! inputs ! --- in/out: integer, dimension(im), intent(inout) :: soiltyp, vegtype real (kind=kind_phys), dimension(lsoil_ruc), intent(in) :: zs - real (kind=kind_phys), dimension(im), intent(inout) :: weasd, & - & snwdph, tskin, tskin_wat, & - & srflag, canopy, trans, tsurf, zorl, tsnow, & - & sfcqc, sfcqv, sfcdew, fice, tice, sfalb, smcwlt2, smcref2 + real (kind=kind_phys), dimension(im), intent(inout) :: srflag, & + & canopy, trans, smcwlt2, smcref2, & + ! for land + & weasd_lnd, snwdph_lnd, tskin_lnd, & + & tsurf_lnd, z0rl_lnd, tsnow_lnd, & + & sfcqc_lnd, sfcqv_lnd, sfcdew_lnd, sfalb_lnd, & + ! for ice + & weasd_ice, snwdph_ice, tskin_ice, & + & tsurf_ice, z0rl_ice, tsnow_ice, & + & sfcqc_ice, sfcqv_ice, sfcdew_ice, fice, tice, sfalb_ice + ! --- in real (kind=kind_phys), dimension(im), intent(in) :: & & rainnc, rainc, ice, snow, graupel ! --- in/out: ! --- on RUC levels - real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: & - & smois, tslb, sh2o, keepfr, smfrkeep + real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: & + & smois, tsice, tslb, sh2o, keepfr, smfrkeep ! --- output: - real (kind=kind_phys), dimension(im), intent(inout) :: sncovr1, & - & qsurf , gflux , evap , runof , drain , & - & runoff, srunoff, hflx, cmm, chh, & - & rhosnf, evbs, evcw, sbsno, stm, wetness, & - & acsnow, snowfallac + real (kind=kind_phys), dimension(im), intent(inout) :: acsnow, & + & rhosnf, runof, drain, runoff, srunoff, evbs, evcw, & + & stm, wetness, semis_lnd, semis_ice, & + ! for land + & sncovr1_lnd, qsurf_lnd, gflux_lnd, evap_lnd, & + & cmm_lnd, chh_lnd, hflx_lnd, sbsno, & + & snowfallac_lnd, & + ! for ice + & sncovr1_ice, qsurf_ice, gflux_ice, evap_ice, ep1d_ice, & + & cmm_ice, chh_ice, hflx_ice, snowfallac_ice logical, intent(in) :: flag_init, flag_restart character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- locals: - real (kind=kind_phys), dimension(im) :: rch, rho, & - & q0, qs1, weasd_old, snwdph_old, & - & tprcp_old, srflag_old, tskin_old, canopy_old, & - & tsnow_old, snowfallac_old, acsnow_old, sfalb_old, & - & sfcqv_old, sfcqc_old, wetness_old, zorl_old, sncovr1_old + real (kind=kind_phys), dimension(im) :: rho, & + & q0, qs1, & + & tprcp_old, srflag_old, sr_old, canopy_old, & + & acsnow_old, wetness_old, & + ! for land + & weasd_lnd_old, snwdph_lnd_old, tskin_lnd_old, & + & tsnow_lnd_old, snowfallac_lnd_old, sfalb_lnd_old, & + & sfcqv_lnd_old, sfcqc_lnd_old, z0rl_lnd_old, & + & sncovr1_lnd_old, & + ! for ice + & weasd_ice_old, snwdph_ice_old, tskin_ice_old, & + & tsnow_ice_old, snowfallac_ice_old, sfalb_ice_old, & + & sfcqv_ice_old, sfcqc_ice_old, z0rl_ice_old, & + & sncovr1_ice_old + real (kind=kind_phys), dimension(lsoil_ruc) :: et real (kind=kind_phys), dimension(im,lsoil_ruc,1) :: smsoil, & - slsoil, stsoil, smfrsoil, keepfrsoil + slsoil, stsoil, smfrsoil, keepfrsoil, stsice real (kind=kind_phys), dimension(im,lsoil_ruc) :: smois_old, & - & tslb_old, sh2o_old, keepfr_old, smfrkeep_old + & tsice_old, tslb_old, sh2o_old, & + & keepfr_old, smfrkeep_old real (kind=kind_phys),dimension (im,1,1) :: & & conflx2, sfcprs, sfctmp, q2, qcatm, rho2 real (kind=kind_phys),dimension (im,1) :: & - & albbck, alb, chs, flhc, flqc, wet, smmax, cmc, & - & dew, drip, ec, edir, ett, lh, esnow, etp, qfx, & - & acceta, ffrozp, lwdn, prcp, xland, xice, & + & albbck_lnd, alb_lnd, chs_lnd, flhc_lnd, flqc_lnd, & + & wet, wet_ice, smmax, cmc, drip, ec, edir, ett, & + & dew_lnd, lh_lnd, esnow_lnd, etp, qfx_lnd, acceta, & + & ffrozp, lwdn, prcp, xland, xland_wat, xice, xice_lnd, & & graupelncv, snowncv, rainncv, raincv, & - & solnet, sfcexc, & + & solnet_lnd, sfcexc, & & runoff1, runoff2, acrunoff, & - & sfcems, hfx, shdfac, shdmin1d, shdmax1d, & - & sneqv, snoalb1d, snowh, snoh, tsnav, & - & snomlt, sncovr, soilw, soilm, ssoil, soilt, tbot, & - & xlai, swdn, z0, znt, rhosnfr, infiltr, & - & precipfr, snfallac, acsn, & - & qsfc, qsg, qvg, qcg, soilt1, chklowq + & sfcems_lnd, hfx_lnd, shdfac, shdmin1d, shdmax1d, & + & sneqv_lnd, snoalb1d_lnd, snowh_lnd, snoh_lnd, tsnav_lnd, & + & snomlt_lnd, sncovr_lnd, soilw, soilm, ssoil_lnd, & + & soilt_lnd, tbot, & + & xlai, swdn, z0_lnd, znt_lnd, rhosnfr, infiltr, & + & precipfr, snfallac_lnd, acsn, & + & qsfc_lnd, qsg_lnd, qvg_lnd, qcg_lnd, soilt1_lnd, chklowq + ! ice + real (kind=kind_phys),dimension (im,1) :: & + & albbck_ice, alb_ice, chs_ice, flhc_ice, flqc_ice, & + & dew_ice, lh_ice, esnow_ice, qfx_ice, & + & solnet_ice, sfcems_ice, hfx_ice, & + & sneqv_ice, snoalb1d_ice, snowh_ice, snoh_ice, tsnav_ice, & + & snomlt_ice, sncovr_ice, ssoil_ice, soilt_ice, & + & z0_ice, znt_ice, snfallac_ice, & + & qsfc_ice, qsg_ice, qvg_ice, qcg_ice, soilt1_ice + real (kind=kind_phys) :: xice_threshold + real (kind=kind_phys) :: fwat, qsw, evapw, hfxw character(len=256) :: llanduse !< Land-use dataset. Valid values are : !! "USGS" (USGS 24/27 category dataset) and @@ -373,14 +436,16 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(:,:,:), allocatable :: soilctop !< fractional soil type integer :: nsoil, iswater, isice - integer, dimension (1:im,1:1) :: stype, vtype + integer, dimension (1:im,1:1) :: stype_wat, vtype_wat + integer, dimension (1:im,1:1) :: stype_lnd, vtype_lnd + integer, dimension (1:im,1:1) :: stype_ice, vtype_ice integer :: ipr -! local + ! local integer :: ims,ime, its,ite, jms,jme, jts,jte, kms,kme, kts,kte integer :: l, k, i, j, fractional_seaice - logical :: flag(im) + logical :: flag(im), flag_ice_uncoupled(im) logical :: rdlai2d, myj, frpcpn logical :: debug_print ! @@ -394,6 +459,15 @@ subroutine lsm_ruc_run & ! inputs chklowq = 1. + do i = 1, im ! i - horizontal loop + ! - Set flag for ice points for uncoupled model (islmsk(i) == 4 when coupled to CICE) + ! - Exclude ice on the lakes if the lake model is turned on. + flag_ice_uncoupled(i) = (icy(i) .and. .not. flag_cice(i) .and. .not. lake(i)) + !> - Set flag for land and ice points. + !- 10may19 - ice points are turned off. + flag(i) = land(i) .or. flag_ice_uncoupled(i) + enddo + if (isot == 1) then nscat = 19 ! stasgo else @@ -410,14 +484,34 @@ subroutine lsm_ruc_run & ! inputs if(debug_print) then write (0,*)'RUC LSM run' - write (0,*)'noah soil temp',ipr,stc(ipr,:) - write (0,*)'noah soil mois',ipr,smc(ipr,:) write (0,*)'soiltyp=',ipr,soiltyp(ipr) write (0,*)'vegtype=',ipr,vegtype(ipr) write (0,*)'kdt, iter =',kdt,iter write (0,*)'flag_init =',flag_init write (0,*)'flag_restart =',flag_restart endif + + do i = 1, im ! n - horizontal loop + ! - Initialize land and ice surface albedo + if(land(i)) then + ! snow-free + sfalb_lnd(i) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) + if (weasd_lnd(i) > 0.) then + !- averaged of snow-free and snow-covered + sfalb_lnd(i) = sfalb_lnd(i) * (1.-sncovr1_lnd(i)) + snoalb(i) * sncovr1_lnd(i) + endif + elseif(icy(i)) then + ! snow-free ice + sfalb_ice(i) = 0.55 + if (weasd_ice(i) > 0.) then + ! averaged of snow-free and snow-covered ice + sfalb_ice(i) = sfalb_ice(i) * (1.-sncovr1_ice(i)) + 0.75 * sncovr1_ice(i) + endif + endif + enddo ! i + + + endif ! flag_init=.true.,iter=1 ims = 1 its = 1 @@ -441,13 +535,13 @@ subroutine lsm_ruc_run & ! inputs landusef (:,:,:) = 0.0 soilctop (:,:,:) = 0.0 - ! -- number of soil categories + !> -- number of soil categories !if(isot == 1) then !nscat = 19 ! stasgo !else !nscat = 9 ! zobler !endif - !> - Set parameters for IGBP land-use data. + !> -- set parameters for IGBP land-use data if(ivegsrc == 1) then llanduse = 'MODI-RUC' ! IGBP iswater = 17 @@ -462,7 +556,8 @@ subroutine lsm_ruc_run & ! inputs if ( fractional_seaice == 0 ) then xice_threshold = 0.5 else if ( fractional_seaice == 1 ) then - xice_threshold = 0.02 + xice_threshold = 0.02 ! HRRR value + !xice_threshold = 0.15 ! consistent with GFS physics endif nsoil = lsoil_ruc @@ -480,63 +575,64 @@ subroutine lsm_ruc_run & ! inputs endif enddo - do i = 1, im ! i - horizontal loop - !> - Set flag for land and ice points. - !- 10may19 - ice points are turned off. - flag(i) = land(i) - if (land(i) .and. (vegtype(i)==iswater .or. (vegtype(i)==isice.and.islimsk(i)==2))) then - !write(errmsg,'(a,i0,a,i0)') 'Logic error in sfc_drv_ruc_run: for i=', i, & - ! ', land(i) is true but vegtype(i) is water or ice: ', vegtype(i) - !errflg = 1 - !return - if(flag_init .and. iter==1) then - write(0,'(a,i0,a,i0)') 'Warning: in sfc_drv_ruc_run: for i=', i, & - ', land(i) is true but vegtype(i) is water or ice: ', vegtype(i) - end if - end if - enddo - do i = 1, im ! i - horizontal loop if (flag(i) .and. flag_guess(i)) then !> - Save land-related prognostic fields for guess run. !if(me==0 .and. i==ipr) write (0,*)'before call to RUC guess run', i - weasd_old(i) = weasd(i) - snwdph_old(i) = snwdph(i) - tskin_old(i) = tskin(i) - canopy_old(i) = canopy(i) - !tprcp_old(i) = tprcp(i) - srflag_old(i) = srflag(i) - tsnow_old(i) = tsnow(i) - snowfallac_old(i) = snowfallac(i) - acsnow_old(i) = acsnow(i) - sfalb_old(i) = sfalb(i) - sfcqv_old(i) = sfcqv(i) - sfcqc_old(i) = sfcqc(i) - wetness_old(i) = wetness(i) - zorl_old(i) = zorl(i) - sncovr1_old(i) = sncovr1(i) + wetness_old(i) = wetness(i) + canopy_old(i) = canopy(i) + !srflag_old(i) = srflag(i) + acsnow_old(i) = acsnow(i) + ! for land + weasd_lnd_old(i) = weasd_lnd(i) + snwdph_lnd_old(i) = snwdph_lnd(i) + tskin_lnd_old(i) = tskin_lnd(i) + tsnow_lnd_old(i) = tsnow_lnd(i) + snowfallac_lnd_old(i) = snowfallac_lnd(i) + sfalb_lnd_old(i) = sfalb_lnd(i) + sfcqv_lnd_old(i) = sfcqv_lnd(i) + sfcqc_lnd_old(i) = sfcqc_lnd(i) + z0rl_lnd_old(i) = z0rl_lnd(i) + sncovr1_lnd_old(i) = sncovr1_lnd(i) + ! for ice + weasd_ice_old(i) = weasd_ice(i) + snwdph_ice_old(i) = snwdph_ice(i) + tskin_ice_old(i) = tskin_ice(i) + tsnow_ice_old(i) = tsnow_ice(i) + snowfallac_ice_old(i) = snowfallac_ice(i) + sfalb_ice_old(i) = sfalb_ice(i) + sfcqv_ice_old(i) = sfcqv_ice(i) + sfcqc_ice_old(i) = sfcqc_ice(i) + z0rl_ice_old(i) = z0rl_ice(i) + sncovr1_ice_old(i) = sncovr1_ice(i) + do k = 1, lsoil_ruc smois_old(i,k) = smois(i,k) tslb_old(i,k) = tslb(i,k) sh2o_old(i,k) = sh2o(i,k) keepfr_old(i,k) = keepfr(i,k) smfrkeep_old(i,k) = smfrkeep(i,k) + ! for ice + tsice_old(i,k) = tsice(i,k) enddo endif - enddo + enddo ! im ! --- ... initialization block do j = 1, 1 do i = 1, im ! i - horizontal loop if (flag_iter(i) .and. flag(i)) then - !if(me==0 .and. i==ipr) write (0,*)'iter run', iter, i, flag_iter(i),flag_guess(i) - evap (i) = 0.0 - hflx (i) = 0.0 - gflux(i) = 0.0 + evap_lnd(i) = 0.0 + evap_ice(i) = 0.0 + hflx_lnd (i) = 0.0 + hflx_ice (i) = 0.0 + gflux_lnd(i) = 0.0 + gflux_ice(i) = 0.0 drain(i) = 0.0 canopy(i) = max(canopy(i), 0.0) - sfcdew(i) = 0.0 + sfcdew_lnd(i) = 0.0 + sfcdew_ice(i) = 0.0 evbs (i) = 0.0 evcw (i) = 0.0 @@ -544,24 +640,31 @@ subroutine lsm_ruc_run & ! inputs sbsno(i) = 0.0 !local i,j arrays - dew(i,j) = 0.0 - soilm(i,j) = 0.0 - smmax(i,j) = 0.0 - hfx(i,j) = 0.0 - qfx(i,j) = 0.0 - lh(i,j) = 0.0 - acsn(i,j) = 0.0 - sfcexc(i,j) = 0.0 - acceta(i,j) = 0.0 - ssoil(i,j) = 0.0 - snomlt(i,j) = 0.0 - infiltr(i,j) = 0.0 - runoff1(i,j) = 0.0 - runoff2(i,j) = 0.0 - acrunoff(i,j) = 0.0 - snfallac(i,j) = 0.0 - rhosnfr(i,j) = 0.0 - precipfr(i,j) = 0.0 + dew_lnd(i,j) = 0.0 + dew_ice(i,j) = 0.0 + soilm(i,j) = 0.0 + smmax(i,j) = 0.0 + hfx_lnd(i,j) = 0.0 + hfx_ice(i,j) = 0.0 + qfx_lnd(i,j) = 0.0 + qfx_ice(i,j) = 0.0 + lh_lnd(i,j) = 0.0 + lh_ice(i,j) = 0.0 + acsn(i,j) = 0.0 + sfcexc(i,j) = 0.0 + acceta(i,j) = 0.0 + ssoil_lnd(i,j) = 0.0 + ssoil_ice(i,j) = 0.0 + snomlt_lnd(i,j) = 0.0 + snomlt_ice(i,j) = 0.0 + infiltr(i,j) = 0.0 + runoff1(i,j) = 0.0 + runoff2(i,j) = 0.0 + acrunoff(i,j) = 0.0 + snfallac_lnd(i,j) = 0.0 + snfallac_ice(i,j) = 0.0 + rhosnfr(i,j) = 0.0 + precipfr(i,j) = 0.0 endif enddo ! i=1,im @@ -572,10 +675,11 @@ subroutine lsm_ruc_run & ! inputs do i = 1, im if (flag_iter(i) .and. flag(i)) then q0(i) = max(q1(i)/(1.-q1(i)), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) + rho(i) = prsl1(i) / (con_rd*t1(i)*(1.0+con_fvirt*q0(i))) qs1(i) = rslf(prsl1(i),t1(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg) q0 (i) = min(qs1(i), q0(i)) - endif + endif ! flag_iter & flag enddo ! i !> - Prepare variables to run RUC LSM: @@ -599,6 +703,7 @@ subroutine lsm_ruc_run & ! inputs do j = 1, 1 ! 1:1 do i = 1, im ! i - horizontal loop + xice(i,j) = 0. if (flag_iter(i) .and. flag(i)) then if (frpcpn) then @@ -607,7 +712,7 @@ subroutine lsm_ruc_run & ! inputs ffrozp(i,j) = real(nint(srflag(i)),kind_phys) endif - !tgs - rdlai is .false. when the LAI data is not available in the + !-- rdlai is .false. when the LAI data is not available in the ! - INPUT/sfc_data.nc rdlai2d = rdlai @@ -631,84 +736,88 @@ subroutine lsm_ruc_run & ! inputs !!\n \a lwdn - lw dw radiation flux at surface (\f$W m^{-2}\f$) !!\n \a swdn - sw dw radiation flux at surface (\f$W m^{-2}\f$) -!!\n \a solnet - net sw radiation flux (dn-up) (\f$W m^{-2}\f$) !!\n \a prcp - time-step total precip (\f$kg m^{-2} \f$) !!\n \a raincv - time-step convective precip (\f$kg m^{-2} \f$) !!\n \a rainncv - time-step non-convective precip (\f$kg m^{-2} \f$) !!\n \a graupelncv - time-step graupel (\f$kg m^{-2} \f$) !!\n \a snowncv - time-step snow (\f$kg m^{-2} \f$) !!\n \a precipfr - time-step precipitation in solod form (\f$kg m^{-2} \f$) -!!\n \a qsfc - specific humidity at surface (\f$kg kg^{-1}\f$) -!!\n \a qvg - water vapor mixing ratio at surface (\f$kg kg^{-1}\f$) -!!\n \a qsg - saturated water vapor mixing ratio at surface (\f$kg kg^{-1}\f$) -!!\n \a qcg - cloud water mixing ratio at surface (\f$kg kg^{-1}\f$) +!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-1.0) +!!\n \a shdmin - minimum areal fractional coverage of green vegetation -> !shdmin1d +!!\n \a shdmax - maximum areal fractional coverage of green vegetation -> !shdmax1d +!!\n \a tbot - bottom soil temperature (local yearly-mean sfc air temp) lwdn(i,j) = dlwflx(i) !..downward lw flux at sfc in w/m2 swdn(i,j) = dswsfc(i) !..downward sw flux at sfc in w/m2 - solnet(i,j) = dswsfc(i)*(1.-sfalb(i)) !snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 ! all precip input to RUC LSM is in [mm] !prcp(i,j) = rhoh2o * tprcp(i) ! tprcp in [m] - convective plus explicit !raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip !rainncv(i,j) = rhoh2o * max(rain(i)-rainc(i),0.0) ! total time-step explicit precip - prcp(i,j) = rhoh2o * (rainc(i)+rainnc(i)) ! [mm] - convective plus explicit - raincv(i,j) = rhoh2o * rainc(i) ! [mm] - total time-step convective precip - rainncv(i,j) = rhoh2o * rainnc(i) ! [mm] - total time-step explicit precip + !graupelncv(i,j) = rhoh2o * graupel(i) + !snowncv(i,j) = rhoh2o * snow(i) + prcp(i,j) = rhoh2o * (rainc(i)+rainnc(i)) ! tprcp in [m] - convective plus explicit + raincv(i,j) = rhoh2o * rainc(i) ! total time-step convective precip + rainncv(i,j) = rhoh2o * rainnc(i) ! total time-step explicit precip graupelncv(i,j) = rhoh2o * graupel(i) snowncv(i,j) = rhoh2o * snow(i) - !if(prcp(i,j) > 0. .and. i==21) then - !print *,'prcp(i,j),rainncv(i,j),graupelncv(i,j),snowncv(i,j),ffrozp(i,j)',i,j, & - ! prcp(i,j),rainncv(i,j),graupelncv(i,j),snowncv(i,j),ffrozp(i,j) - !endif + ! ice precipitation is not used + ! precipfr(i,j) = rainncv(i,j) * ffrozp(i,j) + ! ice not used ! precipfr(i,j) = rainncv(i,j) * ffrozp(i,j) + acsn(i,j) = acsnow(i) + + ! --- units % + shdfac(i,j) = sigmaf(i)*100. + shdmin1d(i,j) = shdmin(i)*100. + shdmax1d(i,j) = shdmax(i)*100. - qvg(i,j) = sfcqv(i) - qsfc(i,j) = sfcqv(i)/(1.+sfcqv(i)) - qsg(i,j) = rslf(prsl1(i),tsurf(i)) - qcg(i,j) = sfcqc(i) + tbot(i,j) = tg3(i) !> - 3. canopy/soil characteristics (s): !!\n \a vegtyp - vegetation type (integer index) -> vtype !!\n \a soiltyp - soil type (integer index) -> stype -!!\n \a shdfac - areal fractional coverage of green vegetation (0.0-1.0) -!!\n \a shdmin - minimum areal fractional coverage of green vegetation -> shdmin1d -!!\n \a shdmax - maximum areal fractional coverage of green vegetation -> shdmax1d !!\n \a sfcems - surface emmisivity -> sfcemis !!\n \a 0.5*(alvwf + alnwf) - backround snow-free surface albedo (fraction) -> albbck !!\n \a snoalb - upper bound on maximum albedo over deep snow -> snoalb1d !!\n \a sfalb - surface albedo including snow effect (unitless fraction) -> alb -!!\n \a tbot - bottom soil temperature (local yearly-mean sfc air temp) if(ivegsrc == 1) then ! IGBP - MODIS + vtype_wat(i,j) = 17 ! 17 - water (oceans and lakes) in MODIS + stype_wat(i,j) = 14 + xland_wat(i,j) = 2. ! xland = 2 for water + vtype_lnd(i,j) = vegtype(i) + stype_lnd(i,j) = soiltyp(i) + vtype_ice(i,j) = 15 ! MODIS + if(isot == 0) then + stype_ice(i,j) = 9 ! ZOBLER + else + stype_ice(i,j) = 16 ! STASGO + endif !> - Prepare land/ice/water masks for RUC LSM - !> - for land only - vtype(i,j) = vegtype(i) - stype(i,j) = soiltyp(i) + !SLMSK0 - SEA(0),LAND(1),ICE(2) MASK + !if(islmsk(i) == 0.) then + !elseif(islmsk(i) == 1.) then ! land + + if(land(i)) then ! some land + xland(i,j) = 1. + xice_lnd(i,j) = 0. + elseif(flag_ice_uncoupled(i)) then ! some ice xland(i,j) = 1. - xice(i,j) = 0. + xice(i,j) = 1. !fice(i) ! fraction of sea-ice + endif else write (0,*)'MODIS landuse is not available' endif - ! --- units % - shdfac(i,j) = sigmaf(i)*100. - shdmin1d(i,j) = shdmin(i)*100. - shdmax1d(i,j) = shdmax(i)*100. - - sfcems(i,j) = sfcemis(i) - - snoalb1d(i,j) = snoalb(i) - albbck(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) - alb(i,j) = sfalb(i) - if(rdlai2d) then xlai(i,j) = laixy(i) else xlai(i,j) = 0. endif - tbot(i,j) = tg3(i) + if (land(i)) then ! at least some land in the grid cell !> - 4. history (state) variables (h): !!\n \a cmc - canopy moisture content (\f$mm\f$) @@ -720,23 +829,36 @@ subroutine lsm_ruc_run & ! inputs !!\n \a smfrsoil(lsoil_ruc) - frozen soil moisture content (volumetric fraction) -> smfrsoil !!\n \a keepfrflag(lsoil_ruc) - flag for frozen soil physics: 0. or 1. !!\n \a wet - soil moisture availability at surface -!!\n \a snowh - actual snow depth (\f$m\f$) -!!\n \a sneqv - liquid water-equivalent snow depth (\f$m\f$) -!!\n \a sncovr - fraction of snow in the grid cell -!!\n \a ch - surface exchange coefficient for heat (\f$m s^{-1}\f$) -> chs -!!\n \a z0 - surface roughness (\f$m\f$) -> zorl(\f$cm\f$) - +!!\n \a snowh_lnd - actual snow depth (\f$m\f$) +!!\n \a sneqv_lnd - liquid water-equivalent snow depth (\f$m\f$) +!!\n \a sncovr_lnd - fraction of snow in the grid cell +!!\n \a chh_lnd - surface exchange coefficient for heat (\f$m s^{-1}\f$) -> chs +!!\n \a z0_lnd - surface roughness (\f$m\f$) -> zorl(\f$cm\f$) +!!\n \a qsfc_lnd - specific humidity at surface (\f$kg kg^{-1}\f$) +!!\n \a qvg_lnd - water vapor mixing ratio at surface (\f$kg kg^{-1}\f$) +!!\n \a qsg_lnd - saturated water vapor mixing ratio at surface (\f$kg kg^{-1}\f$) +!!\n \a qcg_lnd - cloud water mixing ratio at surface (\f$kg kg^{-1}\f$) +!!\n \a solnet_lnd - net sw radiation flux (dn-up) (\f$W m^{-2}\f$) + + solnet_lnd(i,j) = dswsfc(i)*(1.-sfalb_lnd(i)) !snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 + qvg_lnd(i,j) = sfcqv_lnd(i) + qsfc_lnd(i,j) = sfcqv_lnd(i)/(1.+sfcqv_lnd(i)) + qsg_lnd(i,j) = rslf(prsl1(i),tsurf_lnd(i)) + qcg_lnd(i,j) = sfcqc_lnd(i) + sfcems_lnd(i,j) = semis_lnd(i) + snoalb1d_lnd(i,j) = snoalb(i) + albbck_lnd(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) + ! sfalb_lnd takes into account snow on the ground + alb_lnd(i,j) = sfalb_lnd(i) cmc(i,j) = canopy(i) ! [mm] - soilt(i,j) = tsurf(i) ! clu_q2m_iter + soilt_lnd(i,j) = tsurf_lnd(i) ! clu_q2m_iter + tsnav_lnd(i,j) = 0.5*(soilt_lnd(i,j) + soilt1_lnd(i,j)) - 273.15 ! sanity check for snow temperature tsnow - if (tsnow(i) > 0. .and. tsnow(i) < 273.15) then - soilt1(i,j) = tsnow(i) + if (tsnow_lnd(i) > 0. .and. tsnow_lnd(i) < 273.15) then + soilt1_lnd(i,j) = tsnow_lnd(i) else - soilt1(i,j) = tsurf(i) + soilt1_lnd(i,j) = tsurf_lnd(i) endif - - tsnav(i,j) = 0.5*(soilt(i,j) + soilt1(i,j)) - 273.15 - do k = 1, lsoil_ruc smsoil (i,k,j) = smois(i,k) slsoil (i,k,j) = sh2o(i,k) @@ -744,114 +866,74 @@ subroutine lsm_ruc_run & ! inputs smfrsoil(i,k,j) = smfrkeep(i,k) keepfrsoil(i,k,j) = keepfr(i,k) enddo - - if(stype(i,j) .ne. 14) then - ! land - if (wetness(i) > 0.) then - wet(i,j) = wetness(i) - else - wet(i,j) = max(0.0001,smsoil(i,1,j)/0.3) - endif + ! land + if (wetness(i) > 0.) then + wet(i,j) = wetness(i) else - ! water - wet(i,j) = 1. + wet(i,j) = max(0.0001,smsoil(i,1,j)/0.3) endif - snowh(i,j) = snwdph(i) * 0.001 ! convert from mm to m - sneqv(i,j) = weasd(i) ! [mm] - - snfallac(i,j) = snowfallac(i) - acsn(i,j) = acsnow(i) - - ! -- sanity checks on sneqv and snowh - if (sneqv(i,j) /= 0.0 .and. snowh(i,j) == 0.0) then - snowh(i,j) = 0.003 * sneqv(i,j) ! snow density ~300 kg m-3 + chs_lnd (i,j) = ch_lnd(i) * wind(i) ! compute conductance + flhc_lnd(i,j) = chs_lnd(i,j) * rho(i) * con_cp ! * (1. + 0.84*q2(i,1,j)) + flqc_lnd(i,j) = chs_lnd(i,j) * rho(i) * wet(i,j) + ! for output + cmm_lnd(i) = cm_lnd(i) * wind(i) + chh_lnd(i) = chs_lnd(i,j) * rho(i) + ! + snowh_lnd(i,j) = snwdph_lnd(i) * 0.001 ! convert from mm to m + sneqv_lnd(i,j) = weasd_lnd(i) ! [mm] + snfallac_lnd(i,j) = snowfallac_lnd(i) + sncovr_lnd(i,j) = sncovr1_lnd(i) + !> -- sanity checks on sneqv and snowh + if (sneqv_lnd(i,j) /= 0.0 .and. snowh_lnd(i,j) == 0.0) then + snowh_lnd(i,j) = 0.003 * sneqv_lnd(i,j) ! snow density ~300 kg m-3 endif - if (snowh(i,j) /= 0.0 .and. sneqv(i,j) == 0.0) then - sneqv(i,j) = 300. * snowh(i,j) ! snow density ~300 kg m-3 + if (snowh_lnd(i,j) /= 0.0 .and. sneqv_lnd(i,j) == 0.0) then + sneqv_lnd(i,j) = 300. * snowh_lnd(i,j) ! snow density ~300 kg m-3 endif - if (sneqv(i,j) > 0. .and. snowh(i,j) > 0.) then - if(sneqv(i,j)/snowh(i,j) > 950.) then - sneqv(i,j) = 300. * snowh(i,j) + if (sneqv_lnd(i,j) > 0. .and. snowh_lnd(i,j) > 0.) then + if(sneqv_lnd(i,j)/snowh_lnd(i,j) > 950.) then + sneqv_lnd(i,j) = 300. * snowh_lnd(i,j) endif endif - - sncovr(i,j) = sncovr1(i) - - chs(i,j) = ch(i) * wind(i) ! compute conductance - flhc(i,j) = chs(i,j) * rho(i) * con_cp * (1. + 0.84*q2(i,1,j)) - flqc(i,j) = chs(i,j) * rho(i) * wet(i,j) - ! for output - cmm(i) = cm(i) * wind(i) - chh(i) = chs(i,j) * rho(i) - ! - ! ---- ... outside sflx, roughness uses cm as unit - z0(i,j) = zorl(i)/100. - znt(i,j) = zorl(i)/100. + z0_lnd(i,j) = z0rl_lnd(i)/100. + znt_lnd(i,j) = z0rl_lnd(i)/100. if(debug_print) then - if(i==ipr) then - write (0,*)'before RUC smsoil = ',smsoil(i,:,j), i,j - write (0,*)'stsoil = ',stsoil(i,:,j), i,j - write (0,*)'soilt = ',soilt(i,j), i,j - write (0,*)'wet = ',wet(i,j), i,j - write (0,*)'soilt1 = ',soilt1(i,j), i,j - write (0,*)'delt =',delt - write (0,*)'kdt =',kdt - write (0,*)'flag_init =',flag_init - write (0,*)'flag_restart =',flag_restart - write (0,*)'nsoil =',nsoil - write (0,*)'frpcpn =',frpcpn - write (0,*)'zs =',zs - write (0,*)'graupelncv(i,j) =',i,j,graupelncv(i,j) - write (0,*)'snowncv(i,j) =',i,j,snowncv(i,j) - write (0,*)'rainncv(i,j) =',i,j,rainncv(i,j) - write (0,*)'raincv(i,j) =',i,j,raincv(i,j) - write (0,*)'prcp(i,j) =',i,j,prcp(i,j) - write (0,*)'sneqv(i,j) =',i,j,sneqv(i,j) - write (0,*)'snowh(i,j) =',i,j,snowh(i,j) - write (0,*)'sncovr(i,j) =',i,j,sncovr(i,j) - write (0,*)'ffrozp(i,j) =',i,j,ffrozp(i,j) - write (0,*)'conflx2(i,1,j) =',i,j,conflx2(i,1,j) - write (0,*)'sfcprs(i,1,j) =',i,j,sfcprs(i,1,j) - write (0,*)'sfctmp(i,1,j) =',i,j,sfctmp(i,1,j) - write (0,*)'q2(i,1,j) =',i,j,q2(i,1,j) - write (0,*)'qcatm(i,1,j) =',i,j,qcatm(i,1,j) - write (0,*)'rho2(i,1,j) =',i,j,rho2(i,1,j) - write (0,*)'lwdn(i,j) =',i,j,lwdn(i,j) - write (0,*)'solnet(i,j) =',i,j,solnet(i,j) - write (0,*)'sfcems(i,j) =',i,j,sfcems(i,j) + if(me==0 ) then + write (0,*)'before LSMRUC for land' + write (0,*)'sfcems(i,j) =',i,j,sfcems_lnd(i,j) write (0,*)'chklowq(i,j) =',i,j,chklowq(i,j) - write (0,*)'chs(i,j) =',i,j,chs(i,j) - write (0,*)'flqc(i,j) =',i,j,flqc(i,j) - write (0,*)'flhc(i,j) =',i,j,flhc(i,j) + write (0,*)'chs(i,j) =',i,j,chs_lnd(i,j) + write (0,*)'flqc(i,j) =',i,j,flqc_lnd(i,j) + write (0,*)'flhc(i,j) =',i,j,flhc_lnd(i,j) write (0,*)'wet(i,j) =',i,j,wet(i,j) write (0,*)'cmc(i,j) =',i,j,cmc(i,j) write (0,*)'shdfac(i,j) =',i,j,shdfac(i,j) - write (0,*)'alb(i,j) =',i,j,alb(i,j) - write (0,*)'znt(i,j) =',i,j,znt(i,j) - write (0,*)'z0(i,j) =',i,j,z0(i,j) - write (0,*)'snoalb1d(i,j) =',i,j,snoalb1d(i,j) - write (0,*)'alb(i,j) =',i,j,alb(i,j) + write (0,*)'alb(i,j) =',i,j,alb_lnd(i,j) + write (0,*)'znt(i,j) =',i,j,znt_lnd(i,j) + write (0,*)'z0(i,j) =',i,j,z0_lnd(i,j) + write (0,*)'snoalb1d(i,j) =',i,j,snoalb1d_lnd(i,j) + write (0,*)'alb(i,j) =',i,j,alb_lnd(i,j) write (0,*)'landusef(i,:,j) =',i,j,landusef(i,:,j) write (0,*)'soilctop(i,:,j) =',i,j,soilctop(i,:,j) write (0,*)'nlcat=',nlcat write (0,*)'nscat=',nscat - write (0,*)'qsfc(i,j) =',i,j,qsfc(i,j) - write (0,*)'qvg(i,j) =',i,j,qvg(i,j) - write (0,*)'qsg(i,j) =',i,j,qsg(i,j) - write (0,*)'qcg(i,j) =',i,j,qcg(i,j) - write (0,*)'dew(i,j) =',i,j,dew(i,j) - write (0,*)'soilt(i,j) =',i,j,soilt(i,j) - write (0,*)'tskin(i) =',i,j,tskin(i) - write (0,*)'soilt1(i,j) =',i,j,soilt1(i,j) - write (0,*)'tsnav(i,j) =',i,j,tsnav(i,j) + write (0,*)'qsfc(i,j) =',i,j,qsfc_lnd(i,j) + write (0,*)'qvg(i,j) =',i,j,qvg_lnd(i,j) + write (0,*)'qsg(i,j) =',i,j,qsg_lnd(i,j) + write (0,*)'qcg(i,j) =',i,j,qcg_lnd(i,j) + write (0,*)'dew(i,j) =',i,j,dew_lnd(i,j) + write (0,*)'soilt(i,j) =',i,j,soilt_lnd(i,j) + write (0,*)'tskin(i) =',i,j,tskin_lnd(i) + write (0,*)'soilt1(i,j) =',i,j,soilt1_lnd(i,j) + write (0,*)'tsnav(i,j) =',i,j,tsnav_lnd(i,j) write (0,*)'tbot(i,j) =',i,j,tbot(i,j) - write (0,*)'vtype(i,j) =',i,j,vtype(i,j) - write (0,*)'stype(i,j) =',i,j,stype(i,j) + write (0,*)'vtype(i,j) =',i,j,vtype_lnd(i,j) + write (0,*)'stype(i,j) =',i,j,stype_lnd(i,j) write (0,*)'xland(i,j) =',i,j,xland(i,j) write (0,*)'xice(i,j) =',i,j,xice(i,j) write (0,*)'iswater=',iswater @@ -877,60 +959,61 @@ subroutine lsm_ruc_run & ! inputs endif endif -!> - Call RUC LSM lsmruc(). - call lsmruc( delt, flag_init, flag_restart, kdt, iter, nsoil, & +!> - Call RUC LSM lsmruc() for land. + call lsmruc( & + & delt, flag_init, flag_restart, kdt, iter, nsoil, & & graupelncv(i,j), snowncv(i,j), rainncv(i,j), raincv(i,j), & - & zs, prcp(i,j), sneqv(i,j), snowh(i,j), sncovr(i,j), & + & zs, prcp(i,j), sneqv_lnd(i,j), snowh_lnd(i,j), & + & sncovr_lnd(i,j), & & ffrozp(i,j), frpcpn, & & rhosnfr(i,j), precipfr(i,j), & ! --- inputs: & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), & & qcatm(i,1,j), rho2(i,1,j), & - & lwdn(i,j), solnet(i,j), sfcems(i,j), chklowq(i,j), & - & chs(i,j), flqc(i,j), flhc(i,j), & + & lwdn(i,j), solnet_lnd(i,j), sfcems_lnd(i,j), chklowq(i,j), & + & chs_lnd(i,j), flqc_lnd(i,j), flhc_lnd(i,j), & ! --- input/outputs: - & wet(i,j), cmc(i,j), shdfac(i,j), alb(i,j), znt(i,j), & - & z0(i,j), snoalb1d(i,j), albbck(i,j), xlai(i,j), & - & landusef(i,:,j), nlcat, & + & wet(i,j), cmc(i,j), shdfac(i,j), alb_lnd(i,j), znt_lnd(i,j), & + & z0_lnd(i,j), snoalb1d_lnd(i,j), albbck_lnd(i,j), & + & xlai(i,j), landusef(i,:,j), nlcat, & ! --- mosaic_lu and mosaic_soil are moved to the namelist ! & mosaic_lu, mosaic_soil, & & soilctop(i,:,j), nscat, & - & qsfc(i,j), qsg(i,j), qvg(i,j), qcg(i,j), dew(i,j), & - & soilt1(i,j), & - & tsnav(i,j), tbot(i,j), vtype(i,j), stype(i,j), xland(i,j), & - & iswater, isice, xice(i,j), xice_threshold, & + & qsfc_lnd(i,j), qsg_lnd(i,j), qvg_lnd(i,j), qcg_lnd(i,j), & + & dew_lnd(i,j), soilt1_lnd(i,j), & + & tsnav_lnd(i,j), tbot(i,j), vtype_lnd(i,j), stype_lnd(i,j), & + & xland(i,j), iswater, isice, xice_lnd(i,j), xice_threshold, & ! xice=0. for the land portion of grid area ! --- constants & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, stbolt, & ! --- input/outputs: & smsoil(i,:,j), slsoil(i,:,j), soilm(i,j), smmax(i,j), & - & stsoil(i,:,j), soilt(i,j), hfx(i,j), qfx(i,j), lh(i,j), & + & stsoil(i,:,j), soilt_lnd(i,j), & + & hfx_lnd(i,j), qfx_lnd(i,j), lh_lnd(i,j), & & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & - & sfcexc(i,j), acceta(i,j), ssoil(i,j), & - & snfallac(i,j), acsn(i,j), snomlt(i,j), & + & sfcexc(i,j), acceta(i,j), ssoil_lnd(i,j), & + & snfallac_lnd(i,j), acsn(i,j), snomlt_lnd(i,j), & & smfrsoil(i,:,j),keepfrsoil(i,:,j), .false., & & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte ) - - if(debug_print) then - if(i==ipr) then - write (0,*)'after RUC smsoil = ',smsoil(i,:,j), i, j - write (0,*)'after sneqv(i,j) =',i,j,sneqv(i,j) - write (0,*)'after snowh(i,j) =',i,j,snowh(i,j) - write (0,*)'after sncovr(i,j) =',i,j,sncovr(i,j) - write (0,*)'after vtype(i,j) =',i,j,vtype(i,j) - write (0,*)'after stype(i,j) =',i,j,stype(i,j) + if(debug_print) then + write (0,*)'after LSMRUC for land' + write (0,*)'after sneqv(i,j) =',i,j,sneqv_lnd(i,j) + write (0,*)'after snowh(i,j) =',i,j,snowh_lnd(i,j) + write (0,*)'after sncovr(i,j) =',i,j,sncovr_lnd(i,j) + write (0,*)'after vtype(i,j) =',i,j,vtype_lnd(i,j) + write (0,*)'after stype(i,j) =',i,j,stype_lnd(i,j) write (0,*)'after wet(i,j) =',i,j,wet(i,j) write (0,*)'after cmc(i,j) =',i,j,cmc(i,j) - write (0,*)'after qsfc(i,j) =',i,j,qsfc(i,j) - write (0,*)'after qvg(i,j) =',i,j,qvg(i,j) - write (0,*)'after qsg(i,j) =',i,j,qsg(i,j) - write (0,*)'after qcg(i,j) =',i,j,qcg(i,j) - write (0,*)'after dew(i,j) =',i,j,dew(i,j) - write (0,*)'after soilt(i,j) =',i,j,soilt(i,j) - write (0,*)'after tskin(i) =',i,j,tskin(i) - write (0,*)'after soilt1(i,j) =',i,j,soilt1(i,j) - write (0,*)'after tsnav(i,j) =',i,j,tsnav(i,j) + write (0,*)'after qsfc(i,j) =',i,j,qsfc_lnd(i,j) + write (0,*)'after qvg(i,j) =',i,j,qvg_lnd(i,j) + write (0,*)'after qsg(i,j) =',i,j,qsg_lnd(i,j) + write (0,*)'after qcg(i,j) =',i,j,qcg_lnd(i,j) + write (0,*)'after dew(i,j) =',i,j,dew_lnd(i,j) + write (0,*)'after soilt(i,j) =',i,j,soilt_lnd(i,j) + write (0,*)'after tskin(i) =',i,j,tskin_lnd(i) + write (0,*)'after soilt1(i,j) =',i,j,soilt1_lnd(i,j) + write (0,*)'after tsnav(i,j) =',i,j,tsnav_lnd(i,j) write (0,*)'after smsoil(i,:,j)=',i,j,smsoil(i,:,j) write (0,*)'after slsoil(i,:,j)=',i,j,slsoil(i,:,j) write (0,*)'after stsoil(i,:,j)=',i,j,stsoil(i,:,j) @@ -938,18 +1021,17 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'after keepfrsoil(i,:,j)=',i,j,keepfrsoil(i,:,j) write (0,*)'after soilm(i,j) =',i,j,soilm(i,j) write (0,*)'after smmax(i,j) =',i,j,smmax(i,j) - write (0,*)'after hfx(i,j) =',i,j,hfx(i,j) - write (0,*)'after qfx(i,j) =',i,j,qfx(i,j) - write (0,*)'after lh(i,j) =',i,j,lh(i,j) + write (0,*)'after hfx(i,j) =',i,j,hfx_lnd(i,j) + write (0,*)'after qfx(i,j) =',i,j,qfx_lnd(i,j) + write (0,*)'after lh(i,j) =',i,j,lh_lnd(i,j) write (0,*)'after infiltr(i,j) =',i,j,infiltr(i,j) write (0,*)'after runoff1(i,j) =',i,j,runoff1(i,j) write (0,*)'after runoff2(i,j) =',i,j,runoff2(i,j) - write (0,*)'after ssoil(i,j) =',i,j,ssoil(i,j) - write (0,*)'after snfallac(i,j) =',i,j,snfallac(i,j) + write (0,*)'after ssoil(i,j) =',i,j,ssoil_lnd(i,j) + write (0,*)'after snfallac(i,j) =',i,j,snfallac_lnd(i,j) write (0,*)'after acsn(i,j) =',i,j,acsn(i,j) - write (0,*)'after snomlt(i,j) =',i,j,snomlt(i,j) + write (0,*)'after snomlt(i,j) =',i,j,snomlt_lnd(i,j) endif - endif !> - RUC LSM: prepare variables for return to parent model and unit conversion. @@ -960,12 +1042,29 @@ subroutine lsm_ruc_run & ! inputs !!\n \a runoff1 - surface runoff (\f$m s^{-1}\f$), not infiltrating the surface !!\n \a runoff2 - subsurface runoff (\f$m s^{-1}\f$), drainage out bottom !!\n \a snoh - phase-change heat flux from snowmelt (w m-2) +!!\n \a lh - actual latent heat flux (\f$W m^{-2}\f$: positive, if upward from sfc) +!!\n \a hfx - sensible heat flux (\f$W m^{-2}\f$: positive, if upward from sfc) +!!\n \a ssoil - soil heat flux (\f$W m^{-2}\f$: negative if downward from surface) +!!\n \a runoff1 - surface runoff (\f$m s^{-1}\f$), not infiltrating the surface +!!\n \a runoff2 - subsurface runoff (\f$m s^{-1}\f$), drainage out bottom +!!\n \a snoh - phase-change heat flux from snowmelt (w m-2) ! +! --- ... do not return the following output fields to parent model +! ec - canopy water evaporation (m s-1) +! edir - direct soil evaporation (m s-1) +! et(nsoil)-plant transpiration from a particular root layer (m s-1) +! ett - total plant transpiration (m s-1) +! esnow - sublimation from (or deposition to if <0) snowpack (m s-1) +! drip - through-fall of precip and/or dew in excess of canopy +! water-holding capacity (m) +! snomlt - snow melt (m) (water equivalent) +! xlai - leaf area index (dimensionless) +! soilw - available soil moisture in root zone (unitless fraction +! between smcwlt and smcmax) +! soilm - total soil column moisture content (frozen+unfrozen) (m) +! nroot - number of root layers, a function of veg type, determined +! in subroutine redprm. - ! Interstitial - evap(i) = qfx(i,j) / rho(i) ! kinematic - hflx(i) = hfx(i,j) / (con_cp*rho(i)) ! kinematic - gflux(i) = ssoil(i,j) !evbs(i) = edir(i,j) !evcw(i) = ec(i,j) @@ -973,42 +1072,43 @@ subroutine lsm_ruc_run & ! inputs !sbsno(i) = esnow(i,j) !snohf(i) = snoh(i,j) - sfcdew(i) = dew(i,j) - qsurf(i) = qsfc(i,j) - sncovr1(i) = sncovr(i,j) - stm(i) = soilm(i,j) - tsurf(i) = soilt(i,j) - tice(i) = tsurf(i) - - runof (i) = runoff1(i,j) * 1000.0 ! unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) - drain (i) = runoff2(i,j) * 1000.0 ! unit conversion (from m s-1 to mm s-1 and kg m-2 s-1) + ! Interstitial + evap_lnd(i) = qfx_lnd(i,j) / rho(i) ! kinematic + hflx_lnd(i) = hfx_lnd(i,j) / (con_cp*rho(i)) ! kinematic + gflux_lnd(i) = ssoil_lnd(i,j) + sfcdew_lnd(i) = dew_lnd(i,j) + qsurf_lnd(i) = qsfc_lnd(i,j) + tsurf_lnd(i) = soilt_lnd(i,j) + stm(i) = soilm(i,j) * 1.e-3 ! convert to [m] + + runof (i) = runoff1(i,j) + drain (i) = runoff2(i,j) wetness(i) = wet(i,j) - ! State variables - tsnow(i) = soilt1(i,j) - sfcqc(i) = qcg(i,j) - sfcqv(i) = qvg(i,j) + ! tsnow(i) = soilt1(i,j) + sfcqv_lnd(i) = qvg_lnd(i,j) + sfcqc_lnd(i) = qcg_lnd(i,j) + ! --- ... units [m/s] = [g m-2 s-1] rhosnf(i) = rhosnfr(i,j) + acsnow(i) = acsn(i,j) ! kg m-2 ! --- ... accumulated total runoff and surface runoff - runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt ! kg m-2 - srunoff(i) = srunoff(i) + runof(i) * delt ! kg m-2 + runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt * 0.001 ! kg m-2 + srunoff(i) = srunoff(i) + runof(i) * delt * 0.001 ! kg m-2 ! --- ... accumulated frozen precipitation (accumulation in lsmruc) - snowfallac(i) = snfallac(i,j) ! kg m-2 - acsnow(i) = acsn(i,j) ! kg m-2 - + snowfallac_lnd(i) = snfallac_lnd(i,j) ! kg m-2 ! --- ... unit conversion (from m to mm) - snwdph(i) = snowh(i,j) * 1000.0 + snwdph_lnd(i) = snowh_lnd(i,j) * 1000.0 - canopy(i) = cmc(i,j) ! mm - weasd(i) = sneqv(i,j) ! mm - sncovr1(i) = sncovr(i,j) + canopy(i) = cmc(i,j) ! mm + weasd_lnd(i) = sneqv_lnd(i,j) ! mm + sncovr1_lnd(i) = sncovr_lnd(i,j) ! ---- ... outside RUC LSM, roughness uses cm as unit ! (update after snow's effect) - zorl(i) = znt(i,j)*100. - sfalb(i)= alb(i,j) + z0rl_lnd(i) = znt_lnd(i,j)*100. + sfalb_lnd(i)= alb_lnd(i,j) do k = 1, lsoil_ruc smois(i,k) = smsoil(i,k,j) @@ -1017,30 +1117,190 @@ subroutine lsm_ruc_run & ! inputs keepfr(i,k) = keepfrsoil(i,k,j) smfrkeep(i,k) = smfrsoil(i,k,j) enddo + if(debug_print) then + write (0,*)'LAND -i,j,stype_lnd,vtype_lnd',i,j,stype_lnd(i,j),vtype_lnd(i,j) + write (0,*)'i,j,tsurf_lnd(i)',i,j,tsurf_lnd(i) + write (0,*)'kdt,iter,stsoil(i,:,j)',kdt,iter,stsoil(i,:,j) + endif + endif ! land + + if (flag_ice_uncoupled(i)) then ! at least some ice in the grid cell + + solnet_ice(i,j) = dswsfc(i)*(1.-sfalb_ice(i)) + qvg_ice(i,j) = sfcqv_ice(i) + qsfc_ice(i,j) = sfcqv_ice(i)/(1.+sfcqv_ice(i)) + qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i)) + qcg_ice(i,j) = sfcqc_ice(i) + sfcems_ice(i,j) = semis_ice(i) + snoalb1d_ice(i,j) = 0.75 ! RAP value for max snow alb on ice + albbck_ice(i,j) = 0.55 ! RAP value for ice alb + alb_ice(i,j) = sfalb_ice(i) + soilt_ice(i,j) = tsurf_ice(i) ! clu_q2m_iter + tsnav_ice(i,j) = 0.5*(soilt_ice(i,j) + soilt1_ice(i,j)) - 273.15 + if (tsnow_ice(i) > 0. .and. tsnow_ice(i) < 273.15) then + soilt1_ice(i,j) = tsnow_ice(i) + else + soilt1_ice(i,j) = tsurf_ice(i) + endif + do k = 1, lsoil_ruc + stsice (i,k,j) = tsice(i,k) + smsoil (i,k,j) = 1. + slsoil (i,k,j) = 0. + smfrsoil(i,k,j) = 1. + keepfrsoil(i,k,j) = 1. + enddo -! --- ... do not return the following output fields to parent model -! ec - canopy water evaporation (m s-1) -! edir - direct soil evaporation (m s-1) -! et(nsoil)-plant transpiration from a particular root layer (m s-1) -! ett - total plant transpiration (m s-1) -! esnow - sublimation from (or deposition to if <0) snowpack (m s-1) -! drip - through-fall of precip and/or dew in excess of canopy -! water-holding capacity (m) -! dew - dewfall (or frostfall for t<273.15) (m) -! snomlt - snow melt (m) (water equivalent) -! sncovr - fractional snow cover (unitless fraction, 0-1) -! for a given soil layer at the end of a time step -! xlai - leaf area index (dimensionless) -! soilw - available soil moisture in root zone (unitless fraction -! between smcwlt and smcmax) -! soilm - total soil column moisture content (frozen+unfrozen) (m) -! nroot - number of root layers, a function of veg type, determined -! in subroutine redprm. + wet_ice(i,j) = 1. + + chs_ice (i,j) = ch_ice(i) * wind(i) ! compute conductance + flhc_ice(i,j) = chs_ice(i,j) * rho(i) * con_cp ! * (1. + 0.84*q2(i,1,j)) + flqc_ice(i,j) = chs_ice(i,j) * rho(i) * wet(i,j) + ! for output + cmm_ice(i) = cm_ice (i) * wind(i) + chh_ice(i) = chs_ice(i,j) * rho(i) + + sncovr_ice(i,j) = sncovr1_ice(i) + + snowh_ice(i,j) = snwdph_ice(i) * 0.001 ! convert from mm to m + sneqv_ice(i,j) = weasd_ice(i) ! [mm] + snfallac_ice(i,j) = snowfallac_ice(i) + + !> -- sanity checks on sneqv and snowh + if (sneqv_ice(i,j) /= 0.0 .and. snowh_ice(i,j) == 0.0) then + snowh_ice(i,j) = 0.003 * sneqv_ice(i,j) ! snow density ~300 kg m-3 + endif + + if (snowh_ice(i,j) /= 0.0 .and. sneqv_ice(i,j) == 0.0) then + sneqv_ice(i,j) = 300. * snowh_ice(i,j) ! snow density ~300 kg m-3 + endif + + if (sneqv_ice(i,j) > 0. .and. snowh_ice(i,j) > 0.) then + if(sneqv_ice(i,j)/snowh_ice(i,j) > 950.) then + sneqv_ice(i,j) = 300. * snowh_ice(i,j) + endif + endif + + z0_ice(i,j) = z0rl_ice(i)/100. + znt_ice(i,j) = z0rl_ice(i)/100. + +!> - Call RUC LSM lsmruc() for ice. + call lsmruc( & + & delt, flag_init, flag_restart, kdt, iter, nsoil, & + & graupelncv(i,j), snowncv(i,j), rainncv(i,j), raincv(i,j), & + & zs, prcp(i,j), sneqv_ice(i,j), snowh_ice(i,j), & + & sncovr_ice(i,j), & + & ffrozp(i,j), frpcpn, & + & rhosnfr(i,j), precipfr(i,j), & +! --- inputs: + & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), & + & qcatm(i,1,j), rho2(i,1,j), & + & lwdn(i,j), solnet_ice(i,j), sfcems_ice(i,j), chklowq(i,j), & + & chs_ice(i,j), flqc_ice(i,j), flhc_ice(i,j), & +! --- input/outputs: + & wet_ice(i,j), cmc(i,j), shdfac(i,j), alb_ice(i,j), & + & znt_ice(i,j), z0_ice(i,j), snoalb1d_ice(i,j), & + & albbck_ice(i,j), xlai(i,j),landusef(i,:,j), nlcat, & +! --- mosaic_lu and mosaic_soil are moved to the namelist +! & mosaic_lu, mosaic_soil, & + & soilctop(i,:,j), nscat, & + & qsfc_ice(i,j), qsg_ice(i,j), qvg_ice(i,j), qcg_ice(i,j), & + & dew_ice(i,j), soilt1_ice(i,j), & + & tsnav_ice(i,j), tbot(i,j), vtype_ice(i,j), stype_ice(i,j), & + & xland(i,j), iswater, isice, xice(i,j), xice_threshold, & +! --- constants + & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, stbolt, & +! --- input/outputs: + & smsoil(i,:,j), slsoil(i,:,j), soilm(i,j), smmax(i,j), & + & stsice(i,:,j), soilt_ice(i,j), & + & hfx_ice(i,j), qfx_ice(i,j), lh_ice(i,j), & + & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & + & sfcexc(i,j), acceta(i,j), ssoil_ice(i,j), & + & snfallac_ice(i,j), acsn(i,j), snomlt_ice(i,j), & + & smfrsoil(i,:,j),keepfrsoil(i,:,j), .false., & + & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & + & ims,ime, jms,jme, kms,kme, & + & its,ite, jts,jte, kts,kte ) + + ! Interstitial + evap_ice(i) = qfx_ice(i,j) / rho(i) ! kinematic + ep1d_ice(i) = qfx_ice(i,j) * con_hvap + hflx_ice(i) = hfx_ice(i,j) / (con_cp*rho(i)) ! kinematic + gflux_ice(i) = ssoil_ice(i,j) + + sfcdew_ice(i) = dew_ice(i,j) + qsurf_ice(i) = qsfc_ice(i,j) + tsurf_ice(i) = soilt_ice(i,j) - endif ! end if_flag_iter_and_flag_block + sfcqv_ice(i) = qvg_ice(i,j) + sfcqc_ice(i) = qcg_ice(i,j) + + snowfallac_ice(i) = snfallac_ice(i,j) ! kg m-2 + ! --- ... unit conversion (from m to mm) + snwdph_ice(i) = snowh_ice(i,j) * 1000.0 + weasd_ice(i) = sneqv_ice(i,j) ! mm + sncovr1_ice(i) = sncovr_ice(i,j) + z0rl_ice(i) = znt_ice(i,j)*100. + sfalb_ice(i)= alb_ice(i,j) + + do k = 1, lsoil_ruc + tsice(i,k) = stsice(i,k,j) + if(.not. frac_grid) then + smois(i,k) = 1. + sh2o(i,k) = 0. + tslb(i,k) = stsice(i,k,j) + keepfr(i,k) = 1. + smfrkeep(i,k) = 1. + endif + enddo + if(debug_print) then + write (0,*)'ICE - i,j,stype_ice,vtype_ice)',i,j,stype_ice(i,j),vtype_ice(i,j) + write (0,*)'i,j,tsurf_ice(i)',i,j,tsurf_ice(i) + write (0,*)'kdt,iter,stsice(i,:,j)',kdt,iter,stsice(i,:,j) + endif + + endif ! ice + + + endif ! end if_flag_iter_and_flag enddo ! j enddo ! i + !-- Take care of fractional sea ice for uncoupled run with frac_grid=.false. + !-- When frac_grid=.true. GFS_surface_composite will take care of this. + do i = 1, im ! i - horizontal loop + if ( flag_iter(i) .and. flag(i) ) then + ! Do this only when the fractional grid is not turned on! + ! Compute composite for a fractional sea ice: fice(i) < 1. + ! This is needed for the 2-way coupling + ! in the upcoupled case (when sfc_cice is not used). + if(.not. frac_grid) then + if( flag_ice_uncoupled(i) .and. fice(i) < 1.) then + !write (0,*)'Fractional sea ice at i', i, fice(i) + fwat = 1.0 - fice(i) + ! Check if ice fraction is below the minimum value: 15% in GFS + ! physics. + if (fice(i) < cimin) then ! cimin - minimal ice fraction + write (0,*)'warning: ice fraction is low:', fice(i) + fice(i) = cimin + fwat = 1.0 - cimin + write (0,*)'fix ice fraction: reset it to:', fice(i), tskin_wat(i) + endif + + ! Compute the composite of ice and open water for 2-way coupling in the + ! uncoupled sea-ice model. Use ice variables for the composite. + tsurf_ice(i) = tsurf_ice(i) * fice(i) + min(con_tice,tskin_wat(i)) * fwat + chh_ice(i) = chh_ice(i) * fice(i) + ch_wat(i) * wind(i) * rho(i) * fwat + hfxw = ch_wat(i) * wind(i) * (min(con_tice,tskin_wat(i)) - t1(i)) + hflx_ice(i) = hflx_ice(i) * fice(i) + hfxw * fwat + qsw = rslf(prsl1(i),min(con_tice,tskin_wat(i))) + evapw = ch_wat(i) * wind(i) * (qsw - q0(i)) + evap_ice(i) = evap_ice(i) * fice(i) + evapw * fwat + qsurf_ice(i) = q1(i) + evap_ice(i) * rho(i) / chh_ice(i) + endif ! flag_ice_uncoupled(i) .and. fice(i) < 1. + endif ! flag_iter, icy, not frac_grid + endif + enddo ! i + !> - Restore land-related prognostic fields for guess run. do j = 1, 1 do i = 1, im @@ -1048,34 +1308,48 @@ subroutine lsm_ruc_run & ! inputs if(debug_print) write (0,*)'end ',i,flag_guess(i),flag_iter(i) if (flag_guess(i)) then if(debug_print) write (0,*)'guess run' - weasd(i) = weasd_old(i) - snwdph(i) = snwdph_old(i) - tskin(i) = tskin_old(i) - canopy(i) = canopy_old(i) - !tprcp(i) = tprcp_old(i) - srflag(i) = srflag_old(i) - tsnow(i) = tsnow_old(i) - snowfallac(i) = snowfallac_old(i) - acsnow(i) = acsnow_old(i) - sfalb(i) = sfalb_old(i) - sfcqv(i) = sfcqv_old(i) - sfcqc(i) = sfcqc_old(i) - wetness(i) = wetness_old(i) - zorl(i) = zorl_old(i) - sncovr1(i) = sncovr1_old(i) + + weasd_lnd(i) = weasd_lnd_old(i) + snwdph_lnd(i) = snwdph_lnd_old(i) + tskin_lnd(i) = tskin_lnd_old(i) + canopy(i) = canopy_old(i) + !srflag(i) = srflag_old(i) + tsnow_lnd(i) = tsnow_lnd_old(i) + snowfallac_lnd(i) = snowfallac_lnd_old(i) + acsnow(i) = acsnow_old(i) + sfalb_lnd(i) = sfalb_lnd_old(i) + sfcqv_lnd(i) = sfcqv_lnd_old(i) + sfcqc_lnd(i) = sfcqc_lnd_old(i) + wetness(i) = wetness_old(i) + z0rl_lnd(i) = z0rl_lnd_old(i) + sncovr1_lnd(i) = sncovr1_lnd_old(i) + !ice + weasd_ice(i) = weasd_ice_old(i) + snwdph_ice(i) = snwdph_ice_old(i) + tskin_ice(i) = tskin_ice_old(i) + tsnow_ice(i) = tsnow_ice_old(i) + snowfallac_ice(i) = snowfallac_ice_old(i) + sfalb_ice(i) = sfalb_ice_old(i) + sfcqv_ice(i) = sfcqv_ice_old(i) + sfcqc_ice(i) = sfcqc_ice_old(i) + z0rl_ice(i) = z0rl_ice_old(i) + sncovr1_ice(i) = sncovr1_ice_old(i) + do k = 1, lsoil_ruc - smois(i,k) = smois_old(i,k) - tslb(i,k) = tslb_old(i,k) - sh2o(i,k) = sh2o_old(i,k) - keepfr(i,k) = keepfr_old(i,k) + smois(i,k) = smois_old(i,k) + tslb(i,k) = tslb_old(i,k) + tsice(i,k) = tsice_old(i,k) + sh2o(i,k) = sh2o_old(i,k) + keepfr(i,k) = keepfr_old(i,k) smfrkeep(i,k) = smfrkeep_old(i,k) enddo - else - if(debug_print) write (0,*)'iter run', i,j, tskin(i),tsurf(i) - tskin(i) = tsurf(i) - tice (i) = tsurf(i) - endif - endif + else ! flag_guess + if(debug_print) write (0,*)'iter run', i,j, tskin_ice(i),tsurf_ice(i) + tskin_lnd(i) = tsurf_lnd(i) + tskin_ice(i) = tsurf_ice(i) + tice(i) = tsurf_ice(i) + endif ! flag_guess + endif ! flag enddo ! i enddo ! j ! diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 8737f0d60..2ba1b6087 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -331,6 +331,15 @@ type = integer intent = in optional = F +[delt] + standard_name = time_step_for_dynamics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [kdt] standard_name = index_of_time_step long_name = current number of time steps @@ -355,6 +364,54 @@ type = integer intent = in optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_gfdl] + standard_name = flag_for_gfdl_microphysics_scheme + long_name = choice of GFDL microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_thompson] + standard_name = flag_for_thompson_microphysics_scheme + long_name = choice of Thompson microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[do_mynnsfclay] + standard_name = do_mynnsfclay + long_name = flag to activate MYNN surface layer + units = flag + dimensions = () + type = logical + intent = in + optional = F [lsoil_ruc] standard_name = soil_vertical_dimension_for_land_surface_model long_name = number of soil layers internal to land surface model @@ -371,6 +428,14 @@ type = integer intent = in optional = F +[rdlai] + standard_name = flag_for_reading_leaf_area_index_from_input + long_name = flag for reading leaf area index from initial conditions for RUC LSM + units = flag + dimensions = () + type = logical + intent = in + optional = F [zs] standard_name = depth_of_soil_levels_for_land_surface_model long_name = depth of soil levels for land surface model @@ -400,7 +465,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio_at_lowest_model_layer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water at lowest model layer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) at lowest model layer units = kg kg-1 dimensions = (horizontal_dimension) type = real @@ -441,15 +506,6 @@ kind = kind_phys intent = in optional = F -[sfcemis] - standard_name = surface_longwave_emissivity_over_land_interstitial - long_name = surface lw emissivity in fraction over land (temporary use as interstitial) - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [dlwflx] standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time @@ -477,15 +533,6 @@ kind = kind_phys intent = in optional = F -[delt] - standard_name = time_step_for_dynamics - long_name = physics time step - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [tg3] standard_name = deep_soil_temperature long_name = deep soil temperature @@ -495,19 +542,70 @@ kind = kind_phys intent = in optional = F -[cm] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_land - long_name = surface exchange coeff for momentum over land - units = none +[land] + standard_name = flag_nonzero_land_surface_fraction + long_name = flag indicating presence of some land surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[lake] + standard_name = flag_nonzero_lake_surface_fraction + long_name = flag indicating presence of some lake surface area fraction + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[rainnc] + standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep + long_name = explicit rainfall from previous timestep + units = m dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[ch] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land - long_name = surface exchange coeff heat & moisture over land - units = none +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep + long_name = convective_precipitation_amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ice] + standard_name = lwe_thickness_of_ice_amount_from_previous_timestep + long_name = ice amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snow] + standard_name = lwe_thickness_of_snow_amount_from_previous_timestep + long_name = snow amount from previous timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[graupel] + standard_name = lwe_thickness_of_graupel_amount_from_previous_timestep + long_name = graupel amount from previous timestep + units = m dimensions = (horizontal_dimension) type = real kind = kind_phys @@ -576,38 +674,22 @@ kind = kind_phys intent = in optional = F -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo - units = frac +[srflag] + standard_name = flag_for_precipitation_type + long_name = snow/rain flag for precipitation + units = flag dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[sfalb] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused sw albedo +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout - optional = F -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F -[flag_guess] - standard_name = flag_for_guess_run - long_name = flag for guess run - units = flag - dimensions = (horizontal_dimension) - type = logical intent = in optional = F [isot] @@ -633,6 +715,24 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys + intent = in + optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = soil water fraction at wilting point + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys intent = inout optional = F [smc] @@ -662,160 +762,115 @@ kind = kind_phys intent = inout optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model - units = flag +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat !of dry air at constant pressure + units = J kg-1 K-1 dimensions = () - type = integer + type = real + kind = kind_phys intent = in optional = F -[lsm] - standard_name = flag_for_land_surface_scheme - long_name = flag for land surface model - units = flag +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 dimensions = () - type = integer + type = real + kind = kind_phys intent = in optional = F -[land] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys intent = in optional = F -[islimsk] - standard_name = sea_land_ice_mask - long_name = sea/land/ice mask (=0/1/2) - units = flag - dimensions = (horizontal_dimension) - type = integer +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys intent = in optional = F -[rdlai] - standard_name = flag_for_reading_leaf_area_index_from_input - long_name = flag for reading leaf area index from initial conditions for RUC LSM - units = flag +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none dimensions = () - type = logical + type = real + kind = kind_phys intent = in optional = F -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of vaporization/sublimation (hvap) + units = J kg-1 dimensions = () - type = integer + type = real + kind = kind_phys intent = in optional = F -[imp_physics_gfdl] - standard_name = flag_for_gfdl_microphysics_scheme - long_name = choice of GFDL microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_thompson] - standard_name = flag_for_thompson_microphysics_scheme - long_name = choice of Thompson microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[smcwlt2] - standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point - long_name = soil water fraction at wilting point - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[smcref2] - standard_name = threshold_volume_fraction_of_condensed_water_in_soil - long_name = soil moisture threshold - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[do_mynnsfclay] - standard_name = do_mynnsfclay - long_name = flag to activate MYNN surface layer - units = flag - dimensions = () - type = logical - intent = in - optional = F -[con_cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat !of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_rv] - standard_name = gas_constant_water_vapor - long_name = ideal gas constant for water vapor - units = J kg-1 K-1 +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none dimensions = () type = real kind = kind_phys intent = in optional = F -[con_rd] - standard_name = gas_constant_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () +[ch_wat] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ocean + long_name = surface exchange coeff heat & moisture over ocean + units = none + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () +[tskin_wat] + standard_name = surface_skin_temperature_over_ocean_interstitial + long_name = surface skin temperature over ocean (temporary use as interstitial) + units = K + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[con_hvap] - standard_name = latent_heat_of_vaporization_of_water_at_0C - long_name = latent heat of vaporization/sublimation (hvap) - units = J kg-1 - dimensions = () +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice_interstitial + long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) + units = frac + dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[con_fvirt] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) - units = none - dimensions = () +[sncovr1_lnd] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction over land + units = frac + dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[weasd] +[weasd_lnd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land units = mm @@ -824,7 +879,7 @@ kind = kind_phys intent = inout optional = F -[snwdph] +[snwdph_lnd] standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land units = mm @@ -833,7 +888,7 @@ kind = kind_phys intent = inout optional = F -[tskin] +[tskin_lnd] standard_name = surface_skin_temperature_over_land_interstitial long_name = surface skin temperature over land use as interstitial units = K @@ -842,64 +897,55 @@ kind = kind_phys intent = inout optional = F -[tskin_wat] - standard_name = surface_skin_temperature_over_ocean_interstitial - long_name = surface skin temperature over ocean (temporary use as interstitial) - units = K +[sfalb_lnd] + standard_name = surface_diffused_shortwave_albedo_over_land + long_name = mean surface diffused sw albedo over land with snow effect + units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[rainnc] - standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep - long_name = explicit rainfall from previous timestep - units = m - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[rainc] - standard_name = lwe_thickness_of_convective_precipitation_amount_from_previous_timestep - long_name = convective_precipitation_amount from previous timestep - units = m +[sncovr1_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in optional = F -[ice] - standard_name = lwe_thickness_of_ice_amount_from_previous_timestep - long_name = ice amount from previous timestep - units = m +[weasd_ice] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[snow] - standard_name = lwe_thickness_of_snow_amount_from_previous_timestep - long_name = snow amount from previous timestep - units = m +[snwdph_ice] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[graupel] - standard_name = lwe_thickness_of_graupel_amount_from_previous_timestep - long_name = graupel amount from previous timestep - units = m +[tskin_ice] + standard_name = surface_skin_temperature_over_ice_interstitial + long_name = surface skin temperature over ice (temporary use as interstitial) + units = K dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout optional = F -[srflag] - standard_name = flag_for_precipitation_type - long_name = snow/rain flag for precipitation - units = flag +[sfalb_ice] + standard_name = surface_diffused_shortwave_albedo_over_ice + long_name = mean surface diffused sw albedo over ice with snow effect + units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys @@ -914,6 +960,15 @@ kind = kind_phys intent = inout optional = F +[tsice] + standard_name = internal_ice_temperature + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_dimension,ice_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [tslb] standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model @@ -968,7 +1023,7 @@ kind = kind_phys intent = out optional = F -[tsurf] +[tsurf_lnd] standard_name = surface_skin_temperature_after_iteration_over_land long_name = surface skin temperature after iteration over land units = K @@ -977,16 +1032,16 @@ kind = kind_phys intent = inout optional = F -[tsnow] - standard_name = snow_temperature_bottom_first_layer - long_name = snow temperature at the bottom of first snow layer +[tsnow_lnd] + standard_name = snow_temperature_bottom_first_layer_over_land + long_name = snow temperature at the bottom of first snow layer over land units = K dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[zorl] +[z0rl_lnd] standard_name = surface_roughness_length_over_land_interstitial long_name = surface roughness length over land (temporary use as interstitial) units = cm @@ -995,7 +1050,7 @@ kind = kind_phys intent = inout optional = F -[sfcqc] +[sfcqc_lnd] standard_name = cloud_condensed_water_mixing_ratio_at_surface long_name = moist cloud water mixing ratio at surface units = kg kg-1 @@ -1004,43 +1059,25 @@ kind = kind_phys intent = inout optional = F -[sfcdew] - standard_name = surface_condensation_mass - long_name = surface condensation mass +[sfcdew_lnd] + standard_name = surface_condensation_mass_over_land + long_name = surface condensation mass over land units = kg m-2 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[tice] - standard_name = sea_ice_temperature_interstitial - long_name = sea ice surface skin temperature use as interstitial - units = K - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[sfcqv] +[sfcqv_lnd] standard_name = water_vapor_mixing_ratio_at_surface - long_name = water vapor mixing ratio at surface + long_name = water vapor mixing ratio at surface over land units = kg kg-1 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[sncovr1] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qsurf] +[qsurf_lnd] standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land units = kg kg-1 @@ -1049,7 +1086,7 @@ kind = kind_phys intent = inout optional = F -[gflux] +[gflux_lnd] standard_name = upward_heat_flux_in_soil_over_land long_name = soil heat flux over land units = W m-2 @@ -1058,16 +1095,7 @@ kind = kind_phys intent = out optional = F -[drain] - standard_name = subsurface_runoff_flux - long_name = subsurface runoff flux - units = kg m-2 s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[evap] +[evap_lnd] standard_name = kinematic_surface_upward_latent_heat_flux_over_land long_name = kinematic surface upward evaporation flux over land units = kg kg-1 m s-1 @@ -1076,7 +1104,7 @@ kind = kind_phys intent = out optional = F -[hflx] +[hflx_lnd] standard_name = kinematic_surface_upward_sensible_heat_flux_over_land long_name = kinematic surface upward sensible heat flux over land units = K m s-1 @@ -1085,15 +1113,6 @@ kind = kind_phys intent = out optional = F -[rhosnf] - standard_name = density_of_frozen_precipitation - long_name = density of frozen precipitation - units = kg m-3 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [runof] standard_name = surface_runoff_flux long_name = surface runoff flux @@ -1121,23 +1140,32 @@ kind = kind_phys intent = inout optional = F -[chh] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land - long_name = thermal exchange coefficient over land +[drain] + standard_name = subsurface_runoff_flux + long_name = subsurface runoff flux units = kg m-2 s-1 dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = F -[cmm] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land - long_name = momentum exchange coefficient over land - units = m s-1 +[cm_lnd] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_land + long_name = surface exchange coeff for momentum over land + units = none dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout + intent = in + optional = F +[ch_lnd] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_land + long_name = surface exchange coeff heat & moisture over land + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in optional = F [evbs] standard_name = soil_upward_latent_heat_flux @@ -1157,15 +1185,6 @@ kind = kind_phys intent = out optional = F -[sbsno] - standard_name = snow_deposition_sublimation_upward_latent_heat_flux - long_name = latent heat flux from snow depo/subl - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [stm] standard_name = soil_moisture_content long_name = soil moisture content @@ -1184,6 +1203,150 @@ kind = kind_phys intent = inout optional = F +[snowfallac_lnd] + standard_name = total_accumulated_snowfall_over_land + long_name = run-total snow accumulation on the ground over land + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcqc_ice] + standard_name = cloud_condensed_water_mixing_ratio_at_surface_over_ice + long_name = moist cloud water mixing ratio at surface over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcdew_ice] + standard_name = surface_condensation_mass_over_ice + long_name = surface condensation mass over ice + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcqv_ice] + standard_name = water_vapor_mixing_ratio_at_surface_over_ice + long_name = water vapor mixing ratio at surface over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tice] + standard_name = sea_ice_temperature_interstitial + long_name = sea ice surface skin temperature use as interstitial + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsnow_ice] + standard_name = snow_temperature_bottom_first_layer_over_ice + long_name = snow temperature at the bottom of first snow layer over ice + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[z0rl_ice] + standard_name = surface_roughness_length_over_ice_interstitial + long_name = surface roughness length over ice (temporary use as interstitial) + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsurf_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[gflux_ice] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evap_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ep1d_ice] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cm_ice] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_ice + long_name = surface exchange coeff for momentum over ice + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ch_ice] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air + long_name = surface exchange coeff heat & moisture + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowfallac_ice] + standard_name = total_accumulated_snowfall_over_ice + long_name = run-total snow accumulation on the ground over ice + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [acsnow] standard_name = accumulated_water_equivalent_of_frozen_precip long_name = snow water equivalent of run-total frozen precip @@ -1193,14 +1356,75 @@ kind = kind_phys intent = inout optional = F -[snowfallac] - standard_name = total_accumulated_snowfall - long_name = run-total snow accumulation on the ground - units = kg m-2 +[rhosnf] + standard_name = density_of_frozen_precipitation + long_name = density of frozen precipitation + units = kg m-3 dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout + intent = out + optional = F +[sbsno] + standard_name = snow_deposition_sublimation_upward_latent_heat_flux + long_name = latent heat flux from snow depo/subl + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cmm_lnd] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_land + long_name = momentum exchange coefficient over land + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[chh_lnd] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_land + long_name = thermal exchange coefficient over land + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cmm_ice] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[chh_ice] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[flag_guess] + standard_name = flag_for_guess_run + long_name = flag for guess run + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in optional = F [flag_init] standard_name = flag_for_first_time_step @@ -1218,6 +1442,22 @@ type = logical intent = in optional = F +[flag_cice] + standard_name = flag_for_cice + long_name = flag for cice + units = flag + dimensions = (horizontal_dimension) + type = logical + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 9b6366826c22ea81a1ca1966db99a874d674cbfd Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 16 Oct 2020 20:39:44 -0600 Subject: [PATCH 080/274] Fix metadata, remove moninedmf_hafs, remove dkudiagnostic from satmedmfvdifq --- physics/moninedmf.meta | 2 +- physics/moninedmf_hafs.f | 1560 ----------------------------------- physics/moninedmf_hafs.meta | 533 ------------ physics/satmedmfvdifq.F | 11 +- 4 files changed, 3 insertions(+), 2103 deletions(-) delete mode 100644 physics/moninedmf_hafs.f delete mode 100644 physics/moninedmf_hafs.meta diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index d518ed21e..b14dbd2fc 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -509,7 +509,7 @@ standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F diff --git a/physics/moninedmf_hafs.f b/physics/moninedmf_hafs.f deleted file mode 100644 index 25ad5ca02..000000000 --- a/physics/moninedmf_hafs.f +++ /dev/null @@ -1,1560 +0,0 @@ -!> \file moninedmf_hafs.f -!! Contains most of the hybrid eddy-diffusivity mass-flux scheme except for the -!! subroutine that calculates the mass flux and updraft properties. - -!> This module contains the CCPP-compliant hybrid eddy-diffusivity mass-flux -!! scheme. - module hedmf_hafs - - contains - -!> \section arg_table_hedmf_hafs_init Argument Table -!! \htmlinclude hedmf_hafs_init.html -!! - subroutine hedmf_hafs_init (moninq_fac,errmsg,errflg) - use machine, only : kind_phys - implicit none - real(kind=kind_phys), intent(in ) :: moninq_fac - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (moninq_fac == 0) then - errflg = 1 - write(errmsg,'(*(a))') 'Logic error: moninq_fac == 0', & - & ' is incompatible with moninedmf_hafs' - end if - end subroutine hedmf_hafs_init - - subroutine hedmf_hafs_finalize () - end subroutine hedmf_hafs_finalize - - -!> \defgroup HEDMF GFS Hybrid Eddy-Diffusivity Mass-Flux (HEDMF) Scheme Module -!! @{ -!! \brief This subroutine contains all of logic for the -!! Hybrid EDMF PBL scheme except for the calculation of -!! the updraft properties and mass flux. -!! -!> \section arg_table_hedmf_hafs_run Argument Table -!! \htmlinclude hedmf_hafs_run.html -!! -!! \section general_edmf GFS Hybrid EDMF General Algorithm -!! -# Compute preliminary variables from input arguments. -!! -# Calculate the first estimate of the PBL height ("Predictor step"). -!! -# Calculate Monin-Obukhov similarity parameters. -!! -# Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). -!! -# Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion. -!! -# Calculate the inverse Prandtl number. -!! -# Compute diffusion coefficients below the PBL top. -!! -# Compute diffusion coefficients above the PBL top. -!! -# If the PBL is convective, call the mass flux scheme to replace the countergradient terms. -!! -# Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs. -!! -# Solve for the temperature and moisture tendencies due to vertical mixing. -!! -# Calculate heating due to TKE dissipation and add to the tendency for temperature. -!! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. -!! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm -!! @{ - subroutine hedmf_hafs_run(im,km,ntrac,ntcw,dv,du,tau,rtg, & - & u1,v1,t1,q1,swh,hlw,xmu, & - & psk,rbsoil,zorl,u10m,v10m,fm,fh, & - & tsea,heat,evap,stress,spd1,kpbl, & - & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & - & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & - & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & - & xkzminv,moninq_fac,islimsk,dkudiagnostic,errmsg,errflg) -! - use machine , only : kind_phys - use funcphys , only : fpvs - use physcons, grav => con_g, rd => con_rd, cp => con_cp & - &, hvap => con_hvap, fv => con_fvirt - implicit none -! -! arguments -! - logical, intent(in) :: lprnt - integer, intent(in) :: ipr - integer, intent(in) :: im, km, ntrac, ntcw, kinver(im) - integer, intent(in) :: islimsk(1:im) - integer, intent(out) :: kpbl(im) - -! - real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s - real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac - real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & - & tau(im,km), rtg(im,km,ntrac) - real(kind=kind_phys), intent(in) :: & - & u1(im,km), v1(im,km), & - & t1(im,km), q1(im,km,ntrac), & - & swh(im,km), hlw(im,km), & - & xmu(im), psk(im), & - & rbsoil(im), zorl(im), & - & u10m(im), v10m(im), & - & fm(im), fh(im), & - & tsea(im), & - & heat(im), evap(im), & - & stress(im), spd1(im) - real(kind=kind_phys), intent(in) :: & - & prsi(im,km+1), del(im,km), & - & prsl(im,km), prslk(im,km), & - & phii(im,km+1), phil(im,km) - real(kind=kind_phys), intent(out) :: & - & dusfc(im), dvsfc(im), & - & dtsfc(im), dqsfc(im), & - & hpbl(im), dkt(im,km-1) - - real(kind=kind_phys), intent(inout) :: & - & hgamt(im), hgamq(im) -! - logical, intent(in) :: dspheat -! flag for tke dissipative heating - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! -! locals -! - integer i,iprt,is,iun,k,kk,km1,kmpbl,latd,lond - integer lcld(im),icld(im),kcld(im),krad(im) - integer kx1(im), kpblx(im) -! -! real(kind=kind_phys) betaq(im), betat(im), betaw(im), - real(kind=kind_phys) phih(im), phim(im), hpblx(im), & - & rbdn(im), rbup(im), & - & beta(im), sflux(im), & - & z0(im), crb(im), wstar(im), & - & zol(im), ustmin(im), ustar(im), & - & thermal(im),wscale(im), wscaleu(im) -! - real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), & - & qlx(im,km), thetae(im,km), & - & qtx(im,km), bf(im,km-1), diss(im,km), & - & radx(im,km-1), & - & govrth(im), hrad(im), & -! & hradm(im), radmin(im), vrad(im), & - & radmin(im), vrad(im), & - & zd(im), zdd(im), thlvx1(im) -! - real(kind=kind_phys) rdzt(im,km-1),dktx(im,km-1), & - & zi(im,km+1), zl(im,km), xkzo(im,km-1), & - & dku(im,km-1), xkzmo(im,km-1), & - & cku(im,km-1), ckt(im,km-1), & - & ti(im,km-1), shr2(im,km-1), & - & al(im,km-1), ad(im,km), & - & au(im,km-1), a1(im,km), & - & a2(im,km*ntrac), dkudiagnostic(im,km-1) -! - real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), & - & ucko(im,km), vcko(im,km), xmf(im,km) -! - real(kind=kind_phys) prinv(im), rent(im) -! - logical pblflg(im), sfcflg(im), scuflg(im), flg(im) - logical ublflg(im), pcnvflg(im) -! -! pcnvflg: true for convective(strongly unstable) pbl -! ublflg: true for unstable but not convective(strongly unstable) pbl -! - real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, - & cfac, conq, cont, conw, - & dk, dkmax, dkmin, - & dq1, dsdz2, dsdzq, dsdzt, - & dsdzu, dsdzv, - & dsig, dt2, dthe1, dtodsd, - & dtodsu, dw2, dw2min, g, - & gamcrq, gamcrt, gocp, - & gravi, f0, - & prnum, prmax, prmin, pfac, crbcon, - & qmin, tdzmin, qtend, crbmin,crbmax, - & rbint, rdt, rdz, qlmin, - & ri, rimin, rl2, rlam, rlamun, - & rone, rzero, sfcfrac, - & spdk2, sri, zol1, zolcr, zolcru, - & robn, ttend, - & utend, vk, vk2, - & ust3, wst3, - & vtend, zfac, vpert, cteit, - & rentf1, rentf2, radfac, - & zfmin, zk, tem, tem1, tem2, - & xkzm, xkzmu, - & ptem, ptem1, ptem2, tx1(im), tx2(im) -! - real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, - & cldtime - -!! for aplha - real(kind=kind_phys) WSPM(IM,KM-1) - integer kLOC ! RGF - real :: xDKU, ALPHA ! RGF - - integer :: useshape - real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax - - -!cc - parameter(gravi=1.0/grav) - parameter(g=grav) - parameter(gocp=g/cp) - parameter(cont=cp/g,conq=hvap/g,conw=1.0/g) ! for del in pa -! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) ! for del in kpa - parameter(rlam=30.0,vk=0.4,vk2=vk*vk) - parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) - parameter(dw2min=0.0001,dkmin=0.0,dkmax=1000.,rimin=-100.) - parameter(crbcon=0.25,crbmin=0.15,crbmax=0.35) - parameter(wfac=7.0,cfac=6.5,pfac=2.0,sfcfrac=0.1) -! parameter(qmin=1.e-8,xkzm=1.0,zfmin=1.e-8,aphi5=5.,aphi16=16.) - parameter(qmin=1.e-8, zfmin=1.e-8,aphi5=5.,aphi16=16.) - parameter(tdzmin=1.e-3,qlmin=1.e-12,f0=1.e-4) - parameter(h1=0.33333333,h2=0.66666667) -! parameter(cldtime=500.,xkzminv=0.3) - parameter(cldtime=500.) -! parameter(cldtime=500.,xkzmu=3.0,xkzminv=0.3) -! parameter(gamcrt=3.,gamcrq=2.e-3,rlamun=150.0) - parameter(gamcrt=3.,gamcrq=0.,rlamun=150.0) - parameter(rentf1=0.2,rentf2=1.0,radfac=0.85) - parameter(iun=84) -! -! parameter (zstblmax = 2500., qlcr=1.0e-5) -! parameter (zstblmax = 2500., qlcr=3.0e-5) -! parameter (zstblmax = 2500., qlcr=3.5e-5) -! parameter (zstblmax = 2500., qlcr=1.0e-4) - parameter (zstblmax = 2500., qlcr=3.5e-5) -! parameter (actei = 0.23) - parameter (actei = 0.7) - -! HAFS PBL: height-dependent ALPHA - useshape=2 !0-- no change, origincal ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) - alpha=moninq_fac - - ! write(0,*)'in PBL,alpha=',alpha - - ! write(0,*)'islimsk=',(islimsk(i),i=1,im) - -c -c----------------------------------------------------------------------- -c - 601 format(1x,' moninp lat lon step hour ',3i6,f6.1) - 602 format(1x,' k',' z',' t',' th', - 1 ' tvh',' q',' u',' v', - 2 ' sp') - 603 format(1x,i5,8f9.1) - 604 format(1x,' sfc',9x,f9.1,18x,f9.1) - 605 format(1x,' k zl spd2 thekv the1v' - 1 ,' thermal rbup') - 606 format(1x,i5,6f8.2) - 607 format(1x,' kpbl hpbl fm fh hgamt', - 1 ' hgamq ws ustar cd ch') - 608 format(1x,i5,9f8.2) - 609 format(1x,' k pr dkt dku ',i5,3f8.2) - 610 format(1x,' k pr dkt dku ',i5,3f8.2,' l2 ri t2', - 1 ' sr2 ',2f8.2,2e10.2) -! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 -!> ## Compute preliminary variables from input arguments - -! compute preliminary variables -! -! iprt = 0 -! if(iprt.eq.1) then -!cc latd = 0 -! lond = 0 -! else -!cc latd = 0 -! lond = 0 -! endif -! - dt2 = delt - rdt = 1. / dt2 - km1 = km - 1 - kmpbl = km / 2 -!> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) - do k=1,km - do i=1,im - zi(i,k) = phii(i,k) * gravi - zl(i,k) = phil(i,k) * gravi - enddo - enddo - do i=1,im - zi(i,km+1) = phii(i,km+1) * gravi - enddo -!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) - do k = 1,km1 - do i=1,im - rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) - enddo - enddo -!> - Compute reciprocal of pressure (tx1, tx2) - do i=1,im - kx1(i) = 1 - tx1(i) = 1.0 / prsi(i,1) - tx2(i) = tx1(i) - enddo -!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) - do k = 1,km1 - do i=1,im - xkzo(i,k) = 0.0 - xkzmo(i,k) = 0.0 - if (k < kinver(i)) then -! vertical background diffusivity - ptem = prsi(i,k+1) * tx1(i) - tem1 = 1.0 - ptem - tem1 = tem1 * tem1 * 10.0 - xkzo(i,k) = xkzm_h * min(1.0, exp(-tem1)) - -! vertical background diffusivity for momentum - if (ptem >= xkzm_s) then - xkzmo(i,k) = xkzm_m - kx1(i) = k + 1 - else - if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) - tem1 = 1.0 - prsi(i,k+1) * tx2(i) - tem1 = tem1 * tem1 * 5.0 - xkzmo(i,k) = xkzm_m * min(1.0, exp(-tem1)) - endif - endif - enddo - enddo - -! if (lprnt) then -! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) -! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) -! endif -! -! diffusivity in the inversion layer is set to be xkzminv (m^2/s) -!> - The background scalar vertical diffusivity is limited to be less than or equal to xkzminv - do k = 1,kmpbl - do i=1,im -! if(zi(i,k+1) > 200..and.zi(i,k+1) < zstblmax) then - if(zi(i,k+1) > 250.) then - tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) - if(tem1 > 1.e-5) then - xkzo(i,k) = min(xkzo(i,k),xkzminv) - endif - endif - enddo - enddo -!> - Some output variables and logical flags are initialized - do i = 1,im - z0(i) = 0.01 * zorl(i) - dusfc(i) = 0. - dvsfc(i) = 0. - dtsfc(i) = 0. - dqsfc(i) = 0. - wscale(i)= 0. - wscaleu(i)= 0. - kpbl(i) = 1 - hpbl(i) = zi(i,1) - hpblx(i) = zi(i,1) - pblflg(i)= .true. - sfcflg(i)= .true. - if(rbsoil(i) > 0.) sfcflg(i) = .false. - ublflg(i)= .false. - pcnvflg(i)= .false. - scuflg(i)= .true. - if(scuflg(i)) then - radmin(i)= 0. - rent(i) = rentf1 - hrad(i) = zi(i,1) -! hradm(i) = zi(i,1) - krad(i) = 1 - icld(i) = 0 - lcld(i) = km1 - kcld(i) = km1 - zd(i) = 0. - endif - enddo -!> - Compute \f$\theta\f$ (theta), \f$q_l\f$ (qlx), \f$q_t\f$ (qtx), \f$\theta_e\f$ (thetae), \f$\theta_v\f$ (thvx), \f$\theta_{l,v}\f$ (thlvx) - do k = 1,km - do i = 1,im - theta(i,k) = t1(i,k) * psk(i) / prslk(i,k) - qlx(i,k) = max(q1(i,k,ntcw),qlmin) - qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) - ptem = qlx(i,k) - ptem1 = hvap*max(q1(i,k,1),qmin)/(cp*t1(i,k)) - thetae(i,k)= theta(i,k)*(1.+ptem1) - thvx(i,k) = theta(i,k)*(1.+fv*max(q1(i,k,1),qmin)-ptem) - ptem2 = theta(i,k)-(hvap/cp)*ptem - thlvx(i,k) = ptem2*(1.+fv*qtx(i,k)) - enddo - enddo -!> - Initialize diffusion coefficients to 0 and calculate the total radiative heating rate (dku, dkt, radx) - do k = 1,km1 - do i = 1,im - dku(i,k) = 0. - dkt(i,k) = 0. - dktx(i,k) = 0. - cku(i,k) = 0. - ckt(i,k) = 0. - tem = zi(i,k+1)-zi(i,k) - radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) - enddo - enddo -!> - Set lcld to first index above 2.5km - do i=1,im - flg(i) = scuflg(i) - enddo - do k = 1, km1 - do i=1,im - if(flg(i).and.zl(i,k) >= zstblmax) then - lcld(i)=k - flg(i)=.false. - endif - enddo - enddo -! -! compute virtual potential temp gradient (bf) and winshear square -!> - Compute \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) and the wind shear squared (shr2) - do k = 1, km1 - do i = 1, im - rdz = rdzt(i,k) - bf(i,k) = (thvx(i,k+1)-thvx(i,k))*rdz - ti(i,k) = 2./(t1(i,k)+t1(i,k+1)) - dw2 = (u1(i,k)-u1(i,k+1))**2 - & + (v1(i,k)-v1(i,k+1))**2 - shr2(i,k) = max(dw2,dw2min)*rdz*rdz - enddo - enddo -!> - Calculate \f$\frac{g}{\theta}\f$ (govrth), \f$\beta = \frac{\Delta t}{\Delta z}\f$ (beta), \f$u_*\f$ (ustar), total surface flux (sflux), and set pblflag to false if the total surface energy flux is into the surface - do i = 1,im - govrth(i) = g/theta(i,1) - enddo -! - do i=1,im - beta(i) = dt2 / (zi(i,2)-zi(i,1)) - enddo -! - do i=1,im - ustar(i) = sqrt(stress(i)) - enddo -! - do i = 1,im - sflux(i) = heat(i) + evap(i)*fv*theta(i,1) - if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. - enddo -!> ## Calculate the first estimate of the PBL height (``Predictor step") -!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. -!! -!! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. -! compute the pbl height -! - do i=1,im - flg(i) = .false. - rbup(i) = rbsoil(i) - - IF ( ALPHA .GT. 0.0) THEN ! ALPHA - - if(pblflg(i)) then - thermal(i) = thvx(i,1) - crb(i) = crbcon - else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) - tem = sqrt(u10m(i)**2+v10m(i)**2) - tem = max(tem, 1.) - robn = tem / (f0 * z0(i)) - tem1 = 1.e-7 * robn - crb(i) = 0.16 * (tem1 ** (-0.18)) - crb(i) = max(min(crb(i), crbmax), crbmin) - endif - - ELSE -! use variable Ri for all conditions - if(pblflg(i)) then - thermal(i) = thvx(i,1) - else - thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) - endif - tem = sqrt(u10m(i)**2+v10m(i)**2) - tem = max(tem, 1.) - robn = tem / (f0 * z0(i)) - tem1 = 1.e-7 * robn -! crb(i) = 0.16 * (tem1 ** (-0.18)) - crb(i) = crbcon - IF(islimsk(i).ne.0) crb(I) = 0.16*(tem1)**(-0.18) - IF(islimsk(i).eq.0) crb(I) = 0.25*(tem1)**(-0.18) - crb(i) = max(min(crb(i), crbmax), crbmin) - ENDIF ! ALPHA - - enddo - -!> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): -!! \f[ -!! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} -!! \f] -!! where \f$h\f$ is the PBL height, \f$Ri\f$ is the Richardson number, \f$T_0\f$ is the virtual potential temperature near the surface, \f$\left|\vec{v}\right|\f$ is the wind speed, and \f$\theta_s\f$ is for the thermal. Rearranging this equation to calculate the modified Richardson number at each level, k, for comparison with the critical value yields: -!! \f[ -!! Ri_k = gz(k)\frac{\left(\theta_v(k) - \theta_s\right)}{\theta_v(1)*\vec{v}(k)} -!! \f] - do k = 1, kmpbl - do i = 1, im - if(.not.flg(i)) then - rbdn(i) = rbup(i) - spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) - rbup(i) = (thvx(i,k)-thermal(i))* - & (g*zl(i,k)/thvx(i,1))/spdk2 - kpbl(i) = k - flg(i) = rbup(i) > crb(i) - endif - enddo - enddo - -!> Once the level is found, some linear interpolation is performed to find the exact height of the boundary layer top (where \f$Ri = Ri_{cr}\f$) and the PBL height and the PBL top index are saved (hpblx and kpblx, respectively) - do i = 1,im - if(kpbl(i) > 1) then - k = kpbl(i) - if(rbdn(i) >= crb(i)) then - rbint = 0. - elseif(rbup(i) <= crb(i)) then - rbint = 1. - else - rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) - endif - hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) - if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 - else - hpbl(i) = zl(i,1) - kpbl(i) = 1 - endif - kpblx(i) = kpbl(i) - hpblx(i) = hpbl(i) - enddo -! -! compute similarity parameters -!> ## Calculate Monin-Obukhov similarity parameters -!! Using the initial guess for the PBL height, Monin-Obukhov similarity parameters are calculated. They are needed to refine the PBL height calculation and for calculating diffusion coefficients. -!! -!! First, calculate the Monin-Obukhov nondimensional stability parameter, commonly referred to as \f$\zeta\f$ using the following equation from Businger et al. (1971) \cite businger_et_al_1971 (equation 28): -!! \f[ -!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} -!! \f] -!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and \f$L\f$ is the Obukhov length. Then, the nondimensional gradients of momentum and temperature (phim and phih) are calculated using equations 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability. Then, the velocity scale valid for the surface layer (\f$w_s\f$, wscale) is calculated using equation 3 from Hong and Pan (1996) \cite hong_and_pan_1996. For the neutral and unstable PBL above the surface layer, the convective velocity scale, \f$w_*\f$, is calculated according to: -!! \f[ -!! w_* = \left(\frac{g}{\theta_0}h\overline{w'\theta_0'}\right)^{1/3} -!! \f] -!! and the mixed layer velocity scale is then calculated with equation 6 from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 -!! \f[ -!! w_s = (u_*^3 + 7\epsilon k w_*^3)^{1/3} -!! \f] - do i=1,im - zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) - if(sfcflg(i)) then - zol(i) = min(zol(i),-zfmin) - else - zol(i) = max(zol(i),zfmin) - endif - zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) - if(sfcflg(i)) then -! phim(i) = (1.-aphi16*zol1)**(-1./4.) -! phih(i) = (1.-aphi16*zol1)**(-1./2.) - tem = 1.0 / (1. - aphi16*zol1) - phih(i) = sqrt(tem) - phim(i) = sqrt(phih(i)) - else - phim(i) = 1. + aphi5*zol1 - phih(i) = phim(i) - endif - wscale(i) = ustar(i)/phim(i) - ustmin(i) = ustar(i)/aphi5 - wscale(i) = max(wscale(i),ustmin(i)) - enddo - do i=1,im - if(pblflg(i)) then - if(zol(i) < zolcru .and. kpbl(i) > 1) then - pcnvflg(i) = .true. - else - ublflg(i) = .true. - endif - wst3 = govrth(i)*sflux(i)*hpbl(i) - wstar(i)= wst3**h1 - ust3 = ustar(i)**3. - wscaleu(i) = (ust3+wfac*vk*wst3*sfcfrac)**h1 - wscaleu(i) = max(wscaleu(i),ustmin(i)) - endif - enddo -! -! compute counter-gradient mixing term for heat and moisture -!> ## Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). -!! Next, the counter-gradient terms for temperature and humidity are calculated using equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) so that the properties of the thermal are updated to recalculate the PBL height. - do i = 1,im - if(ublflg(i)) then - hgamt(i) = min(cfac*heat(i)/wscaleu(i),gamcrt) - hgamq(i) = min(cfac*evap(i)/wscaleu(i),gamcrq) - vpert = hgamt(i) + hgamq(i)*fv*theta(i,1) - vpert = min(vpert,gamcrt) - thermal(i)= thermal(i)+max(vpert,0.) - hgamt(i) = max(hgamt(i),0.0) - hgamq(i) = max(hgamq(i),0.0) - endif - enddo -! -! enhance the pbl height by considering the thermal excess -!> The PBL height calculation follows the same procedure as the predictor step, except that it uses an updated virtual potential temperature for the thermal. - do i=1,im - flg(i) = .true. - if(ublflg(i)) then - flg(i) = .false. - rbup(i) = rbsoil(i) - endif - enddo - do k = 2, kmpbl - do i = 1, im - if(.not.flg(i)) then - rbdn(i) = rbup(i) - spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) - rbup(i) = (thvx(i,k)-thermal(i))* - & (g*zl(i,k)/thvx(i,1))/spdk2 - kpbl(i) = k - flg(i) = rbup(i) > crb(i) - endif - enddo - enddo - do i = 1,im - if(ublflg(i)) then - k = kpbl(i) - if(rbdn(i) >= crb(i)) then - rbint = 0. - elseif(rbup(i) <= crb(i)) then - rbint = 1. - else - rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) - endif - hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) - if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 - if(kpbl(i) <= 1) then - ublflg(i) = .false. - pblflg(i) = .false. - endif - endif - enddo -! -! look for stratocumulus -!> ## Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion -!! - Starting at the PBL top and going downward, if the level is less than 2.5 km and \f$q_l>q_{l,cr}\f$ then set kcld = k (find the cloud top index in the PBL). If no cloud water above the threshold is found, scuflg is set to F. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,1,-1 - do i = 1, im - if(flg(i) .and. k <= lcld(i)) then - if(qlx(i,k).ge.qlcr) then - kcld(i)=k - flg(i)=.false. - endif - endif - enddo - enddo - do i = 1, im - if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. - enddo -!> - Starting at the PBL top and going downward, if the level is less than the cloud top, find the level of the minimum radiative heating rate within the cloud. If the level of the minimum is the lowest model level or the minimum radiative heating rate is positive, then set scuflg to F. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,1,-1 - do i = 1, im - if(flg(i) .and. k <= kcld(i)) then - if(qlx(i,k) >= qlcr) then - if(radx(i,k) < radmin(i)) then - radmin(i)=radx(i,k) - krad(i)=k - endif - else - flg(i)=.false. - endif - endif - enddo - enddo - do i = 1, im - if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. - if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. - enddo -!> - Starting at the PBL top and going downward, count the number of levels below the minimum radiative heating rate level that have cloud water above the threshold. If there are none, then set the scuflg to F. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,2,-1 - do i = 1, im - if(flg(i) .and. k <= krad(i)) then - if(qlx(i,k) >= qlcr) then - icld(i)=icld(i)+1 - else - flg(i)=.false. - endif - endif - enddo - enddo - do i = 1, im - if(scuflg(i) .and. icld(i) < 1) scuflg(i)=.false. - enddo -!> - Find the height of the interface where the minimum in radiative heating rate is located. If this height is less than the second model interface height, then set the scuflg to F. - do i = 1, im - if(scuflg(i)) then - hrad(i) = zi(i,krad(i)+1) -! hradm(i)= zl(i,krad(i)) - endif - enddo -! - do i = 1, im - if(scuflg(i) .and. hrad(i) - Calculate the hypothetical \f$\theta_v\f$ at the minimum radiative heating level that a parcel would reach due to radiative cooling after a typical cloud turnover time spent at that level. - do i = 1, im - if(scuflg(i)) then - k = krad(i) - tem = zi(i,k+1)-zi(i,k) - tem1 = cldtime*radmin(i)/tem - thlvx1(i) = thlvx(i,k)+tem1 -! if(thlvx1(i) > thlvx(i,k-1)) scuflg(i)=.false. - endif - enddo -!> - Determine the distance that a parcel would sink downwards starting from the level of minimum radiative heating rate by comparing the hypothetical minimum \f$\theta_v\f$ calculated above with the environmental \f$\theta_v\f$. - do i = 1, im - flg(i)=scuflg(i) - enddo - do k = kmpbl,1,-1 - do i = 1, im - if(flg(i) .and. k <= krad(i))then - if(thlvx1(i) <= thlvx(i,k))then - tem=zi(i,k+1)-zi(i,k) - zd(i)=zd(i)+tem - else - flg(i)=.false. - endif - endif - enddo - enddo -!> - Calculate the cloud thickness, where the cloud top is the in-cloud minimum radiative heating level and the bottom is determined previously. - do i = 1, im - if(scuflg(i))then - kk = max(1, krad(i)+1-icld(i)) - zdd(i) = hrad(i)-zi(i,kk) - endif - enddo -!> - Find the largest between the cloud thickness and the distance of a sinking parcel, then determine the smallest of that number and the height of the minimum in radiative heating rate. Set this number to \f$zd\f$. Using \f$zd\f$, calculate the characteristic velocity scale of cloud-top radiative cooling-driven turbulence. - do i = 1, im - if(scuflg(i))then - zd(i) = max(zd(i),zdd(i)) - zd(i) = min(zd(i),hrad(i)) - tem = govrth(i)*zd(i)*(-radmin(i)) - vrad(i)= tem**h1 - endif - enddo -! -! compute inverse prandtl number -!> ## Calculate the inverse Prandtl number -!! For an unstable PBL, the Prandtl number is calculated according to Hong and Pan (1996) \cite hong_and_pan_1996, equation 10, whereas for a stable boundary layer, the Prandtl number is simply \f$Pr = \frac{\phi_h}{\phi_m}\f$. - do i = 1, im - if(ublflg(i)) then - tem = phih(i)/phim(i)+cfac*vk*sfcfrac - else - tem = phih(i)/phim(i) - endif - prinv(i) = 1.0 / tem - prinv(i) = min(prinv(i),prmax) - prinv(i) = max(prinv(i),prmin) - enddo - do i = 1, im - if(zol(i) > zolcr) then - kpbl(i) = 1 - endif - enddo - -!!! HAFS PBL, Bgin adjustment -! RGF determine wspd at roughly 500 m above surface, or as close as possible, -! reuse SPDK2 -! zi(i,k) is AGL, right? May not matter if applied only to water grid points - if(moninq_fac.lt.0)then - - DO I=1,IM - SPDK2 = 0. - WSPM(i,1) = 0. - DO K = 1, KMPBL ! kmpbl is like a max possible pbl height - if(zi(i,k).le.500.and.zi(i,k+1).gt.500.)then ! find level bracketing 500 m - SPDK2 = SQRT(U1(i,k)*U1(i,k)+V1(i,k)*V1(i,k)) ! wspd near 500 m - WSPM(i,1) = SPDK2/0.6 ! now the Km limit for 500 m. just store in K=1 - WSPM(i,2) = float(k) ! height of level at gridpoint i. store in K=2 -! if(i.eq.25) print *,' IK ',i,k,' ZI ',zi(i,k), ' WSPM1 ',wspm(i,1),' -! KMPBL ',kmpbl,' KPBL ',kpbl(i) - endif - ENDDO - ENDDO ! i - - endif ! moninq_fac < 0 - - -! -! compute diffusion coefficients below pbl -!> ## Compute diffusion coefficients below the PBL top -!! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. - - IF (ALPHA > 0) THEN ! AAAAAAAAAAAAAAAAAAAAAAAAAAA - - do k = 1, kmpbl - do i=1,im - if(k < kpbl(i)) then -! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ -! 1 (hpbl(i)-zl(i,1))), zfmin) - zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) - tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg - if(pblflg(i)) then - tem1 = vk * wscaleu(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - else - tem1 = vk * wscale(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - endif - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) - dktx(i,k)= dkt(i,k) - endif - enddo - enddo - - ELSE ! ALPHA <0 AAAAAAAAAAAAA - - do i=1,im - do k = 1, kmpbl - if(k < kpbl(i)) then -! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ -! 1 (hpbl(i)-zl(i,1))), zfmin) - zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) - ! tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg - tem = zi(i,k+1) * (zfac**pfac) * abs( moninq_fac) - -!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W - if(useshape .ge. 1) then - sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) - sz2h=max(sz2h,zfmin) - sz2h=min(sz2h,1.0) - zfac=(1.0-sz2h)**pfac -! smax=0.148 !! max value of this shape function - smax=0.148 !! max value of this shape function - hmax=0.333 !! roughly height if max K - skmax=hmax*(1.0-hmax)**pfac - sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) - sksfc=sksfc*(1-sksfc)**pfac - - zfac=max(zfac,zfmin) - ashape=max(ABS(moninq_fac),0.2) ! should not be smaller than 0.2, otherwise too much adjustment(?) - if(useshape ==1) then - ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) - & *( 1.0 - ashape ) ) - tem = zi(i,k+1) * (zfac) * ashape - endif - - if (useshape == 2) then !only adjus K that is > K_surface_top - ashape1=1.0 - if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ - & (skmax-sksfc) - skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc - tem = zi(i,k+1) * (zfac) ! no adjustment - if (skminusk0 > 0) then ! only adjust K which is > surface top K - tem = skminusk0*ashape1 + HPBL(i)*sksfc - endif - endif - endif ! endif useshape>1 -!!!! END OF CHAGES , WANG W - - - if(pblflg(i)) then - tem1 = vk * wscaleu(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - else - tem1 = vk * wscale(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - endif - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) - dktx(i,k)= dkt(i,k) - endif - enddo !K loop - -! possible modification of first guess DKU, under certain conditions -! (1) this applies only to columns over water - - IF(islimsk(i).eq.0)then ! sea only - -! (2) alpha test -! if alpha < 0, find alpha for each column and do the loop again -! if alpha > 0, we are finished - - - if(alpha.lt.0)then ! variable alpha test - -! k-level of layer around 500 m - kLOC = INT(WSPM(i,2)) -! print *,' kLOC ',kLOC,' KPBL ',KPBL(I) - -! (3) only do this IF KPBL(I) >= kLOC. Otherwise, we are finished, with DKU as -! if alpha = +1 - - if(KPBL(I).gt.kLOC)then - - xDKU = DKU(i,kLOC) ! Km at k-level -! (4) DKU check. -! WSPM(i,1) is the KM cap for the 500-m level. -! if DKU at 500-m level < WSPM(i,1), do not limit Km ANYWHERE. Alpha = -! abs(alpha). No need to recalc. -! if DKU at 500-m level > WSPM(i,1), then alpha = WSPM(i,1)/xDKU for entire -! column - if(xDKU.ge.WSPM(i,1)) then ! ONLY if DKU at 500-m exceeds cap, otherwise already done - - WSPM(i,3) = WSPM(i,1)/xDKU ! ratio of cap to Km at k-level, store in WSPM(i,3) - !WSPM(i,4) = amin1(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed - WSPM(i,4) = min(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed - !! recalculate K capped by WSPM(i,1) - do k = 1, kmpbl - if(k < kpbl(i)) then -! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ -! 1 (hpbl(i)-zl(i,1))), zfmin) - zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) - ! tem = zi(i,k+1) * (zfac**pfac) - tem = zi(i,k+1) * (zfac**pfac) * WSPM(i,4) - - -!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W - if(useshape .ge. 1) then - sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) - sz2h=max(sz2h,zfmin) - sz2h=min(sz2h,1.0) - zfac=(1.0-sz2h)**pfac - smax=0.148 !! max value of this shape function - hmax=0.333 !! roughly height if max K - skmax=hmax*(1.0-hmax)**pfac - sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) - sksfc=sksfc*(1-sksfc)**pfac - - zfac=max(zfac,zfmin) - ashape=max(WSPM(i,4),0.2) !! adjustment coef should not smaller than 0.2 - if(useshape ==1) then - ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) - & *( 1.0 - ashape ) ) - tem = zi(i,k+1) * (zfac) * ashape -! if(k ==5) write(0,*)'min alf, height-depend alf',WSPM(i,4),ashape - endif ! endif useshape=1 - - if (useshape == 2) then !only adjus K that is > K_surface_top - ashape1=1.0 - if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ - & (skmax-sksfc) - - skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc - tem = zi(i,k+1) * (zfac) ! no adjustment -! if(k ==5) write(0,*)'before, dku,ashape,ashpe1', -! & tem*wscaleu(i)*vk,ashape,ashape1 - if (skminusk0 > 0) then ! only adjust K which is > surface top K - tem = skminusk0*ashape1 + HPBL(i)*sksfc - endif -! if(k ==5)write(0,*) -! & 'after,dku,k_sfc,skmax,sksfc,zi(2),hpbl' -! & ,tem*wscaleu(i)*vk,WSCALEU(I)*VK*HPBL(i)*sksfc, skmax, -! & sksfc,ZI(I,2),HPBL(I) - - endif ! endif useshape=2 - endif ! endif useshape>1 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - - if(pblflg(i)) then - tem1 = vk * wscaleu(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - else - tem1 = vk * wscale(i) * tem -! dku(i,k) = xkzmo(i,k) + tem1 -! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) - dku(i,k) = tem1 - dkt(i,k) = tem1 * prinv(i) - endif - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) - dktx(i,k)= dkt(i,k) - endif - enddo !K loop - endif ! xDKU.ge.WSPM(i,1) - endif ! KPBL(I).ge.kLOC - endif ! alpha < 0 - endif ! islimsk=0 - - enddo !I loop - ENDIF !AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA - -! -! compute diffusion coefficients based on local scheme above pbl -!> ## Compute diffusion coefficients above the PBL top -!! Diffusion coefficients above the PBL top are computed as a function of local stability (gradient Richardson number), shear, and a length scale from Louis (1979) \cite louis_1979 : -!! \f[ -!! K_{m,h}=l^2f_{m,h}(Ri_g)\left|\frac{\partial U}{\partial z}\right| -!! \f] -!! The functions used (\f$f_{m,h}\f$) depend on the local stability. First, the gradient Richardson number is calculated as -!! \f[ -!! Ri_g=\frac{\frac{g}{T}\frac{\partial \theta_v}{\partial z}}{\frac{\partial U}{\partial z}^2} -!! \f] -!! where \f$U\f$ is the horizontal wind. For the unstable case (\f$Ri_g < 0\f$), the Richardson number-dependent functions are given by -!! \f[ -!! f_h(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.286\sqrt{\left|Ri_g\right|}}\\ -!! \f] -!! \f[ -!! f_m(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.746\sqrt{\left|Ri_g\right|}}\\ -!! \f] -!! For the stable case, the following formulas are used -!! \f[ -!! f_h(Ri_g) = \frac{1}{\left(1 + 5Ri_g\right)^2}\\ -!! \f] -!! \f[ -!! Pr = \frac{K_h}{K_m} = 1 + 2.1Ri_g -!! \f] -!! The source for the formulas used for the Richardson number-dependent functions is unclear. They are different than those used in Hong and Pan (1996) \cite hong_and_pan_1996 as the previous documentation suggests. They follow equation 14 of Louis (1979) \cite louis_1979 for the unstable case, but it is unclear where the values of the coefficients \f$b\f$ and \f$c\f$ from that equation used in this scheme originate. Finally, the length scale, \f$l\f$ is calculated according to the following formula from Hong and Pan (1996) \cite hong_and_pan_1996 -!! \f[ -!! \frac{1}{l} = \frac{1}{kz} + \frac{1}{l_0}\\ -!! \f] -!! \f[ -!! or\\ -!! \f] -!! \f[ -!! l=\frac{l_0kz}{l_0+kz} -!! \f] -!! where \f$l_0\f$ is currently 30 m for stable conditions and 150 m for unstable. Finally, the diffusion coefficients are kept in a range bounded by the background diffusion and the maximum allowable values. - do k = 1, km1 - do i=1,im - if(k >= kpbl(i)) then - bvf2 = g*bf(i,k)*ti(i,k) - ri = max(bvf2/shr2(i,k),rimin) - zk = vk*zi(i,k+1) - if(ri < 0.) then ! unstable regime - rl2 = zk*rlamun/(rlamun+zk) - dk = rl2*rl2*sqrt(shr2(i,k)) - sri = sqrt(-ri) -! dku(i,k) = xkzmo(i,k) + dk*(1+8.*(-ri)/(1+1.746*sri)) -! dkt(i,k) = xkzo(i,k) + dk*(1+8.*(-ri)/(1+1.286*sri)) - dku(i,k) = dk*(1+8.*(-ri)/(1+1.746*sri)) - dkt(i,k) = dk*(1+8.*(-ri)/(1+1.286*sri)) - else ! stable regime - rl2 = zk*rlam/(rlam+zk) -!! tem = rlam * sqrt(0.01*prsi(i,k)) -!! rl2 = zk*tem/(tem+zk) - dk = rl2*rl2*sqrt(shr2(i,k)) - tem1 = dk/(1+5.*ri)**2 -! - if(k >= kpblx(i)) then - prnum = 1.0 + 2.1*ri - prnum = min(prnum,prmax) - else - prnum = 1.0 - endif -! dku(i,k) = xkzmo(i,k) + tem1 * prnum -! dkt(i,k) = xkzo(i,k) + tem1 - dku(i,k) = tem1 * prnum - dkt(i,k) = tem1 - endif -! - dku(i,k) = min(dku(i,k),dkmax) - dku(i,k) = max(dku(i,k),xkzmo(i,k)) - dkt(i,k) = min(dkt(i,k),dkmax) - dkt(i,k) = max(dkt(i,k),xkzo(i,k)) -! - endif -! - enddo - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute components for mass flux mixing by large thermals -!> ## If the PBL is convective, call the mass flux scheme to replace the countergradient terms. -!! If the PBL is convective, the updraft properties are initialized to be the same as the state variables and the subroutine mfpbl is called. - do k = 1, km - do i = 1, im - if(pcnvflg(i)) then - tcko(i,k) = t1(i,k) - ucko(i,k) = u1(i,k) - vcko(i,k) = v1(i,k) - xmf(i,k) = 0. - endif - enddo - enddo - do kk = 1, ntrac - do k = 1, km - do i = 1, im - if(pcnvflg(i)) then - qcko(i,k,kk) = q1(i,k,kk) - endif - enddo - enddo - enddo -!> For details of the mfpbl subroutine, step into its documentation ::mfpbl - call mfpbl(im,im,km,ntrac,dt2,pcnvflg, - & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, - & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute diffusion coefficients for cloud-top driven diffusion -! if the condition for cloud-top instability is met, -! increase entrainment flux at cloud top -! -!> ## Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs -!! If a stratocumulus layer has been identified in the PBL, the diffusion coefficients in the PBL are modified in the following way. -!! -!! -# First, the criteria for CTEI is checked, using the threshold from equation 13 of Macvean and Mason (1990) \cite macvean_and_mason_1990. If the criteria is met, the cloud top diffusion is increased: -!! \f[ -!! K_h^{Sc} = -c\frac{\Delta F_R}{\rho c_p}\frac{1}{\frac{\partial \theta_v}{\partial z}} -!! \f] -!! where the constant \f$c\f$ is set to 0.2 if the CTEI criterion is not met and 1.0 if it is. -!! -!! -# Calculate the diffusion coefficients due to stratocumulus mixing according to equation 5 in Lock et al. (2000) \cite lock_et_al_2000 for every level below the stratocumulus top using the characteristic stratocumulus velocity scale previously calculated. The diffusion coefficient for momentum is calculated assuming a constant inverse Prandtl number of 0.75. - do i = 1, im - if(scuflg(i)) then - k = krad(i) - tem = thetae(i,k) - thetae(i,k+1) - tem1 = qtx(i,k) - qtx(i,k+1) - if (tem > 0. .and. tem1 > 0.) then - cteit= cp*tem/(hvap*tem1) - if(cteit > actei) rent(i) = rentf2 - endif - endif - enddo - do i = 1, im - if(scuflg(i)) then - k = krad(i) - tem1 = max(bf(i,k),tdzmin) - ckt(i,k) = -rent(i)*radmin(i)/tem1 - cku(i,k) = ckt(i,k) - endif - enddo -! - do k = 1, kmpbl - do i=1,im - if(scuflg(i) .and. k < krad(i)) then - tem1=hrad(i)-zd(i) - tem2=zi(i,k+1)-tem1 - if(tem2 > 0.) then - ptem= tem2/zd(i) - if(ptem.ge.1.) ptem= 1. - ptem= tem2*ptem*sqrt(1.-ptem) - ckt(i,k) = radfac*vk*vrad(i)*ptem - cku(i,k) = 0.75*ckt(i,k) - ckt(i,k) = max(ckt(i,k),dkmin) - ckt(i,k) = min(ckt(i,k),dkmax) - cku(i,k) = max(cku(i,k),dkmin) - cku(i,k) = min(cku(i,k),dkmax) - endif - endif - enddo - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! -!> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. - do k = 1, kmpbl - do i=1,im - if(scuflg(i)) then - ! dkt(i,k) = dkt(i,k)+ckt(i,k) - ! dku(i,k) = dku(i,k)+cku(i,k) - !! if K needs to be adjusted by alpha, then no need to add this term - if(alpha .ge. 0.0) dkt(i,k) = dkt(i,k)+ckt(i,k) - if(alpha .ge. 0.0) dku(i,k) = dku(i,k)+cku(i,k) - - dkt(i,k) = min(dkt(i,k),dkmax) - dku(i,k) = min(dku(i,k),dkmax) - endif - enddo - enddo -! -! compute tridiagonal matrix elements for heat and moisture -! -!> ## Solve for the temperature and moisture tendencies due to vertical mixing. -!! The tendencies of heat, moisture, and momentum due to vertical diffusion are calculated using a two-part process. First, a solution is obtained using an implicit time-stepping scheme, then the time tendency terms are "backed out". The tridiagonal matrix elements for the implicit solution for temperature and moisture are prepared in this section, with differing algorithms depending on whether the PBL was convective (substituting the mass flux term for counter-gradient term), unstable but not convective (using the computed counter-gradient terms), or stable (no counter-gradient terms). - do i=1,im - ad(i,1) = 1. - a1(i,1) = t1(i,1) + beta(i) * heat(i) - a2(i,1) = q1(i,1,1) + beta(i) * evap(i) - enddo - - if(ntrac >= 2) then - do k = 2, ntrac - is = (k-1) * km - do i = 1, im - a2(i,1+is) = q1(i,1,k) - enddo - enddo - endif -! - do k = 1,km1 - do i = 1,im - dtodsd = dt2/del(i,k) - dtodsu = dt2/del(i,k+1) - dsig = prsl(i,k)-prsl(i,k+1) - rdz = rdzt(i,k) - tem1 = dsig * dkt(i,k) * rdz - dsdz2 = tem1 * rdz - au(i,k) = -dtodsd*dsdz2 - al(i,k) = -dtodsu*dsdz2 -! - if(pcnvflg(i) .and. k < kpbl(i)) then - tem2 = dsig * rdz - ptem = 0.5 * tem2 * xmf(i,k) - ptem1 = dtodsd * ptem - ptem2 = dtodsu * ptem - ad(i,k) = ad(i,k)-au(i,k)-ptem1 - ad(i,k+1) = 1.-al(i,k)+ptem2 - au(i,k) = au(i,k)-ptem1 - al(i,k) = al(i,k)+ptem2 - ptem = tcko(i,k) + tcko(i,k+1) - dsdzt = tem1 * gocp - a1(i,k) = a1(i,k)+dtodsd*dsdzt-ptem1*ptem - a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+ptem2*ptem - ptem = qcko(i,k,1) + qcko(i,k+1,1) - a2(i,k) = a2(i,k) - ptem1 * ptem - a2(i,k+1) = q1(i,k+1,1) + ptem2 * ptem - elseif(ublflg(i) .and. k < kpbl(i)) then - ptem1 = dsig * dktx(i,k) * rdz - tem = 1.0 / hpbl(i) - dsdzt = tem1 * gocp - ptem1 * hgamt(i) * tem - dsdzq = - ptem1 * hgamq(i) * tem - ad(i,k) = ad(i,k)-au(i,k) - ad(i,k+1) = 1.-al(i,k) - a1(i,k) = a1(i,k)+dtodsd*dsdzt - a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt - a2(i,k) = a2(i,k)+dtodsd*dsdzq - a2(i,k+1) = q1(i,k+1,1)-dtodsu*dsdzq - else - ad(i,k) = ad(i,k)-au(i,k) - ad(i,k+1) = 1.-al(i,k) - dsdzt = tem1 * gocp - a1(i,k) = a1(i,k)+dtodsd*dsdzt - a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt - a2(i,k+1) = q1(i,k+1,1) - endif -! - enddo - enddo -! - if(ntrac >= 2) then - do kk = 2, ntrac - is = (kk-1) * km - do k = 1, km1 - do i = 1, im - if(pcnvflg(i) .and. k < kpbl(i)) then - dtodsd = dt2/del(i,k) - dtodsu = dt2/del(i,k+1) - dsig = prsl(i,k)-prsl(i,k+1) - tem = dsig * rdzt(i,k) - ptem = 0.5 * tem * xmf(i,k) - ptem1 = dtodsd * ptem - ptem2 = dtodsu * ptem - tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) - a2(i,k+is) = a2(i,k+is) - ptem1*tem1 - a2(i,k+1+is)= q1(i,k+1,kk) + ptem2*tem1 - else - a2(i,k+1+is) = q1(i,k+1,kk) - endif - enddo - enddo - enddo - endif -! -! solve tridiagonal problem for heat and moisture -! -!> The tridiagonal system is solved by calling the internal ::tridin subroutine. - call tridin99(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) - -! -! recover tendencies of heat and moisture -! -!> After returning with the solution, the tendencies for temperature and moisture are recovered. - do k = 1,km - do i = 1,im - ttend = (a1(i,k)-t1(i,k)) * rdt - qtend = (a2(i,k)-q1(i,k,1))*rdt - tau(i,k) = tau(i,k)+ttend - rtg(i,k,1) = rtg(i,k,1)+qtend - dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend - dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend - enddo - enddo - if(ntrac >= 2) then - do kk = 2, ntrac - is = (kk-1) * km - do k = 1, km - do i = 1, im - qtend = (a2(i,k+is)-q1(i,k,kk))*rdt - rtg(i,k,kk) = rtg(i,k,kk)+qtend - enddo - enddo - enddo - endif -! -! compute tke dissipation rate -! -!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature -!! Following Han et al. (2015) \cite han_et_al_2015 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2015) \cite han_et_al_2015 for the PBL and equation 16 for the surface layer. - if(dspheat) then -! - do k = 1,km1 - do i = 1,im - diss(i,k) = dku(i,k)*shr2(i,k)-g*ti(i,k)*dkt(i,k)*bf(i,k) -! diss(i,k) = dku(i,k)*shr2(i,k) - enddo - enddo -! -! add dissipative heating at the first model layer -! -!> Next, the temperature tendency is updated following equation 14. - do i = 1,im - tem = govrth(i)*sflux(i) - tem1 = tem + stress(i)*spd1(i)/zl(i,1) - tem2 = 0.5 * (tem1+diss(i,1)) - tem2 = max(tem2, 0.) - ttend = tem2 / cp - if (alpha .gt. 0.0) then - tau(i,1) = tau(i,1)+0.5*ttend - else - tau(i,1) = tau(i,1)+0.7*ttend ! in HWRF/HMON, use 0.7 - endif - enddo -! -! add dissipative heating above the first model layer -! - do k = 2,km1 - do i = 1,im - tem = 0.5 * (diss(i,k-1)+diss(i,k)) - tem = max(tem, 0.) - ttend = tem / cp - tau(i,k) = tau(i,k) + 0.5*ttend - enddo - enddo -! - endif -! -! compute tridiagonal matrix elements for momentum -! -!> ## Solve for the horizontal momentum tendencies and add them to the output tendency terms -!! As with the temperature and moisture tendencies, the horizontal momentum tendencies are calculated by solving tridiagonal matrices after the matrices are prepared in this section. - do i=1,im - ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) - a1(i,1) = u1(i,1) - a2(i,1) = v1(i,1) - enddo -! - do k = 1,km1 - do i=1,im - dtodsd = dt2/del(i,k) - dtodsu = dt2/del(i,k+1) - dsig = prsl(i,k)-prsl(i,k+1) - rdz = rdzt(i,k) - tem1 = dsig*dku(i,k)*rdz - dsdz2 = tem1 * rdz - au(i,k) = -dtodsd*dsdz2 - al(i,k) = -dtodsu*dsdz2 -! - if(pcnvflg(i) .and. k < kpbl(i)) then - tem2 = dsig * rdz - ptem = 0.5 * tem2 * xmf(i,k) - ptem1 = dtodsd * ptem - ptem2 = dtodsu * ptem - ad(i,k) = ad(i,k)-au(i,k)-ptem1 - ad(i,k+1) = 1.-al(i,k)+ptem2 - au(i,k) = au(i,k)-ptem1 - al(i,k) = al(i,k)+ptem2 - ptem = ucko(i,k) + ucko(i,k+1) - a1(i,k) = a1(i,k) - ptem1 * ptem - a1(i,k+1) = u1(i,k+1) + ptem2 * ptem - ptem = vcko(i,k) + vcko(i,k+1) - a2(i,k) = a2(i,k) - ptem1 * ptem - a2(i,k+1) = v1(i,k+1) + ptem2 * ptem - else - ad(i,k) = ad(i,k)-au(i,k) - ad(i,k+1) = 1.-al(i,k) - a1(i,k+1) = u1(i,k+1) - a2(i,k+1) = v1(i,k+1) - endif -! - enddo - enddo - - do k = 1,km1 - do i=1,im - dkudiagnostic(i,k) = dku(i,k) - enddo - enddo - -! -! solve tridiagonal problem for momentum -! - call tridi299(im,km,al,ad,au,a1,a2,au,a1,a2) -! -! recover tendencies of momentum -! -!> Finally, the tendencies are recovered from the tridiagonal solutions. - do k = 1,km - do i = 1,im - utend = (a1(i,k)-u1(i,k))*rdt - vtend = (a2(i,k)-v1(i,k))*rdt - du(i,k) = du(i,k) + utend - dv(i,k) = dv(i,k) + vtend - dusfc(i) = dusfc(i) + conw*del(i,k)*utend - dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend -! -! for dissipative heating for ecmwf model -! -! tem1 = 0.5*(a1(i,k)+u1(i,k)) -! tem2 = 0.5*(a2(i,k)+v1(i,k)) -! diss(i,k) = -(tem1*utend+tem2*vtend) -! diss(i,k) = max(diss(i,k),0.) -! ttend = diss(i,k) / cp -! tau(i,k) = tau(i,k) + ttend -! - enddo - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! - do i = 1, im - hpbl(i) = hpblx(i) - kpbl(i) = kpblx(i) - enddo -! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - return - end subroutine hedmf_hafs_run - -!> @} - -c----------------------------------------------------------------------- -!> \ingroup PBL -!! \brief Routine to solve the tridiagonal system to calculate temperature and moisture at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. -!! -!! Origin of subroutine unknown. - subroutine tridi299(l,n,cl,cm,cu,r1,r2,au,a1,a2) -cc - use machine , only : kind_phys - implicit none - integer k,n,l,i - real(kind=kind_phys) fk -cc - real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & - & au(l,n-1),a1(l,n),a2(l,n) -c----------------------------------------------------------------------- - do i=1,l - fk = 1./cm(i,1) - au(i,1) = fk*cu(i,1) - a1(i,1) = fk*r1(i,1) - a2(i,1) = fk*r2(i,1) - enddo - do k=2,n-1 - do i=1,l - fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) - au(i,k) = fk*cu(i,k) - a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) - a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) - enddo - enddo - do i=1,l - fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) - a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) - a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) - enddo - do k=n-1,1,-1 - do i=1,l - a1(i,k) = a1(i,k)-au(i,k)*a1(i,k+1) - a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) - enddo - enddo -c----------------------------------------------------------------------- - return - end subroutine tridi299 -c----------------------------------------------------------------------- -!> \ingroup PBL -!! \brief Routine to solve the tridiagonal system to calculate u- and v-momentum at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. -!! -!! Origin of subroutine unknown. - subroutine tridin99(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) -cc - use machine , only : kind_phys - implicit none - integer is,k,kk,n,nt,l,i - real(kind=kind_phys) fk(l) -cc - real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & - & r1(l,n), r2(l,n*nt), & - & au(l,n-1), a1(l,n), a2(l,n*nt), & - & fkk(l,2:n-1) -c----------------------------------------------------------------------- - do i=1,l - fk(i) = 1./cm(i,1) - au(i,1) = fk(i)*cu(i,1) - a1(i,1) = fk(i)*r1(i,1) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - a2(i,1+is) = fk(i) * r2(i,1+is) - enddo - enddo - do k=2,n-1 - do i=1,l - fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) - au(i,k) = fkk(i,k)*cu(i,k) - a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=2,n-1 - do i=1,l - a2(i,k+is) = fkk(i,k)*(r2(i,k+is)-cl(i,k)*a2(i,k+is-1)) - enddo - enddo - enddo - do i=1,l - fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) - a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) - enddo - do k = 1, nt - is = (k-1) * n - do i = 1, l - a2(i,n+is) = fk(i)*(r2(i,n+is)-cl(i,n)*a2(i,n+is-1)) - enddo - enddo - do k=n-1,1,-1 - do i=1,l - a1(i,k) = a1(i,k) - au(i,k)*a1(i,k+1) - enddo - enddo - do kk = 1, nt - is = (kk-1) * n - do k=n-1,1,-1 - do i=1,l - a2(i,k+is) = a2(i,k+is) - au(i,k)*a2(i,k+is+1) - enddo - enddo - enddo -c----------------------------------------------------------------------- - return - end subroutine tridin99 - -!> @} - - end module hedmf_hafs diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta deleted file mode 100644 index 6f084e08b..000000000 --- a/physics/moninedmf_hafs.meta +++ /dev/null @@ -1,533 +0,0 @@ -[ccpp-table-properties] - name = hedmf_hafs - type = scheme - dependencies = funcphys.f90,machine.F,mfpbl.f,physcons.F90 - -######################################################################## -[ccpp-arg-table] - name = hedmf_hafs_init - type = scheme -[moninq_fac] - standard_name = atmosphere_diffusivity_coefficient_factor - long_name = multiplicative constant for atmospheric diffusivities - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F - -######################################################################## -[ccpp-arg-table] - name = hedmf_hafs_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[km] - standard_name = vertical_dimension - long_name = vertical layer dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[ntrac] - standard_name = number_of_vertical_diffusion_tracers - long_name = number of tracers to diffuse vertically - units = count - dimensions = () - type = integer - intent = in - optional = F -[ntcw] - standard_name = index_for_liquid_cloud_condensate - long_name = cloud condensate index in tracer array - units = index - dimensions = () - type = integer - intent = in - optional = F -[dv] - standard_name = tendency_of_y_wind_due_to_model_physics - long_name = updated tendency of the y wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[du] - standard_name = tendency_of_x_wind_due_to_model_physics - long_name = updated tendency of the x wind - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[tau] - standard_name = tendency_of_air_temperature_due_to_model_physics - long_name = updated tendency of the temperature - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[rtg] - standard_name = tendency_of_vertically_diffused_tracer_concentration - long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme - units = kg kg-1 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) - type = real - kind = kind_phys - intent = inout - optional = F -[u1] - standard_name = x_wind - long_name = x component of layer wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[v1] - standard_name = y_wind - long_name = y component of layer wind - units = m s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[t1] - standard_name = air_temperature - long_name = layer mean air temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[q1] - standard_name = vertically_diffused_tracer_concentration - long_name = tracer concentration diffused by PBL scheme - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_vertical_diffusion_tracers) - type = real - kind = kind_phys - intent = in - optional = F -[swh] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step - long_name = total sky shortwave heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[hlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - long_name = total sky longwave heating rate - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[xmu] - standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes - long_name = zenith angle temporal adjustment factor for shortwave - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[psk] - standard_name = dimensionless_exner_function_at_lowest_model_interface - long_name = dimensionless Exner function at the surface interface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[rbsoil] - standard_name = bulk_richardson_number_at_lowest_model_level - long_name = bulk Richardson number at the surface - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length in cm - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[u10m] - standard_name = x_wind_at_10m - long_name = x component of wind at 10 m - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[v10m] - standard_name = y_wind_at_10m - long_name = y component of wind at 10 m - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fm] - standard_name = Monin_Obukhov_similarity_function_for_momentum - long_name = Monin-Obukhov similarity function for momentum - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fh] - standard_name = Monin_Obukhov_similarity_function_for_heat - long_name = Monin-Obukhov similarity function for heat - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsea] - standard_name = surface_skin_temperature - long_name = surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[heat] - standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward sensible heat flux - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[evap] - standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness - long_name = kinematic surface upward latent heat flux - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[stress] - standard_name = surface_wind_stress - long_name = surface wind stress - units = m2 s-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[spd1] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[kpbl] - standard_name = vertical_index_at_top_of_atmosphere_boundary_layer - long_name = PBL top model level index - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = out - optional = F -[prsi] - standard_name = air_pressure_at_interface - long_name = air pressure at model layer interfaces - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[del] - standard_name = air_pressure_difference_between_midlayers - long_name = pres(k) - pres(k+1) - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[prsl] - standard_name = air_pressure - long_name = mean layer pressure - units = Pa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[prslk] - standard_name = dimensionless_exner_function_at_model_layers - long_name = Exner function at layers - units = none - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[phii] - standard_name = geopotential_at_interface - long_name = geopotential at model layer interfaces - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[phil] - standard_name = geopotential - long_name = geopotential at model layer centers - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[delt] - standard_name = time_step_for_physics - long_name = time step for physics - units = s - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[dspheat] - standard_name = flag_TKE_dissipation_heating - long_name = flag for using TKE dissipation heating - units = flag - dimensions = () - type = logical - intent = in - optional = F -[dusfc] - standard_name = instantaneous_surface_x_momentum_flux - long_name = x momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[dvsfc] - standard_name = instantaneous_surface_y_momentum_flux - long_name = y momentum flux - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[dtsfc] - standard_name = instantaneous_surface_upward_sensible_heat_flux - long_name = surface upward sensible heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[dqsfc] - standard_name = instantaneous_surface_upward_latent_heat_flux - long_name = surface upward latent heat flux - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[hpbl] - standard_name = atmosphere_boundary_layer_thickness - long_name = PBL thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[hgamt] - standard_name = countergradient_mixing_term_for_temperature - long_name = countergradient mixing term for temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[hgamq] - standard_name = countergradient_mixing_term_for_water_vapor - long_name = countergradient mixing term for water vapor - units = kg kg-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[dkt] - standard_name = atmosphere_heat_diffusivity - long_name = diffusivity for heat - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) - type = real - kind = kind_phys - intent = out - optional = F -[kinver] - standard_name = index_of_highest_temperature_inversion - long_name = index of highest temperature inversion - units = index - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F -[xkzm_m] - standard_name = atmosphere_momentum_diffusivity_background - long_name = background value of momentum diffusivity - units = m2 s-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[xkzm_h] - standard_name = atmosphere_heat_diffusivity_background - long_name = background value of heat diffusivity - units = m2 s-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[xkzm_s] - standard_name = diffusivity_background_sigma_level - long_name = sigma level threshold for background diffusivity - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lprnt] - standard_name = flag_print - long_name = flag for printing diagnostics to output - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F -[xkzminv] - standard_name = atmosphere_heat_diffusivity_background_maximum - long_name = maximum background value of heat diffusivity - units = m2 s-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[moninq_fac] - standard_name = atmosphere_diffusivity_coefficient_factor - long_name = multiplicative constant for atmospheric diffusivities - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[islimsk] - standard_name = sea_land_ice_mask - long_name = sea/land/ice mask (=0/1/2) - units = flag - dimensions = (horizontal_loop_extent) - type = integer - intent = in - optional = F -[dkudiagnostic] - standard_name = atmosphere_momentum_diffusivity - long_name = diffusivity for momentum - units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension_minus_one) - type = real - kind = kind_phys - intent = out - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 3741b502f..63a67c810 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -66,7 +66,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & dspheat,dusfc,dvsfc,dtsfc,dqsfc,hpbl, & & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & & ntoz,du3dt,dv3dt,dt3dt,dq3dt,do3dt,gen_tend,ldiag3d,qdiag3d, & - & dkudiagnostic,errmsg,errflg) + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -131,8 +131,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & & slx(im,km), svx(im,km), qtx(im,km), & tvx(im,km), pix(im,km), radx(im,km-1), & dku(im,km-1),dkt(im,km-1), dkq(im,km-1), - & cku(im,km-1),ckt(im,km-1), - & dkudiagnostic(im,km-1) + & cku(im,km-1),ckt(im,km-1) ! real(kind=kind_phys) plyr(im,km), rhly(im,km), cfly(im,km), & qstl(im,km) @@ -1539,12 +1538,6 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntiw,ntke, & ! enddo enddo - - do k = 1,km1 - do i=1,im - dkudiagnostic(i,k) = dku(i,k) - enddo - enddo c !> - Call tridi2() to solve tridiagonal problem for momentum c From c3105d8247746aa4a3591d12de9e6f0a697c372b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 16 Oct 2020 20:56:29 -0600 Subject: [PATCH 081/274] Bugfix: remove dkudiagnostic from satmedmfvdifq.meta --- physics/satmedmfvdifq.meta | 9 --------- 1 file changed, 9 deletions(-) diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index af6e23914..a57ce3839 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -670,15 +670,6 @@ type = logical intent = inout optional = F -[dkudiagnostic] - standard_name = atmosphere_momentum_diffusivity - long_name = diffusivity for momentum - units = m2 s-1 - dimensions = (horizontal_loop_extent,vertical_dimension_minus_one) - type = real - kind = kind_phys - intent = out - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 20807664c55e55ad0af2312c2e13da312bf5c338 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 20 Oct 2020 16:56:30 +0000 Subject: [PATCH 082/274] Albedo computation fixes for RUC ice to get a successful run. --- physics/namelist_soilveg_ruc.F90 | 2 ++ physics/set_soilveg_ruc.F90 | 5 +++-- physics/sfc_drv_ruc.F90 | 21 +++++++++++---------- 3 files changed, 16 insertions(+), 12 deletions(-) diff --git a/physics/namelist_soilveg_ruc.F90 b/physics/namelist_soilveg_ruc.F90 index c40b859bf..1e05122c4 100644 --- a/physics/namelist_soilveg_ruc.F90 +++ b/physics/namelist_soilveg_ruc.F90 @@ -1,3 +1,5 @@ +!>\file namelist_soilveg_ruc.F90 +!>\ingroup RUC_lsm module namelist_soilveg_ruc implicit none save diff --git a/physics/set_soilveg_ruc.F90 b/physics/set_soilveg_ruc.F90 index e48f4ed88..cac4fd1e7 100644 --- a/physics/set_soilveg_ruc.F90 +++ b/physics/set_soilveg_ruc.F90 @@ -26,13 +26,14 @@ subroutine set_soilveg_ruc(me,isot,ivet,nlunit) real refsmc1, wltsmc1 NAMELIST /SOIL_VEG_RUC/ SLOPE_DATA, ALBTBL, Z0TBL, LEMITBL, & - & PCTBL, SHDTBL, & + & PCTBL, SHDTBL, & & IFORTBL, RSTBL, RGLTBL, HSTBL, SNUPTBL, LAITBL, MAXALB, & & LPARAM, TOPT_DATA, CMCMAX_DATA, CFACTR_DATA, & & RSMAX_DATA, BARE, NATURAL, CROP, URBAN, & & DEFINED_VEG, DEFINED_SOIL, DEFINED_SLOPE, & & BB, DRYSMC, HC, MAXSMC, REFSMC, SATPSI, SATDK, SATDW, & - & WLTSMC, QTZ, mosaic_soil, mosaic_lu, REFSMCnoah, WLTSMCnoah + & WLTSMC, QTZ, mosaic_soil, mosaic_lu, & + & REFSMCnoah, WLTSMCnoah, MAXSMCnoah if(ivet.eq.2) then ! Using umd veg classification diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 02d197fbd..5dae40782 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -129,7 +129,6 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) - !if( .not. flag_restart) then call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in soiltyp, vegtype, & ! in @@ -146,7 +145,6 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & enddo enddo ! i - !endif ! flag_restart !-- end of initialization if ( debug_print) then @@ -491,6 +489,7 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'flag_restart =',flag_restart endif + !if( (flag_init .and. iter==1)) then do i = 1, im ! n - horizontal loop ! - Initialize land and ice surface albedo if(land(i)) then @@ -500,7 +499,9 @@ subroutine lsm_ruc_run & ! inputs !- averaged of snow-free and snow-covered sfalb_lnd(i) = sfalb_lnd(i) * (1.-sncovr1_lnd(i)) + snoalb(i) * sncovr1_lnd(i) endif - elseif(icy(i)) then + endif + + if(icy(i)) then ! snow-free ice sfalb_ice(i) = 0.55 if (weasd_ice(i) > 0.) then @@ -508,10 +509,9 @@ subroutine lsm_ruc_run & ! inputs sfalb_ice(i) = sfalb_ice(i) * (1.-sncovr1_ice(i)) + 0.75 * sncovr1_ice(i) endif endif - enddo ! i - - endif ! flag_init=.true.,iter=1 + enddo ! i + !endif ! flag_init=.true.,iter=1 ims = 1 its = 1 @@ -805,20 +805,20 @@ subroutine lsm_ruc_run & ! inputs xice_lnd(i,j) = 0. elseif(flag_ice_uncoupled(i)) then ! some ice xland(i,j) = 1. - xice(i,j) = 1. !fice(i) ! fraction of sea-ice + xice(i,j) = fice(i) ! fraction of sea-ice endif else write (0,*)'MODIS landuse is not available' endif + if (land(i)) then ! at least some land in the grid cell + if(rdlai2d) then xlai(i,j) = laixy(i) else xlai(i,j) = 0. endif - if (land(i)) then ! at least some land in the grid cell - !> - 4. history (state) variables (h): !!\n \a cmc - canopy moisture content (\f$mm\f$) !!\n \a soilt = tskin - ground/canopy/snowpack effective skin temperature (\f$K\f$) @@ -1122,9 +1122,10 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'i,j,tsurf_lnd(i)',i,j,tsurf_lnd(i) write (0,*)'kdt,iter,stsoil(i,:,j)',kdt,iter,stsoil(i,:,j) endif - endif ! land + endif ! end of land if (flag_ice_uncoupled(i)) then ! at least some ice in the grid cell + !-- ice point solnet_ice(i,j) = dswsfc(i)*(1.-sfalb_ice(i)) qvg_ice(i,j) = sfcqv_ice(i) From 394dfa597e1846d367b8d785ecc1b57a61bd9760 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 20 Oct 2020 18:14:18 +0000 Subject: [PATCH 083/274] Noah soil variables (smc,stc,slc) are removed from the list of parameters of lsm_ruc_run. There are not needed there because initialization of RUC soil variables is done now in lsm_ruc_init. --- physics/sfc_drv_ruc.F90 | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 5dae40782..985bee414 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -258,7 +258,6 @@ subroutine lsm_ruc_run & ! inputs & rainnc, rainc, ice, snow, graupel, & & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & & srflag, snoalb, isot, ivegsrc, fice, smcwlt2, smcref2, & - & smc, stc, slc, & ! --- constants & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, & & con_fvirt, & @@ -304,8 +303,6 @@ subroutine lsm_ruc_run & ! inputs integer, intent(in) :: lsm_ruc, lsm integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson - real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: smc,stc,slc - real (kind=kind_phys), dimension(im), intent(in) :: & & t1, sigmaf, laixy, dlwflx, dswsfc, snet, tg3, & & prsl1, wind, shdmin, shdmax, & @@ -1357,16 +1354,6 @@ subroutine lsm_ruc_run & ! inputs deallocate(soilctop) deallocate(landusef) ! - !! Update standard (Noah LSM) soil variables for physics - !! that require these variables and for debugging purposes - do i = 1, im - do k = 1, lsoil - smc(i,k) = smois(i,k) - slc(i,k) = sh2o(i,k) - stc(i,k) = tslb(i,k) - enddo - enddo - return !................................... end subroutine lsm_ruc_run From 13bf35065cd4b4e74605f2578e68319f0f0f5623 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 20 Oct 2020 18:28:32 +0000 Subject: [PATCH 084/274] Removed Noah soil variables from sfc_drv_ruc.meta as well. --- physics/sfc_drv_ruc.meta | 27 --------------------------- 1 file changed, 27 deletions(-) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 2ba1b6087..ba61ed899 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -735,33 +735,6 @@ kind = kind_phys intent = inout optional = F -[smc] - standard_name = volume_fraction_of_soil_moisture - long_name = total soil moisture - units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[stc] - standard_name = soil_temperature - long_name = soil temperature - units = K - dimensions = (horizontal_dimension,soil_vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[slc] - standard_name = volume_fraction_of_unfrozen_soil_moisture - long_name = liquid soil moisture - units = frac - dimensions = (horizontal_dimension,soil_vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [con_cp] standard_name = specific_heat_of_dry_air_at_constant_pressure long_name = specific heat !of dry air at constant pressure From b7eff6b604ffbe8b27d8c45498411fa5a908fb31 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 20 Oct 2020 14:02:59 -0600 Subject: [PATCH 085/274] Fix uninitialized variable mvd_r in physics/module_mp_thompson.F90 --- physics/module_mp_thompson.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 5c2a2acb5..7d449473b 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1797,6 +1797,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622)) nwfa(k) = MAX(11.1E6, MIN(9999.E6, nwfa1d(k)*rho(k))) nifa(k) = MAX(naIN1*0.01, MIN(9999.E6, nifa1d(k)*rho(k))) + mvd_r(k) = D0r if (qc1d(k) .gt. R1) then no_micro = .false. From 390ec2160239c49f395f18150f19521fdd4f409a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 20 Oct 2020 14:10:10 -0600 Subject: [PATCH 086/274] Fix calls to mcica_subcol_sw in radsw_main.F90 --- physics/radsw_main.F90 | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index d74d4a63f..cf9e0e524 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -1012,14 +1012,16 @@ subroutine rrtmg_sw_run & enddo enddo - call mcica_subcol_sw (1, j1, nlay, iovrsw, permuteseed, & - & irng, plyr, hgt, & - & cld_cf, cld_iwp, cld_lwp,cld_swp, & - & cld_ref_ice, cld_ref_liq, & - & cld_ref_snow, taucld3,ssacld3,asmcld3,fsfcld3, & - & cldfmcl, ciwpmcl, clwpmcl, cswpmcl, & !--output - & reicmcl, relqmcl, resnmcl, & - & taucmcl, ssacmcl, asmcmcl, fsfcmcl) + call mcica_subcol_sw (1, 1, nlay, iovrsw, permuteseed, & + & irng, plyr(j1:j1,:), hgt(j1:j1,:), & + & cld_cf(j1:j1,:), cld_iwp(j1:j1,:), cld_lwp(j1:j1,:), & + & cld_swp(j1:j1,:), cld_ref_ice(j1:j1,:), cld_ref_liq(j1:j1,:), & + & cld_ref_snow(j1:j1,:), taucld3(:,j1:j1,:), ssacld3(:,j1:j1,:), & + & asmcld3(:,j1:j1,:), fsfcld3(:,j1:j1,:), cldfmcl(:,j1:j1,:), & !--output + & ciwpmcl(:,j1:j1,:), clwpmcl(:,j1:j1,:), cswpmcl(:,j1:j1,:), & + & reicmcl(j1:j1,:), relqmcl(j1:j1,:), resnmcl(j1:j1,:), & + & taucmcl(:,j1:j1,:), ssacmcl(:,j1:j1,:), asmcmcl(:,j1:j1,:), & + & fsfcmcl(:,j1:j1,:)) endif !mz* end @@ -5769,7 +5771,7 @@ subroutine mcica_subcol_sw(iplon, ncol, nlay, icld, permuteseed, & & ssac, asmc, fsfc, & & cldfmcl, ciwpmcl, clwpmcl, cswpmcl, reicmcl, & & relqmcl, resnmcl, & - & taucmcl, ssacmcl, asmcmcl, fsfcmcl) + & taucmcl, ssacmcl, asmcmcl, fsfcmcl) ! ----- Input ----- ! Control From 9a53be63b7508a1d5b7cab16b5ffa003b4189600 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Wed, 21 Oct 2020 17:50:16 +0000 Subject: [PATCH 087/274] Bug fix from Dom. --- physics/module_mp_thompson.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 14604e625..b077871d9 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1784,6 +1784,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622)) nwfa(k) = MAX(11.1E6, MIN(9999.E6, nwfa1d(k)*rho(k))) nifa(k) = MAX(naIN1*0.01, MIN(9999.E6, nifa1d(k)*rho(k))) + mvd_r(k) = D0r if (qc1d(k) .gt. R1) then no_micro = .false. From 748b0bc508af21d175aebc997179c497894a97ca Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Thu, 22 Oct 2020 02:43:04 +0000 Subject: [PATCH 088/274] Modified code per PR recommendations --- physics/cires_orowam2017.F90 | 17 +++++--- physics/cires_ugwp_initialize_v1.F90 | 34 +++++++++------ physics/cires_ugwp_module_v1.F90 | 65 +++++++++++++++------------- physics/cires_ugwp_orolm97_v1.F90 | 30 ++++++++++--- physics/cires_ugwp_solv2_v1_mod.F90 | 43 +++++++++++++----- physics/cires_ugwp_triggers_v1.F90 | 30 ++++++++----- physics/cires_vert_orodis_v1.F90 | 31 ++++++++----- physics/ugwp_driver_v0.F | 10 ++++- physics/unified_ugwp.F90 | 39 +++++++++-------- physics/unified_ugwp.meta | 36 +++++++++++++++ physics/unified_ugwp_post.F90 | 4 +- 11 files changed, 231 insertions(+), 108 deletions(-) diff --git a/physics/cires_orowam2017.F90 b/physics/cires_orowam2017.F90 index d5568bb9d..d5fda5cc0 100644 --- a/physics/cires_orowam2017.F90 +++ b/physics/cires_orowam2017.F90 @@ -6,11 +6,10 @@ module cires_orowam2017 subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, & & dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, & - & del, sigma, hprime, gamma, theta, & + & grav, omega, con_rd, del, sigma, hprime, gamma, theta, & & sinlat, xlatd, taup, taud, pkdis) ! USE MACHINE , ONLY : kind_phys - use ugwp_common_v1 , only : grav, omega2 ! implicit none @@ -29,6 +28,7 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, & real(kind=kind_phys), intent(in), dimension(im, levs) :: & & u1, v1, t1, bn2, rho, prsl, del + real(kind=kind_phys), intent(in) :: grav, omega, con_rd real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi ! @@ -128,11 +128,12 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, & wkdis(:,:) = kedmin call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), & - & prsi(j,:), prsL(j,:), del(j,:), rho(i,:), & + & prsi(j,:), prsL(j,:), grav, con_rd, & + & del(j,:), rho(i,:), & & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, & & xn(i), yn(i)) - fcor2 = (omega2*sinlat(j))*(omega2*sinlat(j))*fc_flag + fcor2 = (2*omega*sinlat(j))*(2*omega*sinlat(j))*fc_flag k = ksrc @@ -282,9 +283,10 @@ end subroutine oro_wam_2017 ! !------------------------------------------------------------- subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & + & grav, con_rd, & & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) - use ugwp_common_v1 , only : grav, rgrav, rdi, velmin, dw2min + use ugwp_common_v1 , only : velmin, dw2min implicit none integer :: nz, nzi @@ -292,6 +294,7 @@ subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & real, dimension(nz ) :: bn2 ! define at the interfaces real, dimension(nz+1) :: pint real :: xn, yn + real,intent(in) :: grav, con_rd ! output real, dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp @@ -300,6 +303,7 @@ subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & integer :: i, j, k real :: ui, vi, ti, uz, vz, shr2, rdz, kamp real :: zgrow, zmet, rdpm, ritur, kmol, w1 + real :: rgrav, rdi ! paremeters real, parameter :: hps = 7000., rpspa = 1.e-5 real, parameter :: rhps=1.0/hps @@ -309,6 +313,9 @@ subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & real, parameter :: lsc2 = lturb*lturb,usc2 = uturb*uturb kalp(1:nzi) = 2.e-7 ! radiative damping + rgrav = 1.0/grav + rdi = 1.0/con_rd + do k=2, nz rdpm = grav/(pmid(k-1)-pmid(k)) ui = .5*(u1(k-1)+u1(k)) diff --git a/physics/cires_ugwp_initialize_v1.F90 b/physics/cires_ugwp_initialize_v1.F90 index ef6c2c7d1..4258680ea 100644 --- a/physics/cires_ugwp_initialize_v1.F90 +++ b/physics/cires_ugwp_initialize_v1.F90 @@ -54,15 +54,14 @@ end module ugwp_common_v1 !Part-1 init => wave dissipation + RFriction ! !=================================================== - subroutine init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) + subroutine init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & + pa_rf, tau_rf, me, master) - use ugwp_common_v1, only : pih - implicit none integer , intent(in) :: me, master integer , intent(in) :: levs - real, intent(in) :: pa_rf, tau_rf + real, intent(in) :: con_pi, pa_rf, tau_rf real, intent(in) :: zkm(levs), pmb(levs) ! in km-Pa real, intent(out), dimension(levs+1) :: kvg, ktg, krad, kion ! @@ -91,6 +90,10 @@ subroutine init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau real :: rf_fv3, rtau_fv3, ptop, pih_dlog ! real :: ae1 ,ae2 + real :: pih + + pih = 0.5*con_pi + pa_alp = pa_rf tau_alp = tau_rf @@ -335,12 +338,13 @@ module ugwp_conv_init_v1 contains ! subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & - lonr, kxw, cgwf) - use ugwp_common_v1, only : pi2, arad + con_pi, arad, lonr, kxw, cgwf) + implicit none integer :: nwaves, nazdir, nstoch integer :: lonr + real :: con_pi, arad real :: cgwf(2) real :: kxw, effac real :: work1 = 0.5 @@ -352,7 +356,7 @@ subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & nstcon = nstoch eff_con = effac - con_dlength = pi2*arad/float(lonr) + con_dlength = 2.0*con_pi*arad/float(lonr) con_cldf = cgwf(1) * work1 + cgwf(2) *(1.-work1) ! ! allocate & define spectra in "selected direction": "dc" "ch(nwaves)" @@ -378,7 +382,7 @@ subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & snorm = sum(spf_conv) spf_conv = spf_conv/snorm*1.5 - call init_nazdir(nazdir, xaz_conv, yaz_conv) + call init_nazdir(con_pi, nazdir, xaz_conv, yaz_conv) end subroutine init_conv_gws @@ -405,12 +409,13 @@ module ugwp_fjet_init_v1 real, allocatable :: ch_fjet(:) , spf_fjet(:) real, allocatable :: xaz_fjet(:), yaz_fjet(:) contains - subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) - use ugwp_common_v1, only : pi2, arad + subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, & + con_pi, lonr, kxw) implicit none integer :: nwaves, nazdir, nstoch integer :: lonr + real :: con_pi real :: kxw, effac , chk integer :: k @@ -431,7 +436,7 @@ subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) ch_fjet(k) = chk spf_fjet(k) = 1.0 enddo - call init_nazdir(nazdir, xaz_fjet, yaz_fjet) + call init_nazdir(con_pi, nazdir, xaz_fjet, yaz_fjet) end subroutine init_fjet_gws @@ -459,13 +464,14 @@ module ugwp_okw_init_v1 contains ! - subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) + subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, & + con_pi, lonr, kxw) - use ugwp_common_v1, only : pi2, arad implicit none integer :: nwaves, nazdir, nstoch integer :: lonr + real :: con_pi real :: kxw, effac , chk integer :: k @@ -486,7 +492,7 @@ subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) spf_okwp(k) = 1. enddo - call init_nazdir(nazdir, xaz_okwp, yaz_okwp) + call init_nazdir(con_pi, nazdir, xaz_okwp, yaz_okwp) end subroutine init_okw_gws diff --git a/physics/cires_ugwp_module_v1.F90 b/physics/cires_ugwp_module_v1.F90 index a25854097..9b245ed11 100644 --- a/physics/cires_ugwp_module_v1.F90 +++ b/physics/cires_ugwp_module_v1.F90 @@ -39,12 +39,12 @@ module cires_ugwp_module_v1 ! integer :: curday_ugwp ! yyyymmdd 20150101 ! integer :: ddd_ugwp ! ddd of year from 1-366 - integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) - integer, dimension(4) :: knob_ugwp_source ! [1,1,1,0] - (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_wvspec ! number of waves for- (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_azdir ! number of wave azimuths for- (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_stoch ! 1 - deterministic ; 0 - stochastic - real, dimension(4) :: knob_ugwp_effac ! efficiency factors for- (oro, fronts, conv, imbf-owp] + integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) + integer, dimension(4) :: knob_ugwp_source=(/1,0,1,0/) ! [1,0,1,1] - (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_wvspec=(/1,32,32,32/) ! number of waves for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_azdir=(/2,4,4,4/) ! number of wave azimuths for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_stoch=(/0,0,0,0/) ! 0 - deterministic ; 1 - stochastic + real, dimension(4) :: knob_ugwp_effac=(/1.,1.,1.,1./) ! efficiency factors for- (oro, fronts, conv, imbf-owp] integer :: knob_ugwp_doaxyz=1 ! 1 -gwdrag integer :: knob_ugwp_doheat=1 ! 1 -gwheat @@ -94,11 +94,6 @@ module cires_ugwp_module_v1 real :: ugwp_effac ! - data knob_ugwp_source / 1,0, 1, 0 / ! oro-conv-fjet-okw-taub_lat: 1-active 0-off - data knob_ugwp_wvspec /1,32,32,32/ ! number of waves for- (oro, fronts, conv, imbf-owp, taulat] - data knob_ugwp_azdir /2, 4, 4,4/ ! number of wave azimuths for- (oro, fronts, conv, imbf-okwp] - data knob_ugwp_stoch /0, 0, 0,0/ ! 0 - deterministic ; 1 - stochastic, non-activated option - data knob_ugwp_effac /1.,1.,1.,1./ ! efficiency factors for- (oro, fronts, conv, imbf-owp] integer :: knob_ugwp_version = 0 integer :: launch_level = 55 ! @@ -170,9 +165,9 @@ module cires_ugwp_module_v1 - subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & - lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & - pa_rf_in, tau_rf_in) + subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, con_pi, & + con_rerth, fn_nml2, lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, & + cgwf, pa_rf_in, tau_rf_in, errmsg, errflg) ! ! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 ! @@ -201,11 +196,14 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & real, intent (in) :: ak(levs+1), bk(levs+1), pref real, intent (in) :: dtp real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW dims(2) !!! - real, intent (in) :: pa_rf_in, tau_rf_in + real, intent (in) :: pa_rf_in, tau_rf_in, con_pi, con_rerth character(len=64), intent (in) :: fn_nml2 character(len=64), parameter :: fn_nml='input.nml' + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! character, intent (in) :: input_nml_file ! integer, parameter :: logunit = 6 integer :: ios @@ -215,8 +213,7 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & integer :: ncid, iernc, vid, dimid, status integer :: k integer :: ddd_ugwp, curday_ugwp - real :: avqbo(6) - avqbo = [0.05, 0.1, 0.25, 0.5, 0.75, 0.95] + real, dimension(6) :: avqbo = (/0.05, 0.1, 0.25, 0.5, 0.75, 0.95/) ! if (me == master) print *, trim (fn_nml), ' GW-namelist file ' inquire (file =trim (fn_nml) , exist = exists) @@ -231,6 +228,12 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & read (nlunit, nml = cires_ugwp_nml) close (nlunit) ! + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + strsolver= knob_ugwp_orosolv pa_rf = pa_rf_in tau_rf = tau_rf_in @@ -304,7 +307,8 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & ! ! Part-1 :init_global_gwdis_v1 ! - call init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, pa_rf, tau_rf, me, master) + call init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & + pa_rf, tau_rf, me, master) call rf_damp_init_v1 (levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) ! ! Part-2 :init_SOURCES_gws @@ -326,21 +330,24 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & if (knob_ugwp_wvspec(4) > 0) then ! okw call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & - knob_ugwp_stoch(4), knob_ugwp_effac(4), lonr, kxw ) + knob_ugwp_stoch(4), knob_ugwp_effac(4), & + con_pi, lonr, kxw ) if (me == master) print *, ' init_okw_gws ' endif if (knob_ugwp_wvspec(3) > 0) then ! fronts call init_fjet_gws(knob_ugwp_wvspec(3), knob_ugwp_azdir(3), & - knob_ugwp_stoch(3), knob_ugwp_effac(3), lonr, kxw ) + knob_ugwp_stoch(3), knob_ugwp_effac(3), & + con_pi, lonr, kxw ) if (me == master) print *, ' init_fjet_gws ' endif if (knob_ugwp_wvspec(2) > 0) then ! conv call init_conv_gws(knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & - knob_ugwp_stoch(2), knob_ugwp_effac(2), lonr, kxw, cgwf ) + knob_ugwp_stoch(2), knob_ugwp_effac(2), & + con_pi, con_rerth, lonr, kxw, cgwf ) if (me == master) & print *, ' init_convective GWs cgwf', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) @@ -356,10 +363,10 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & iernc=NF90_OPEN(trim(ugwp_taufile), nf90_nowrite, ncid) if(iernc.ne.0) then - write(6,*) - write(6,*) ' cannot open file_limb_tab data-file', trim(ugwp_taufile) - write(6,*) - stop + write(errmsg,'(*(a))') "Cannot open file_limb_tab data-file ", & + trim(ugwp_taufile) + errflg = 1 + return else @@ -388,10 +395,10 @@ subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & iernc=NF90_OPEN(trim(ugwp_qbofile), nf90_nowrite, ncid) if(iernc.ne.0) then - write(6,*) - write(6,*) ' cannot open qbofile data-file', trim(ugwp_qbofile) - write(6,*) - stop + write(errmsg,'(*(a))') "Cannot open qbofile data-file ", & + trim(ugwp_qbofile) + errflg = 1 + return else status = nf90_inq_dimid(ncid, "lat", DimID) diff --git a/physics/cires_ugwp_orolm97_v1.F90 b/physics/cires_ugwp_orolm97_v1.F90 index e6c3a1ea0..fd692a825 100644 --- a/physics/cires_ugwp_orolm97_v1.F90 +++ b/physics/cires_ugwp_orolm97_v1.F90 @@ -8,7 +8,8 @@ module cires_ugwp_orolm97_v1 subroutine gwdps_oro_v1(im, km, imx, do_tofd, & pdvdt, pdudt, pdtdt, pkdis, u1,v1,t1,q1,kpbl, & prsi,del,prsl,prslk, zmeti, zmet, dtp, kdt, hprime, & - oc, oa4, clx4, theta, sigmad, gammad, elvmaxd, sgh30, & + oc, oa4, clx4, theta, sigmad, gammad, elvmaxd, & + grav, con_omega, rd, cpd, rv, pi, arad, fv, sgh30, & dusfc, dvsfc, xlatd, sinlat, coslat, sparea, & cdmbgwd, me, master, rdxzb, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & @@ -23,10 +24,7 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & !---------------------------------------- use machine , only : kind_phys - use ugwp_common_v1, only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2, & - pi, rad_to_deg, deg_to_rad, pi2, & - rdi, gor, grcp, gocp, fv, gr2, & - bnv2min, dw2min, velmin, arad + use ugwp_common_v1, only : dw2min, velmin use ugwp_oro_init_v1, only : rimin, ric, efmin, efmax , & hpmax, hpmin, sigfaci => sigfac , & @@ -70,6 +68,8 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & clx4(im,4), theta(im), sigmad(im), & gammad(im), elvmaxd(im) + real(kind=kind_phys), intent(in) :: grav, con_omega, rd, cpd, rv, & + pi, arad, fv real(kind=kind_phys), intent(in) :: sgh30(im) real(kind=kind_phys), intent(in), dimension(im,km) :: & u1, v1, t1, q1,del, prsl, prslk, zmet @@ -166,6 +166,10 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & real(kind=kind_phys) :: kxridge, inv_b2eff, zw1, zw2 real(kind=kind_phys) :: belps, aelps, nhills, selps + + real(kind=kind_phys) :: rgrav, rcpd, rcpd2, rad_to_deg, deg_to_rad + real(kind=kind_phys) :: pi2, rdi, gor, grcp, gocp, gr2, bnv2min + ! ! various integers ! @@ -181,6 +185,19 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & ! rcpdt = 1.0 / (cpd*dtp) grav2 = grav + grav +! + rgrav = 1.0/grav + rcpd = 1.0/cpd + rcpd2 = 0.5/cpd + rad_to_deg=180.0/pi + deg_to_rad=pi/180.0 + pi2 = 2.*pi + rdi = 1.0/rd + gor = grav/rd + grcp = grav*rcpd + gocp = grcp + gr2 = grav*gor + bnv2min = (pi2/1800.)*(pi2/1800.) ! ! mtb-blocking sigma_min and dxres => cires_initialize ! @@ -813,6 +830,7 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsl, & + grav, con_omega, rd, & del, sigma, hprime, gamma, theta, sinlat, xlatd, taup, taud, pkdis) endif ! oro_wam_2017 - linsatdis-solver of wam-2017 @@ -840,7 +858,7 @@ subroutine gwdps_oro_v1(im, km, imx, do_tofd, & vp1(k) = v1(j,k) enddo - call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, & + call ugwp_tofd1d(km, cpd, sigflt, elvmaxd(j), zsurf, zpbl, & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) do k=1,km diff --git a/physics/cires_ugwp_solv2_v1_mod.F90 b/physics/cires_ugwp_solv2_v1_mod.F90 index c84028199..46a5fb833 100644 --- a/physics/cires_ugwp_solv2_v1_mod.F90 +++ b/physics/cires_ugwp_solv2_v1_mod.F90 @@ -11,8 +11,9 @@ module cires_ugwp_solv2_v1_mod ! they are out of given column !--------------------------------------------------- subroutine cires_ugwp_solv2_v1(im, levs, dtp , & - tm , um, vm, qm, prsl, prsi, zmet, zmeti, & + tm , um, vm, qm, prsl, prsi, zmet, zmeti, & prslk, xlatd, sinlat, coslat, & + grav, cpd, rd, rv, omega, pi, fv, & pdudt, pdvdt, pdtdt, dked, tauabs, wrms, trms, & tau_ngw, mpi_id, master, kdt) ! @@ -30,12 +31,7 @@ subroutine cires_ugwp_solv2_v1(im, levs, dtp , & use cires_ugwp_module_v1,only : knob_ugwp_doheat, knob_ugwp_dokdis, idebug_gwrms - use ugwp_common_v1 , only : rgrav, grav, cpd, rd, rv, rcpdl, grav2cpd, & - omega2, rcpd, rcpd2, pi, pi2, fv, & - rad_to_deg, deg_to_rad, & - rdi, gor, grcp, gocp, & - bnv2min, bnv2max, dw2min, velmin, gr2, & - hpscale, rhp, rh4, grav2, rgrav2, mkzmin, mkz2min + use ugwp_common_v1 , only : dw2min, velmin, hpscale, rhp, rh4 ! use ugwp_wmsdis_init_v1, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & maxdudt, gw_eff, dked_min, dked_max, maxdtdt, & @@ -67,6 +63,8 @@ subroutine cires_ugwp_solv2_v1(im, levs, dtp , & real ,intent(in) :: tau_ngw(im) integer, intent(in):: mpi_id, master, kdt + + real ,intent(in) :: grav, cpd, rd, rv, omega, pi, fv ! ! ! out-gw effects @@ -144,7 +142,10 @@ subroutine cires_ugwp_solv2_v1(im, levs, dtp , & real :: pwrms, ptrms real :: zu, zcin, zcin2, zcin3, zcin4, zcinc real :: zatmp, fluxs, zdep, ze1, ze2 - +! + real :: rcpdl, grav2cpd, rcpd, rcpd2, pi2, rad_to_deg + real :: deg_to_rad, rdi, gor, grcp, gocp, bnv2min, bnv2max, gr2 + real :: grav2, rgrav, rgrav2, mkzmin, mkz2min ! real :: zdelp, zdelm, taud_min real :: tvc, tvm, ptc, ptm @@ -192,9 +193,27 @@ subroutine cires_ugwp_solv2_v1(im, levs, dtp , & tauabs=0.0; wrms =0.0 ; trms =0.0 endif -! grav2 = grav + grav -! rgrav2 = rgrav*rgrav - + + grav2 = grav + grav + rgrav = 1.0/grav + rgrav2 = rgrav*rgrav + rdi = 1.0/rd + gor = grav/rd + gr2 = grav*gor + rcpd = 1.0/cpd + rcpd2 = 0.5/cpd + rcpdl = cpd*rgrav ! 1/[g/cp] == cp/g + pi2 = 2.0*pi + grcp = grav*rcpd + gocp = grcp + grav2cpd = grav*grcp ! g*(g/cp)= g^2/cp + rad_to_deg=180.0/pi + deg_to_rad=pi/180.0 + bnv2min = (pi2/1800.)*(pi2/1800.) + bnv2max = (pi2/30.)*(pi2/30.) + mkzmin = pi2/80.0e3 + mkz2min = mkzmin*mkzmin + rci(:) = 1./zci(:) rdci(:) = 1./zdci(:) @@ -224,7 +243,7 @@ subroutine cires_ugwp_solv2_v1(im, levs, dtp , & DO j=1, im jl =j - tx1 = omega2 * sinlat(j) *rv_kxw + tx1 = 2*omega * sinlat(j) *rv_kxw cf1 = abs(tx1) c2f2 = tx1 * tx1 ucrit_max = max(ucrit, cf1) diff --git a/physics/cires_ugwp_triggers_v1.F90 b/physics/cires_ugwp_triggers_v1.F90 index 44911e1d5..8cfd57cb7 100644 --- a/physics/cires_ugwp_triggers_v1.F90 +++ b/physics/cires_ugwp_triggers_v1.F90 @@ -9,24 +9,25 @@ subroutine ugwp_triggers write(6,*) ' physics-based triggers for UGWP ' end subroutine ugwp_triggers ! - SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, con_pi, earth_r, & cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - use ugwp_common_v1 , only : deg_to_rad implicit none integer :: nx, ny real :: lon(nx), lat(ny) real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) real :: rlatc(ny-1), brcos(ny), brcos2(ny) - real :: earth_r, ra1, ra2, dx, dy, dlat + real :: ra1, ra2, dx, dy, dlat + real :: con_pi, earth_r real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) integer :: j + real :: deg_to_rad ! ! specify common constants and ! geometric factors to compute deriv-es etc ... ! coriolis coslat tan etc... ! - earth_r = 6370.e3 + deg_to_rad = con_pi/180.0 ra1 = 1.0 / earth_r ra2 = ra1*ra1 ! @@ -125,10 +126,12 @@ subroutine get_xyd_wind( V, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) end subroutine get_xyd_wind - subroutine trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) + subroutine trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, & + con_pi, con_rerth, pmid, trig3d_fgf) implicit none integer :: nx, ny, nz real :: lon(nx), lat(ny) + real :: con_pi, con_rerth ! real, dimension(nz) :: pmid real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d @@ -150,7 +153,7 @@ subroutine trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, con_pi, con_rerth, & cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) do k=1, nz @@ -173,6 +176,7 @@ subroutine trig3d_okubo( nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, implicit none integer :: nx, ny, nz real :: lon(nx), lat(ny) + real :: con_pi, con_rerth ! real, dimension(nz) :: pmid real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d @@ -193,7 +197,7 @@ subroutine trig3d_okubo( nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, real :: dx, dy, dlat real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & + call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, con_pi, con_rerth, & cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) do k=1, nz @@ -238,12 +242,13 @@ end subroutine trig3d_dconv subroutine cires_3d_triggers( nx, ny, nz, lon, lat, pmid, & U, V, W, T, Q, delp, delz, p3d, PS, HS, Hyam, Hybm, Hyai, Hybi, & - trig3d_okw, trig3d_fgf, trig3d_conv, & + con_pi, con_rerth, trig3d_okw, trig3d_fgf, trig3d_conv, & dcheat3d, precip2d, cld_klevs2d, scheat3d) implicit none integer :: nx, ny, nz real :: lon(nx), lat(ny) + real :: con_pi, con_rerth ! ! reversed ??? Hyai, Hybi , pmid ! @@ -265,7 +270,8 @@ subroutine cires_3d_triggers( nx, ny, nz, lon, lat, pmid, & ! !=================================================================================== - call trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) + call trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, & + con_pi, con_rerth, pmid, trig3d_fgf) call trig3d_okubo( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_okw) call trig3d_dconv(nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_conv, & dcheat3d, precip2d, cld_klevs2d, scheat3d) @@ -544,13 +550,15 @@ subroutine slat_geos5(im, xlatdeg, tau_gw) enddo ! end subroutine slat_geos5 - subroutine init_nazdir(naz, xaz, yaz) - use ugwp_common_v1 , only : pi2 + subroutine init_nazdir(con_pi, naz, xaz, yaz) implicit none + real :: con_pi integer :: naz real, dimension(naz) :: xaz, yaz integer :: idir real :: phic, drad + real :: pi2 + pi2 = 2.0*con_pi drad = pi2/float(naz) if (naz.ne.4) then do idir =1, naz diff --git a/physics/cires_vert_orodis_v1.F90 b/physics/cires_vert_orodis_v1.F90 index c328a3fb6..d16b1519f 100644 --- a/physics/cires_vert_orodis_v1.F90 +++ b/physics/cires_vert_orodis_v1.F90 @@ -766,15 +766,15 @@ end subroutine ugwp_taub_oro ! !-------------------------------------- ! -! call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, kxw, & -! fcor(j), c2f2(j), up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, & -! xn, yn, umag, drtau, kdis_oro) +! call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, & +! con_pi, con_g, kxw, fcor(j), c2f2(j), up, vp, tp, qp, dp, zpm, zpi, & +! pmid1, pint1, xn, yn, umag, drtau, kdis_oro) subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & - kxw, fcor, kxridge, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - xn, yn, umag, drtau, kdis) + pi, grav, kxw, fcor, kxridge, up, vp, tp, qp, dp, zpm, zpi, & + pmid, pint, xn, yn, umag, drtau, kdis) - use ugwp_common_v1, only : bnv2min, grav, pi, pi2, dw2min, velmin, rgrav + use ugwp_common_v1, only : dw2min, velmin use cires_ugwp_module_v1, only : frcrit, ricrit, linsat, hps, rhp1, rhp2 use cires_ugwp_module_v1, only : kvg, ktg, krad, kion use ugwp_oro_init_v1, only : coro , fcrit_sm , fcrit_sm2 @@ -786,6 +786,8 @@ subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & real , dimension(levs+1) :: tau_src + real, intent(in) :: pi, grav + real, dimension(levs) , intent(in) :: up, vp, tp, qp, dp, zpm real, dimension(levs+1), intent(in) :: zpi, pmid, pint real , intent(in) :: xn, yn, umag @@ -796,6 +798,7 @@ subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & ! ! locals ! + real :: bnv2min, pi2, rgrav real :: uref, udir, uf2, ufd, uf2p real, dimension(levs+1) :: tauz real, dimension(levs) :: rho @@ -809,6 +812,10 @@ subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & real :: betadis, betam, betat, cdfm, cdft real :: fsat, hsat, hsat2, kds , c2f2 + pi2 = 2.0*pi + bnv2min = (pi2/1800.)*(pi2/1800.) + rgrav = 1.0/grav + drtau(1:levs) = 0.0 kdis (1:levs) = 0.0 @@ -931,15 +938,15 @@ subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & end subroutine ugwp_oro_lsatdis ! ! - subroutine ugwp_tofd(im, levs, sigflt, elvmax, zpbl, u, v, zmid, & + subroutine ugwp_tofd(im, levs, con_cp, sigflt, elvmax, zpbl, u, v, zmid, & utofd, vtofd, epstofd, krf_tofd) use machine , only : kind_phys - use ugwp_common_v1 , only : rcpd2 use ugwp_oro_init_v1, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd ! implicit none ! integer :: im, levs + real(kind_phys) :: con_cp real(kind_phys), dimension(im, levs) :: u, v, zmid real(kind_phys), dimension(im) :: sigflt, elvmax, zpbl real(kind_phys), dimension(im, levs) :: utofd, vtofd, epstofd, krf_tofd @@ -947,10 +954,12 @@ subroutine ugwp_tofd(im, levs, sigflt, elvmax, zpbl, u, v, zmid, & ! locals ! integer :: i, k + real :: rcpd2 real :: sgh = 30. real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, zexp, krf ! utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 + rcpd2 = 0.5/con_cp ! do i=1, im @@ -979,14 +988,14 @@ subroutine ugwp_tofd(im, levs, sigflt, elvmax, zpbl, u, v, zmid, & end subroutine ugwp_tofd ! ! - subroutine ugwp_tofd1d(levs, sigflt, elvmax, zsurf, zpbl, u, v, & + subroutine ugwp_tofd1d(levs, con_cp, sigflt, elvmax, zsurf, zpbl, u, v, & zmid, utofd, vtofd, epstofd, krf_tofd) use machine , only : kind_phys - use ugwp_common_v1 , only : rcpd2 use ugwp_oro_init_v1, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd ! implicit none integer :: levs + real(kind_phys) :: con_cp real(kind_phys), dimension(levs) :: u, v, zmid real(kind_phys) :: sigflt, elvmax, zpbl, zsurf real(kind_phys), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd @@ -994,10 +1003,12 @@ subroutine ugwp_tofd1d(levs, sigflt, elvmax, zsurf, zpbl, u, v, & ! locals ! integer :: i, k + real :: rcpd2 real :: sghmax = 5. real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, ztexp, krf ! utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 + rcpd2 = 0.5/con_cp ! zdec = max(n_tofd*sigflt, zpbl) ! ntimes*sgh_turb or Zpbl zdec = min(ze_tofd, zdec) ! cannot exceed 18 km diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index f573c8776..3e3411fa8 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -31,7 +31,8 @@ subroutine cires_ugwp_driver_v0(me, master, ! (similar to WAM-2017) !----------------------------------------------------------- use machine, only : kind_phys - use physcons, only : con_cp, con_g, con_rd, con_rv + use physcons, only : con_cp, con_g, con_rd, con_rv, & + con_omega use ugwp_wmsdis_init, only : tamp_mpa, ilaunch use sso_coorde, only : pgwd, pgwd4, debugprint @@ -121,6 +122,7 @@ subroutine cires_ugwp_driver_v0(me, master, & SIGMA, GAMM, ELVMAX, & DUSFCg, DVSFCg, xlatd, sinlat, coslat, spgrid, & cdmbgwd(1:2), me, master, rdxzb, + & con_g, con_omega, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & du3dt_mtb, du3dt_ogw, du3dt_tms) ! @@ -287,7 +289,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DTP,KDT, & sgh30, HPRIME,OC,OA4,CLX4,THETA,vSIGMA,vGAMMA,ELVMAXD, & DUSFC, DVSFC, xlatd, sinlat, coslat, sparea, - $ cdmbgwd, me, master, rdxzb, + & cdmbgwd, me, master, rdxzb, + & con_g, con_omega, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & dudt_mtb, dudt_ogw, dudt_tms) !---------------------------------------- @@ -341,6 +344,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys), intent(in) :: ELVMAXD(IM), THETA(IM) real(kind=kind_phys), intent(in) :: vSIGMA(IM), vGAMMA(IM) real(kind=kind_phys) :: SIGMA(IM), GAMMA(IM) + + real(kind=kind_phys), intent(in) :: con_g, con_omega !output -phys-tend real(kind=kind_phys),dimension(im,km),intent(out) :: @@ -1066,6 +1071,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, + & con_g, con_omega, & del, sigma, hprime, gamma, theta, & sinlat, xlatd, taup, taud, pkdis) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 13b9f9193..fda887f3e 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -74,10 +74,10 @@ module unified_ugwp ! subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & - pa_rf_in, tau_rf_in, con_p0, do_ugwp, do_ugwp_v0, & - do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, & - do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, & - errmsg, errflg) + con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, & + do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & + do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & + do_ugwp_v1_orog_only, errmsg, errflg) !---- initialization of unified_ugwp implicit none @@ -95,7 +95,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & real(kind=kind_phys), intent (in) :: dtp real(kind=kind_phys), intent (in) :: cdmbgwd(4), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in - real(kind=kind_phys), intent (in) :: con_p0 + real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth logical, intent (in) :: do_ugwp logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, & @@ -156,9 +156,10 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if ( do_ugwp_v1 ) then - call cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat, & - fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & - cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) + call cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat, con_pi, & + con_rerth, fn_nml2, lonr, latr, levs, ak, bk, & + con_p0, dtp, cdmbgwd(1:2), cgwf, pa_rf_in, & + tau_rf_in, errmsg, errflg) end if is_initialized = .true. @@ -171,11 +172,11 @@ end subroutine unified_ugwp_init ! ----------------------------------------------------------------------- !>@brief The subroutine finalizes the CIRES UGWP -#if 0 + !> \section arg_table_unified_ugwp_finalize Argument Table !! \htmlinclude unified_ugwp_finalize.html !! -#endif + subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v1,errmsg, errflg) implicit none @@ -229,8 +230,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & dudt_mtb,dudt_ogw, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & - dudt, dvdt, dtdt, rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & - rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & + dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & + con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & ldiag3d, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & @@ -288,7 +289,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), intent(inout), dimension(im, levs):: dudt, dvdt, dtdt - real(kind=kind_phys), intent(in) :: con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt + real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, & + con_rv, con_rerth, con_fvirt real(kind=kind_phys), intent(in), dimension(im) :: rain @@ -397,10 +399,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ugrs , vgrs, tgrs, q1, KPBL, prsi,del,prsl, & prslk, zmeti, zmet, dtp, kdt, hprime, oc, oa4, & clx, theta, sigma, gamma, elvmax, & - sgh30, DUSFCg, DVSFCg, xlat_d, sinlat, coslat, & - area,cdmbgwd(1:2), me, master, rdxzb, & - zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & - du3dt_mtb, du3dt_ogw, du3dt_tms) + con_g, con_omega, con_rd, con_cp, con_rv,con_pi, & + con_rerth, con_fvirt, sgh30, DUSFCg, DVSFCg, & + xlat_d, sinlat, coslat, area,cdmbgwd(1:2), me, & + master, rdxzb, zmtb, zogw, tau_mtb, tau_ogw, & + tau_tofd, du3dt_mtb, du3dt_ogw, du3dt_tms) end if @@ -663,6 +666,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, call cires_ugwp_solv2_v1(im, levs, dtp, & tgrs, ugrs, vgrs, q1, prsl, prsi, & zmet, zmeti,prslk, xlat_d, sinlat, coslat, & + con_g, con_cp, con_rd, con_rv, con_omega, & + con_pi, con_fvirt, & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & tauabs, wrms, trms, tau_ngw, me, master, kdt) diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 28aa196d3..49f9365fd 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -138,6 +138,24 @@ kind = kind_phys intent = in optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rerth] + standard_name = radius_of_earth + long_name = radius of earth + units = m + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [pa_rf_in] standard_name = pressure_cutoff_for_rayleigh_damping long_name = pressure level from which Rayleigh Damping is applied @@ -1067,6 +1085,15 @@ kind = kind_phys intent = in optional = F +[con_omega] + standard_name = angular_velocity_of_earth + long_name = angular velocity of earth + units = s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [con_pi] standard_name = pi long_name = ratio of a circle's circumference to its diameter @@ -1103,6 +1130,15 @@ kind = kind_phys intent = in optional = F +[con_rerth] + standard_name = radius_of_earth + long_name = radius of earth + units = m + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [con_fvirt] standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) diff --git a/physics/unified_ugwp_post.F90 b/physics/unified_ugwp_post.F90 index 5e43f2830..39de4b475 100644 --- a/physics/unified_ugwp_post.F90 +++ b/physics/unified_ugwp_post.F90 @@ -12,11 +12,11 @@ subroutine unified_ugwp_post_init () end subroutine unified_ugwp_post_init !>@brief The subroutine initializes the unified UGWP -#if 0 + !> \section arg_table_unified_ugwp_post_run Argument Table !! \htmlinclude unified_ugwp_post_run.html !! -#endif + subroutine unified_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & From 73f06a3273f13077d73673eeb180e51c2ea90911 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Mon, 26 Oct 2020 23:14:46 +0000 Subject: [PATCH 089/274] Modified code per G. Firl's PR recommendations --- physics/cires_vert_orodis_v1.F90 | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/physics/cires_vert_orodis_v1.F90 b/physics/cires_vert_orodis_v1.F90 index d16b1519f..9638abc56 100644 --- a/physics/cires_vert_orodis_v1.F90 +++ b/physics/cires_vert_orodis_v1.F90 @@ -37,6 +37,9 @@ subroutine ugwp_drag_mtb( iemax, nz, & real, dimension(nz), intent(in) :: up, vp, tp, qp, dp, zpm, pmid real, dimension(nz+1), intent(in) :: zpi, pint + + ! character(len=*), intent(out) :: errmsg + ! integer, intent(out) :: errflg ! real, dimension(nz+1) :: zpi_zero real, dimension(nz) :: zpm_zero @@ -51,7 +54,12 @@ subroutine ugwp_drag_mtb( iemax, nz, & phiang, ang, pe, ek, & cang, sang, ss2, cs2, zlen, dbtmp, & hamp, bgamm, cgamm - + + + ! Initialize CCPP error handling variables + ! errmsg = '' + ! errflg = 0 + !================================================== ! ! elvp + hprime <=>elvp + nridge*hprime, ns =2 @@ -77,11 +85,11 @@ subroutine ugwp_drag_mtb( iemax, nz, & mtb_fix = cdmb*sigma/hamp !hamp ~ 2*hprime and 1/sigfac = 0.25 is inside 1/hamp - if (mtb_fix == 0.) then - print *, cdmb, sigma, hamp - print *, ' MTB == 0' - stop - endif + ! if (mtb_fix == 0.) then + ! write(errmsg,'(*(a))') cdmb, sigma, hamp, ' MTB == 0' + ! errflg = 1 + ! return + ! endif if (strver == 'vay_2018') then @@ -99,7 +107,14 @@ subroutine ugwp_drag_mtb( iemax, nz, & bn2, uhm, vhm, bn2hm, rhohm) umag = max(sqrt(uhm*uhm + vhm*vhm), velmin) !velmin=dw2min =1.0 m/s - if (bn2hm .le. 0.0) then + ! if (bn2hm .le. 0.0) then + ! write(errmsg,'(*(a))') 'unstable MF for MTB - RETURN ' + ! errflg = 1 + ! return + ! end if + + + print *, ' unstable MF for MTB -RETURN ' RETURN ! unstable PBL endif From 2cf01d008e8f26e858cdb520226b8e5b8be50375 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Tue, 27 Oct 2020 19:52:27 +0000 Subject: [PATCH 090/274] cires_vert_orodis_v1.F90 bug fix --- physics/cires_vert_orodis_v1.F90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/physics/cires_vert_orodis_v1.F90 b/physics/cires_vert_orodis_v1.F90 index 9638abc56..852c114b0 100644 --- a/physics/cires_vert_orodis_v1.F90 +++ b/physics/cires_vert_orodis_v1.F90 @@ -110,14 +110,9 @@ subroutine ugwp_drag_mtb( iemax, nz, & ! if (bn2hm .le. 0.0) then ! write(errmsg,'(*(a))') 'unstable MF for MTB - RETURN ' ! errflg = 1 - ! return + ! return ! unstable PBL ! end if - - - print *, ' unstable MF for MTB -RETURN ' - RETURN ! unstable PBL - endif bnmag =sqrt(bn2hm) frd_src = min(hamp*bnmag/umag, frmax) ! frmax =10. From dc843a5b033938db1a02a51f0e9f0866b5964b99 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 27 Oct 2020 23:41:01 +0000 Subject: [PATCH 091/274] Initial commit --- physics/radiation_cloud_overlap.F90 | 116 ++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100644 physics/radiation_cloud_overlap.F90 diff --git a/physics/radiation_cloud_overlap.F90 b/physics/radiation_cloud_overlap.F90 new file mode 100644 index 000000000..a94923ba5 --- /dev/null +++ b/physics/radiation_cloud_overlap.F90 @@ -0,0 +1,116 @@ +module module_radiation_cloud_overlap + use physparam, only : kind_phys + implicit none + public :: cmp_dcorr_lgth + + interface cmp_dcorr_lgth + module procedure cmp_dcorr_lgth_hogan + module procedure cmp_dcorr_lgth_oreopoulos + end interface + +contains + ! ###################################################################################### + ! Hogan et al. (2010) + ! "Effect of improving representation of horizontal and vertical cloud structure on the + ! Earth's global radiation budget. Part I: Review and parametrization" + ! https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647 + ! ###################################################################################### + subroutine cmp_dcorr_lgth_hogan(nCol, lat, con_pi, dcorr_lgth) + ! Inputs + integer, intent(in) :: & + nCol ! Number of horizontal grid-points + real(kind_phys), intent(in) :: & + con_pi ! Physical constant: Pi + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + dcorr_lgth ! Decorrelation length + + ! Local variables + integer :: iCol + + ! Parameters + real(kind_phys),parameter :: min_dcorr = 0.6 ! (see section 2.3) + + do iCol =1,nCol + dcorr_lgth(iCol) = max(min_dcorr, 2.78-4.6*abs(lat(iCol)/con_pi)) ! (eq. 13) + enddo + + end subroutine cmp_dcorr_lgth_hogan + ! ###################################################################################### + ! Oreopoulos et al. (2012) + ! "Radiative impacts of cloud heterogeneity and overlap in an + ! atmospheric General Circulation Model" + ! 10.5194/acp-12-9097-2012 + ! ###################################################################################### + subroutine cmp_dcorr_lgth_oreopoulos(nCol, lat, juldat, yearlength, dcorr_lgth) + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid-points + yearlength ! Number of days in year + + real(kind_phys), intent(in) :: & + juldat ! Julian date + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + dcorr_lgth ! Decorrelation length (km) + + ! Parameters for the Gaussian fits per Eqs. (10) and (11) (See Table 1) + real(kind_phys), parameter :: & ! + am1 = 1.4315_kind_phys, & ! + am2 = 2.1219_kind_phys, & ! + am4 = -25.584_kind_phys, & ! + amr = 7.0_kind_phys ! + + ! Local variables + integer :: iCol + real(kind_phys) :: am3 + + do iCol = 1, nCol + if (juldat .gt. 181._kind_phys) then + am3 = -4._kind_phys * amr * (juldat - 272._kind_phys) / yearlength ! (eq. 11a) + else + am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) / yearlength ! (eq. 11b) + endif + dcorr_lgth(iCol) = am1 + am2 * exp( -(lat(iCol) - am3)**2 / am4**2) ! (eq. 10) + enddo + + end subroutine cmp_dcorr_lgth_oreopoulos + + ! ###################################################################################### + ! + ! ###################################################################################### + subroutine get_alpha_exp(nCol, nLay, dzlay, dcorr_lgth, alpha) + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLay ! Number of vertical grid points + real(kind_phys), dimension(nCol), intent(in) :: & + dcorr_lgth ! Decorrelation length (km) + real(kind_phys), dimension(nCol,nLay), intent(in) :: & + dzlay ! + + ! Outputs + real(kind_phys), dimension(nCol,nLay) :: & + alpha ! Cloud overlap parameter + + ! Local variables + integer :: iCol,iLay + + do iCol = 1, nCol + alpha(iCol,1) = 0.0d0 + do iLay = 2, nLay + alpha(iCol,iLay) = exp( -(dzlay(iCol,iLay)) / dcorr_lgth(iCol)) + enddo + enddo + + return + + end subroutine get_alpha_exp + +end module module_radiation_cloud_overlap From e23d4a8845b4145413c590e3f03806ba4bc7cde8 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 28 Oct 2020 16:01:52 +0000 Subject: [PATCH 092/274] Use common cloud-overlap routines in RRTMG --- physics/radiation_clouds.f | 391 ++++++++++--------------------------- 1 file changed, 106 insertions(+), 285 deletions(-) diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 828db4ed0..069c8e867 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -208,14 +208,16 @@ !> This module computes cloud related quantities for radiation computations. module module_radiation_clouds ! - use physparam, only : icldflg, iovrsw, iovrlw, & + use physparam, only : icldflg, iovrsw, iovrlw, idcor, & & lcrick, lcnorm, lnoprec, & & ivflip, kind_phys, kind_io4 use physcons, only : con_fvirt, con_ttp, con_rocp, & & con_t0c, con_pi, con_g, con_rd, & - & con_thgni + & con_thgni, decorr_con use module_microphysics, only : rsipath2 use module_iounitdef, only : NICLTUN + use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, & + & get_alpha_exp ! implicit none ! @@ -257,8 +259,7 @@ module module_radiation_clouds integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & - & cld_init, progcld5, progcld4o, gethml, & - & get_alpha_dcorr, get_alpha_exp + & cld_init, progcld5, progcld4o, gethml ! ================= @@ -837,14 +838,22 @@ subroutine progcld1 & enddo endif -!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha_exp & -! --- inputs: - & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & -! --- outputs: - & alpha & - & ) + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con + endif + + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if (iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. endif !> - Call gethml() to compute low,mid,high,total, and boundary layer @@ -1300,23 +1309,22 @@ subroutine progcld2 & enddo enddo -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con endif -!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha_exp & -! --- inputs: - & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & -! --- outputs: - & alpha & - & ) + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if (iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. endif !> - Call gethml(), to compute low, mid, high, total, and boundary @@ -1723,23 +1731,23 @@ subroutine progcld3 & enddo enddo -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con endif -!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha_exp & -! --- inputs: - & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & -! --- outputs: - & alpha & - & ) + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if (iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. endif !> -# Call gethml() to compute low,mid,high,total, and boundary layer @@ -2086,23 +2094,22 @@ subroutine progcld4 & enddo enddo -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con endif -!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha_exp & -! --- inputs: - & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & -! --- outputs: - & alpha & - & ) + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if (iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. endif ! --- compute low, mid, high, total, and boundary layer cloud fractions @@ -2440,23 +2447,22 @@ subroutine progcld4o & enddo enddo -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con endif -!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha_exp & -! --- inputs: - & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & -! --- outputs: - & alpha & - & ) + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if (iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. endif !> - Call gethml() to compute low, mid, high, total, and boundary layer cloud fractions @@ -2808,23 +2814,22 @@ subroutine progcld5 & enddo enddo -! --- ... estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con endif -!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha_exp & -! --- inputs: - & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & -! --- outputs: - & alpha & - & ) + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if (iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. endif !> - Call gethml() to compute low,mid,high,total, and boundary layer @@ -3202,24 +3207,23 @@ subroutine progclduni & ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) enddo enddo - -!> -# Estimate clouds decorrelation length in km -! this is only a tentative test, need to consider change later - - if ( iovr == 3 ) then - do i = 1, ix - de_lgth(i) = max( 0.6, 2.78-4.6*rxlat(i) ) - enddo + ! Compute cloud decorrelation length + if (idcor == 1) then + call cmp_dcorr_lgth(ix, xlat, con_pi, de_lgth) + endif + if (idcor == 2) then + call cmp_dcorr_lgth(ix, latdeg, julian, yearlen, de_lgth) + endif + if (idcor == 0) then + de_lgth(:) = decorr_con endif -!> - Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options - if ( iovr == 4 .or. iovr == 5 ) then - call get_alpha_exp & -! --- inputs: - & (ix, nlay, dzlay, iovr, latdeg, julian, yearlen, cldtot, & -! --- outputs: - & alpha & - & ) + ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options + if (iovr == 3 .or. iovr == 4 .or. iovr == 5) then + call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) + else + de_lgth(:) = 0. + alpha(:,:) = 0. endif !> - Call gethml() to compute low,mid,high,total, and boundary layer @@ -3709,189 +3713,6 @@ subroutine get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, & enddo end subroutine get_alpha_dcorr - ! ######################################################################################### -!> \ingroup module_radiation_clouds -!! This program derives the exponential transition, alpha, from maximum to -!! random overlap needed to define the fractional cloud vertical correlation -!! for the exponential (EXP, iovrlp=4) or the exponential-random (ER, iovrlp=5) -!! cloud overlap options for RRTMG/RRTMGP. For exponential, the transition from -!! maximum to random with distance through model layers occurs without regard -!! to the configuration of clear and cloudy layers. For the ER method, each -!! block of adjacent cloudy layers is treated with a separate transition from -!! maximum to random, and blocks of cloudy layers separated by one or more -!! clear layers are correlated randomly. -!> /param nlon : number of model longitude points -!> /param nlay : vertical layer dimension -!> /param dzlay(nlon,nlay) : distance between the center of model layers -!> /param iovrlp : cloud overlap method -!> : 0 = random -!> : 1 = maximum-random -!> : 2 = maximum -!> : 3 = decorrelation (NOAA/Hou) -!> : 4 = exponential (AER) -!> : 5 = exponential-random (AER) -!> /param latdeg(nlon) : latitude (in degrees 90 -> -90) -!> /param juldat : day of the year (fractional julian day) -!> /param yearlen : current length of the year (365/366 days) -!> /param cldf(nlon,nlay) : cloud fraction -!> /param idcor : decorrelation length method -!> : 0 = constant value (AER; decorr_con) -!> : 1 = latitude and day of year varying value (AER; Oreopoulos, et al., 2012) -!> /param decorr_con : decorrelation length constant -!! -!>\section detail Detailed Algorithm -!! @{ - subroutine get_alpha_exp & -! --- inputs: - & (nlon, nlay, dzlay, iovrlp, latdeg, juldat, yearlen, cldf, & -! --- outputs: - & alpha & - & ) - -! =================================================================== ! -! ! -! abstract: Derives the exponential transition, alpha, from maximum to ! -! random overlap needed to define the fractional cloud vertical ! -! correlation for the exponential (EXP, iovrlp=4) or the exponential- ! -! random (ER, iovrlp=5) cloud overlap options for RRTMG. For ! -! exponential, the transition from maximum to random with distance ! -! through model layers occurs without regard to the configuration of ! -! clear and cloudy layers. For the ER method, each block of adjacent ! -! cloudy layers is treated with a separate transition from maximum to ! -! random, and blocks of cloudy layers separated by one or more ! -! clear layers are correlated randomly. ! -! ! -! usage: call get_alpha_exp ! -! ! -! subprograms called: none ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm-sp, sgi ! -! ! -! author: m.j. iacono (AER) for use with the RRTMG radiation code ! -! ! -! ==================== definition of variables ==================== ! -! ! -! Input variables: ! -! nlon : number of model longitude points ! -! nlay : vertical layer dimension ! -! dzlay(nlon,nlay) : distance between the center of model layers ! -! iovrlp : cloud overlap method ! -! : 0 = random ! -! : 1 = maximum-random ! -! : 2 = maximum ! -! : 3 = decorrelation (NOAA/Hou) ! -! : 4 = exponential (AER) ! -! : 5 = exponential-random (AER) ! -! latdeg(nlon) : latitude (in degrees 90 -> -90) ! -! juldat : day of the year (fractional julian day) ! -! yearlen : current length of the year (365/366 days) ! -! cldf(nlon,nlay) : cloud fraction ! -! ! -! output variables: ! -! alpha(nlon,nlay) : alpha exponential transition parameter for ! -! : cloud vertical correlation ! -! ! -! external module variables: (in physcons) ! -! decorr_con : decorrelation length constant (km) ! -! ! -! external module variables: (in physparam) ! -! idcor : control flag for decorrelation length method ! -! =0: constant decorrelation length (decorr_con) ! -! =1: latitude and day-of-year varying decorrelation! -! length (AER; Oreopoulos, et al., 2012) ! -! ! -! ==================== end of description ===================== ! -! - use physcons, only: decorr_con - use physparam, only: idcor - - implicit none - -! Input - integer, intent(in) :: nlon, nlay - integer, intent(in) :: iovrlp - integer, intent(in) :: yearlen - real(kind=kind_phys), dimension(:,:), intent(in) :: dzlay - real(kind=kind_phys), dimension(:,:), intent(in) :: cldf - real(kind=kind_phys), dimension(:), intent(in) :: latdeg - real(kind=kind_phys), intent(in) :: juldat - -! Output - real(kind=kind_phys), dimension(:,:), intent(out):: alpha - -! Local - integer :: i, k - real(kind=kind_phys) :: decorr_len(nlon) ! Decorrelation length (km) - -! Constants for latitude and day-of-year dependent decorrlation length (Oreopoulos et al, 2012) -! Used when idcor = 1 - real(kind=kind_phys), parameter :: am1 = 1.4315_kind_phys - real(kind=kind_phys), parameter :: am2 = 2.1219_kind_phys - real(kind=kind_phys), parameter :: am4 = -25.584_kind_phys - real(kind=kind_phys), parameter :: amr = 7.0_kind_phys - real(kind=kind_phys) :: am3 - - real(kind=kind_phys), parameter :: zero = 0.0d0 - real(kind=kind_phys), parameter :: one = 1.0d0 - -! -!===> ... begin here -! -! If exponential or exponential-random cloud overlap is used: -! derive day-of-year and latitude-varying decorrelation lendth if requested; -! otherwise use the constant decorrelation length, decorr_con, specified in physcons.F90 - do i = 1, nlon - if (iovrlp == 4 .or. iovrlp == 5) then - if (idcor .eq. 1) then - if (juldat .gt. 181._kind_phys) then - am3 = -4._kind_phys * amr * (juldat - 272._kind_phys) - & / yearlen - else - am3 = 4._kind_phys * amr * (juldat - 91._kind_phys) - & / yearlen - endif -! For latitude in degrees, decorr_len in km - decorr_len(i) = am1 + am2 * exp( -(latdeg(i) - am3)**2 - & / am4**2) - else - decorr_len(i) = decorr_con - endif - endif - enddo - -! For atmospheric data defined from surface to toa; define alpha from surface to toa -! Exponential cloud overlap - if (iovrlp == 4) then - do i = 1, nlon - alpha(i,1) = zero - do k = 2, nlay - alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) - enddo - enddo - endif -! Exponential-random cloud overlap - if (iovrlp == 5) then - do i = 1, nlon - alpha(i,1) = zero - do k = 2, nlay - alpha(i,k) = exp( -(dzlay(i,k)) / decorr_len(i)) - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (cldf(i,k) .eq. zero .and. cldf(i,k-1) .gt. zero) then - alpha(i,k) = zero - endif - enddo - enddo - endif - - return - - end subroutine get_alpha_exp -!----------------------------------- -!! @} -! !........................................! end module module_radiation_clouds ! !! @} From a8cc7697c5ce4e6ba5539b9595a6398364608d0a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 28 Oct 2020 16:40:22 +0000 Subject: [PATCH 093/274] Remove distinct lw/sw cloud-overlap options in RRTMG. --- physics/GFS_rrtmg_pre.meta | 2 +- physics/GFS_rrtmg_setup.F90 | 27 +++++++++++-------------- physics/GFS_rrtmg_setup.meta | 14 +++---------- physics/physcons.F90 | 2 +- physics/physparam.f | 17 ++++------------ physics/radiation_clouds.f | 9 +++------ physics/radlw_main.f | 30 ++++++++++++++-------------- physics/radsw_main.f | 32 +++++++++++++++--------------- physics/rrtmgp_sw_cloud_optics.F90 | 1 - 9 files changed, 55 insertions(+), 79 deletions(-) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 0ffa78ee5..5ad7bc76a 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -3,7 +3,7 @@ type = scheme dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,module_mp_radar.F90,module_mp_thompson.F90 dependencies = module_mp_thompson_make_number_concentrations.F90,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90 + dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radlw_param.f,radsw_param.f,surface_perturbation.F90,radiation_cloud_overlap.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index b3c91cacc..1bf2e445b 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -5,7 +5,7 @@ module GFS_rrtmg_setup use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg,& ! & iaermdl, laswflg, lalwflg, lavoflg, icldflg, & & iaermdl, icldflg, & - & iovrsw , iovrlw , lcrick , lcnorm , lnoprec, & + & iovrRad=>iovr, lcrick , lcnorm , lnoprec, & & ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & & iswcliq, & & kind_phys @@ -45,7 +45,7 @@ module GFS_rrtmg_setup !! subroutine GFS_rrtmg_setup_init ( & si, levr, ictm, isol, ico2, iaer, ialb, iems, ntcw, num_p2d, & - num_p3d, npdf3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & + num_p3d, npdf3d, ntoz, iovr, isubc_sw, isubc_lw, & icliq_sw, crick_proof, ccnorm, & imp_physics, & norad_precip, idate, iflip, & @@ -131,7 +131,7 @@ subroutine GFS_rrtmg_setup_init ( & ! Stamnes(1993) \cite hu_and_stamnes_1993 method ! ! =2:cloud optical property scheme based on Hu and ! ! Stamnes(1993) -updated ! -! iovr_sw/iovr_lw : control flag for cloud overlap (sw/lw rad) ! +! iovr : control flag for cloud overlap (sw/lw rad) ! ! =0: random overlapping clouds ! ! =1: max/ran overlapping clouds ! ! =2: maximum overlap clouds (mcica only) ! @@ -177,8 +177,7 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: num_p3d integer, intent(in) :: npdf3d integer, intent(in) :: ntoz - integer, intent(in) :: iovr_sw - integer, intent(in) :: iovr_lw + integer, intent(in) :: iovr integer, intent(in) :: isubc_sw integer, intent(in) :: isubc_lw integer, intent(in) :: icliq_sw @@ -268,9 +267,10 @@ subroutine GFS_rrtmg_setup_init ( & iswcliq = icliq_sw ! optical property for liquid clouds for sw - iovrsw = iovr_sw ! cloud overlapping control flag for sw - iovrlw = iovr_lw ! cloud overlapping control flag for lw - + ! iovr comes from the model. In the RRTMG implementation this is stored in phyrparam.f, + ! it comes in from the host-model and is set here. + ! In GP, iovr is passed directly into the routines. + iovrRAD = iovr lcrick = crick_proof ! control flag for eliminating CRICK lcnorm = ccnorm ! control flag for in-cld condensate lnoprec = norad_precip ! precip effect on radiation flag (ferrier microphysics) @@ -293,8 +293,8 @@ subroutine GFS_rrtmg_setup_init ( & print *,' si =',si print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& & ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw - print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr_sw=',iovr_sw, & - & ' iovr_lw=',iovr_lw,' isubc_sw=',isubc_sw, & + print *,' np3d=',num_p3d,' ntoz=',ntoz, & + & ' iovr=',iovr,' isubc_sw=',isubc_sw, & & ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & & ' iflip=',iflip,' me=',me print *,' crick_proof=',crick_proof, & @@ -467,8 +467,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! =8 Thompson microphysics scheme ! ! =6 WSM6 microphysics scheme ! ! =10 MG microphysics scheme ! -! iovrsw : control flag for cloud overlap in sw radiation ! -! iovrlw : control flag for cloud overlap in lw radiation ! +! iovr : control flag for cloud overlap in radiation ! ! =0: random overlapping clouds ! ! =1: max/ran overlapping clouds ! ! isubcsw : sub-column cloud approx control flag in sw radiation ! @@ -544,10 +543,8 @@ subroutine radinit( si, NLAY, imp_physics, me ) & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg - print *,' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw, & + print *,' IVFLIP=',ivflip,' IOVR=',iovrRad, & & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw -! write(0,*)' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw,& -! & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw print *,' LCRICK=',lcrick,' LCNORM=',lcnorm,' LNOPREC=',lnoprec print *,' LTP =',ltp,', add extra top layer =',lextop diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index fec7e32d0..1f2294a54 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -112,17 +112,9 @@ type = integer intent = in optional = F -[iovr_sw] - standard_name = flag_for_cloud_overlap_method_for_shortwave_radiation - long_name = sw: max-random overlap clouds - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_lw] - standard_name = flag_for_cloud_overlap_method_for_longwave_radiation - long_name = lw: max-random overlap clouds +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = max-random overlap clouds units = flag dimensions = () type = integer diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 6a41bda44..397fee935 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -138,7 +138,7 @@ module physcons real(kind=kind_phys),parameter:: rhosnow = 100._kind_phys !< density of snow (kg/m^3) real(kind=kind_phys),parameter:: rhoair = 1.28_kind_phys !< density of air near surface (kg/m^3) -! Decorrelation length constant (km) for iovrlw/iovrsw = 4 or 5 and idcor = 0 +! Decorrelation length constant (km) for iovr = 4 or 5 and idcor = 0 real(kind=kind_phys),parameter:: decorr_con = 2.50_kind_phys !........................................! diff --git a/physics/physparam.f b/physics/physparam.f index c71b62e5b..5518c6163 100644 --- a/physics/physparam.f +++ b/physics/physparam.f @@ -229,25 +229,16 @@ module physparam !!\n =1:use prognostic cloud scheme for cloud cover and cloud properties integer, save :: icldflg = 1 -!> cloud overlapping control flag for SW +!> cloud overlapping control flag for Radiation !!\n =0:use random cloud overlapping method !!\n =1:use maximum-random cloud overlapping method !!\n =2:use maximum cloud overlapping method !!\n =3:use decorrelation length overlapping method !!\n =4:use exponential overlapping method !!\n =5:use exponential-random overlapping method -!!\n Opr GFS/CFS=1; see IOVR_SW in run scripts - integer, save :: iovrsw = 1 -!> cloud overlapping control flag for LW -!!\n =0:use random cloud overlapping method -!!\n =1:use maximum-random cloud overlapping method -!!\n =2:use maximum cloud overlapping method -!!\n =3:use decorrelation length overlapping method -!!\n =4:use exponential overlapping method -!!\n =5:use exponential-random overlapping method -!!\n Opr GFS/CFS=1; see IOVR_LW in run scripts - integer, save :: iovrlw = 1 -!!\n Decorrelation length type for iovrlw/iovrsw = 4 or 5 +!!\n Opr GFS/CFS=1; see IOVR in run scripts + integer, save :: iovr = 1 +!!\n Decorrelation length type for iovr = 4 or 5 !!\n =0:use constant decorrelation length defined by decorr_con (in module physcons) !!\n =1:use day-of-year and latitude-varying decorrelation length integer, save :: idcor = 1 diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 069c8e867..594c65c80 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -188,7 +188,7 @@ !!\n IMP_PHYSICS =98/99: Zhao-Carr-Sundqvist MP - Xu-Randall diagnostic cloud fraction !!\n IMP_PHYSICS =11: GFDL MP - unified diagnostic cloud fraction provided by GFDL MP !! -!! Cloud overlapping method (namelist control parameter - \b IOVR_LW, \b IOVR_SW) +!! Cloud overlapping method (namelist control parameter - \b IOVR) !!\n IOVR=0: randomly overlapping vertical cloud layers !!\n IOVR=1: maximum-random overlapping vertical cloud layers !!\n IOVR=2: maximum overlapping vertical cloud layers @@ -208,7 +208,7 @@ !> This module computes cloud related quantities for radiation computations. module module_radiation_clouds ! - use physparam, only : icldflg, iovrsw, iovrlw, idcor, & + use physparam, only : icldflg, iovr, idcor, & & lcrick, lcnorm, lnoprec, & & ivflip, kind_phys, kind_io4 use physcons, only : con_fvirt, con_ttp, con_rocp, & @@ -256,7 +256,6 @@ module module_radiation_clouds real (kind=kind_phys), parameter :: cldasy_def = 0.84 !< default cld asymmetry factor integer :: llyr = 2 !< upper limit of boundary layer clouds - integer :: iovr = 1 !< maximum-random cloud overlapping method public progcld1, progcld2, progcld3, progcld4, progclduni, & & cld_init, progcld5, progcld4o, gethml @@ -313,7 +312,7 @@ subroutine cld_init & ! =8: Thompson microphysics ! ! =6: WSM6 microphysics ! ! =10: MG microphysics ! -! iovrsw/iovrlw : sw/lw control flag for cloud overlapping scheme ! +! iovr : control flag for cloud overlapping scheme ! ! =0: random overlapping clouds ! ! =1: max/ran overlapping clouds ! ! =2: maximum overlap clouds (mcica only) ! @@ -346,8 +345,6 @@ subroutine cld_init & ! ! --- set up module variables - iovr = max( iovrsw, iovrlw ) !cld ovlp used for diag HML cld output - if (me == 0) print *, VTAGCLD !print out version tag if ( icldflg == 0 ) then diff --git a/physics/radlw_main.f b/physics/radlw_main.f index f470ad109..31c45a33f 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -279,7 +279,7 @@ module rrtmg_lw ! use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & - & isubclw, icldflg, iovrlw, ivflip, & + & isubclw, icldflg, iovr, ivflip, & & kind_phys use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 @@ -524,7 +524,7 @@ subroutine rrtmg_lw_run & ! =0: no sub-col cld treatment, use grid-mean cld quantities ! ! =1: mcica sub-col, prescribed seeds to get random numbers ! ! =2: mcica sub-col, providing array icseed for random numbers! -! iovrlw - cloud overlapping control flag ! +! iovr - cloud overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (used for isubclw>0 only) ! @@ -773,7 +773,7 @@ subroutine rrtmg_lw_run & endif stemp = sfgtmp(iplon) ! surface ground temp - if (iovrlw == 3) delgth= de_lgth(iplon) ! clouds decorr-length + if (iovr == 3) delgth= de_lgth(iplon) ! clouds decorr-length !> -# Prepare atmospheric profile for use in rrtm. ! the vertical index of internal array is from surface to top @@ -797,7 +797,7 @@ subroutine rrtmg_lw_run & tavel(k)= tlyr(iplon,k1) tz(k) = tlvl(iplon,k1) dz(k) = dzlyr(iplon,k1) - if (iovrlw == 4 .or. iovrlw == 5) alph(k) = alpha(iplon,k) ! alpha decorrelation + if (iovr == 4 .or. iovr == 5) alph(k) = alpha(iplon,k) ! alpha decorrelation !> -# Set absorber amount for h2o, co2, and o3. @@ -910,7 +910,7 @@ subroutine rrtmg_lw_run & tavel(k)= tlyr(iplon,k) tz(k) = tlvl(iplon,k+1) dz(k) = dzlyr(iplon,k) - if (iovrlw == 4 .or. iovrlw == 5) alph(k) = alpha(iplon,k) ! alpha decorrelation + if (iovr == 4 .or. iovr == 5) alph(k) = alpha(iplon,k) ! alpha decorrelation ! --- ... set absorber amount !test use @@ -1168,7 +1168,7 @@ subroutine rrtmg_lw_run & if (isubclw <= 0) then - if (iovrlw <= 0) then + if (iovr <= 0) then call rtrn & ! --- inputs: @@ -1188,7 +1188,7 @@ subroutine rrtmg_lw_run & & totuflux,totdflux,htr, totuclfl,totdclfl,htrcl, htrb & & ) - endif ! end if_iovrlw_block + endif ! end if_iovr_block else @@ -1339,7 +1339,7 @@ subroutine rlwinit & ! icldflg - cloud scheme control flag ! ! =0: diagnostic scheme gives cloud tau, omiga, and g. ! ! =1: prognostic scheme gives cloud liq/ice path, etc. ! -! iovrlw - clouds vertical overlapping control flag ! +! iovr - clouds vertical overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud (isubcol>0 only) ! @@ -1387,19 +1387,19 @@ subroutine rlwinit & ! !===> ... begin here ! - if ( iovrlw<0 .or. iovrlw>5 ) then + if ( iovr<0 .or. iovr>5 ) then print *,' *** Error in specification of cloud overlap flag', & - & ' IOVRLW=',iovrlw,' in RLWINIT !!' + & ' IOVR=',iovr,' in RLWINIT !!' stop - elseif ( iovrlw>=2 .and. isubclw==0 ) then + elseif ( iovr>=2 .and. isubclw==0 ) then if (me == 0) then - print *,' *** IOVRLW=',iovrlw,' is not available for', & + print *,' *** IOVR=',iovr,' is not available for', & & ' ISUBCLW=0 setting!!' print *,' The program uses maximum/random overlap', & & ' instead.' endif - iovrlw = 1 + iovr = 1 endif if (me == 0) then @@ -1874,7 +1874,7 @@ subroutine mcica_subcol & ! lcloudy - logical, sub-colum cloud profile flag array ngptlw*nlay! ! ! ! other control flags from module variables: ! -! iovrlw : control flag for cloud overlapping method ! +! iovr : control flag for cloud overlapping method ! ! =0:random; =1:maximum/random: =2:maximum; =3:decorr ! ! ! ! ===================== end of definitions ==================== ! @@ -1916,7 +1916,7 @@ subroutine mcica_subcol & !! - For max-random overlap, pick a random value at every level !! - For maximum overlap, pick same random numebr at every level - select case ( iovrlw ) + select case ( iovr ) case( 0 ) ! random overlap, pick a random value at every level diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 3b975313b..abdc6e281 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -305,7 +305,7 @@ module rrtmg_sw ! use physparam, only : iswrate, iswrgas, iswcliq, iswcice, & - & isubcsw, icldflg, iovrsw, ivflip, & + & isubcsw, icldflg, iovr, ivflip, & & iswmode, kind_phys use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 @@ -627,7 +627,7 @@ subroutine rrtmg_sw_run & ! =0: no sub-col cld treatment, use grid-mean cld quantities ! ! =1: mcica sub-col, prescribed seeds to get random numbers ! ! =2: mcica sub-col, providing array icseed for random numbers! -! iovrsw - cloud overlapping control flag ! +! iovr - cloud overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! @@ -888,7 +888,7 @@ subroutine rrtmg_sw_run & cosz1 = cosz(j1) sntz1 = f_one / cosz(j1) ssolar = s0fac * cosz(j1) - if (iovrsw == 3) delgth = de_lgth(j1) ! clouds decorr-length + if (iovr == 3) delgth = de_lgth(j1) ! clouds decorr-length !> -# Prepare surface albedo: bm,df - dir,dif; 1,2 - nir,uvv. albbm(1) = sfcalb_nir_dir(j1) @@ -910,7 +910,7 @@ subroutine rrtmg_sw_run & tavel(k) = tlyr(j1,kk) delp (k) = delpin(j1,kk) dz (k) = dzlyr (j1,kk) - if (iovrsw == 4 .or. iovrsw == 5) alph(k) = alpha(j1,k) ! alpha decorrelation + if (iovr == 4 .or. iovr == 5) alph(k) = alpha(j1,k) ! alpha decorrelation !> -# Set absorber and gas column amount, convert from volume mixing !! ratio to molec/cm2 based on coldry (scaled to 1.0e-20) @@ -1001,7 +1001,7 @@ subroutine rrtmg_sw_run & tavel(k) = tlyr(j1,k) delp (k) = delpin(j1,k) dz (k) = dzlyr (j1,k) - if (iovrsw == 4 .or. iovrsw == 5) alph(k) = alpha(j1,k) ! alpha decorrelation + if (iovr == 4 .or. iovr == 5) alph(k) = alpha(j1,k) ! alpha decorrelation ! --- ... set absorber amount !test use @@ -1092,11 +1092,11 @@ subroutine rrtmg_sw_run & zcf0 = f_one zcf1 = f_one - if (iovrsw == 0) then ! random overlapping + if (iovr == 0) then ! random overlapping do k = 1, nlay zcf0 = zcf0 * (f_one - cfrac(k)) enddo - else if (iovrsw == 1) then ! max/ran overlapping + else if (iovr == 1) then ! max/ran overlapping do k = 1, nlay if (cfrac(k) > ftiny) then ! cloudy layer zcf1 = min ( zcf1, f_one-cfrac(k) ) @@ -1106,7 +1106,7 @@ subroutine rrtmg_sw_run & endif enddo zcf0 = zcf0 * zcf1 - else if (iovrsw >= 2) then + else if (iovr >= 2) then do k = 1, nlay zcf0 = min ( zcf0, f_one-cfrac(k) ) ! used only as clear/cloudy indicator enddo @@ -1417,7 +1417,7 @@ subroutine rswinit & ! icldflg - cloud scheme control flag ! ! =0: diagnostic scheme gives cloud tau, omiga, and g. ! ! =1: prognostic scheme gives cloud liq/ice path, etc. ! -! iovrsw - clouds vertical overlapping control flag ! +! iovr - clouds vertical overlapping control flag ! ! =0: random overlapping clouds ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! @@ -1453,9 +1453,9 @@ subroutine rswinit & ! !===> ... begin here ! - if ( iovrsw<0 .or. iovrsw>5 ) then + if ( iovr<0 .or. iovr>5 ) then print *,' *** Error in specification of cloud overlap flag', & - & ' IOVRSW=',iovrsw,' in RSWINIT !!' + & ' IOVR=',iovr,' in RSWINIT !!' stop endif @@ -1502,15 +1502,15 @@ subroutine rswinit & stop endif - if ( isubcsw==0 .and. iovrsw>2 ) then + if ( isubcsw==0 .and. iovr>2 ) then if (me == 0) then - print *,' *** IOVRSW=',iovrsw,' is not available for', & + print *,' *** IOVR=',iovr,' is not available for', & & ' ISUBCSW=0 setting!!' print *,' The program will use maximum/random overlap', & & ' instead.' endif - iovrsw = 1 + iovr = 1 endif !> -# Setup constant factors for heating rate @@ -1994,7 +1994,7 @@ subroutine mcica_subcol & ! lcloudy - logical, sub-colum cloud profile flag array nlay*ngptsw! ! ! ! other control flags from module variables: ! -! iovrsw : control flag for cloud overlapping method ! +! iovr : control flag for cloud overlapping method ! ! =0: random ! ! =1: maximum/random overlapping clouds ! ! =2: maximum overlap cloud ! @@ -2038,7 +2038,7 @@ subroutine mcica_subcol & !> -# Sub-column set up according to overlapping assumption. - select case ( iovrsw ) + select case ( iovr ) case( 0 ) ! random overlap, pick a random value at every level diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 7ab3c27e3..e1b8fec33 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -3,7 +3,6 @@ module rrtmgp_sw_cloud_optics use mo_rte_kind, only: wl use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_cloud_optics, only: ty_cloud_optics - use physparam, only: isubcsw, iovrsw use mo_optical_props, only: ty_optical_props_2str use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_aux, only: check_error_msg From b145f63e1061626fd4674b50c6f350253522d083 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 28 Oct 2020 23:20:57 +0000 Subject: [PATCH 094/274] Remove distinct lw/sw cloud-overlap options in RRTMGP. --- physics/GFS_cloud_diagnostics.F90 | 10 +-- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 12 ++- physics/GFS_rrtmgp_setup.F90 | 25 +++---- physics/GFS_rrtmgp_setup.meta | 14 +--- physics/GFS_rrtmgp_sw_pre.F90 | 104 +++++++++++++------------- physics/GFS_rrtmgp_sw_pre.meta | 11 +-- physics/rrtmg_lw_cloud_optics.F90 | 2 +- physics/rrtmg_sw_cloud_optics.F90 | 2 +- physics/rrtmgp_lw_cloud_sampling.F90 | 19 ++--- physics/rrtmgp_lw_cloud_sampling.meta | 8 ++ physics/rrtmgp_sw_cloud_sampling.F90 | 87 +++++++++++---------- physics/rrtmgp_sw_cloud_sampling.meta | 8 ++ physics/rrtmgp_sw_gas_optics.F90 | 2 + 13 files changed, 147 insertions(+), 157 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index c62cc685d..05a18f15f 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -5,7 +5,7 @@ ! ######################################################################################## module GFS_cloud_diagnostics use machine, only: kind_phys - use physparam, only: iovrlw, iovrsw, ivflip, icldflg, idcor + use physparam, only: iovr, ivflip, icldflg, idcor ! Module parameters (imported directly from radiation_cloud.f) integer, parameter :: & @@ -23,7 +23,6 @@ module GFS_cloud_diagnostics ! Module variables integer :: & - iovr = 1, & ! Cloud overlap used for diagnostic HML cloud outputs llyr = 2 ! Upper limit of boundary layer clouds public GFS_cloud_diagnostics_run, GFS_cloud_diagnostics_init,& @@ -145,11 +144,8 @@ subroutine hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, ! Local variables integer :: iLay, kl - ! Initialize error flag - errflg = 0 - - ! Cloud overlap used for diagnostic HML cloud outputs - iovr = max(iovrsw,iovrlw) + ! Initialize error flag + errflg = 0 if (mpi_rank == 0) print *, VTAGCLD !print out version tag diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index b67b22d41..c868de6e3 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -4,9 +4,9 @@ ! ######################################################################################## module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys - use physparam, only: lcnorm, lcrick, idcor, iovrlw, iovrsw + use physparam, only: lcnorm, lcrick, idcor, iovr use rrtmgp_aux, only: check_error_msg - use module_radiation_clouds, only: get_alpha_exp, get_alpha_dcorr + !use module_radiation_clouds, only: get_alpha_exp, get_alpha_dcorr ! Parameters real(kind_phys), parameter :: & reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) @@ -101,7 +101,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! Local variables real(kind_phys) :: tem1 real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate - integer :: iCol,iLay,l,ncndl,iovr + integer :: iCol,iLay,l,ncndl real(kind_phys), dimension(nCol,nLev) :: deltaP if (.not. (lsswr .or. lslwr)) return @@ -200,8 +200,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! #################################################################################### ! Cloud (and precipitation) overlap ! #################################################################################### - - iovr = max(iovrsw,iovrlw) ! Compute layer-thickness do iCol=1,nCol @@ -214,10 +212,10 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! Cloud overlap parameter ! if (iovr == 3) then - call get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, de_lgth, cloud_overlap_param) +! call get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, de_lgth, cloud_overlap_param) endif if (iovr == 4 .or. iovr == 5) then - call get_alpha_exp(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cld_frac, cloud_overlap_param) +! call get_alpha_exp(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cld_frac, cloud_overlap_param) endif ! diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 9b503e3bc..8f7b44e00 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -4,7 +4,7 @@ module GFS_rrtmgp_setup use physparam, only : & isolar, ictmflg, ico2flg, ioznflg, iaerflg, iaermdl, icldflg, & - iovrsw, iovrlw, lcrick, lcnorm, lnoprec, ialbflg, iemsflg, & + lcrick, lcnorm, lnoprec, ialbflg, iemsflg, & isubcsw, isubclw, ivflip , ipsd0, iswcliq use machine, only: & kind_phys ! Working type @@ -40,7 +40,7 @@ module GFS_rrtmgp_setup subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl,& imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & - ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & + ialb, iems, ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & icliq_sw, crick_proof, ccnorm, norad_precip, idate, iflip, me, errmsg, errflg) implicit none @@ -57,7 +57,7 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics real(kind_phys), dimension(levr+1), intent(in) :: & si integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & - ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & + ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & icliq_sw, iflip, me logical, intent(in) :: & crick_proof, ccnorm, norad_precip @@ -78,8 +78,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics ico2flg = ico2 ! co2 data source control flag ioznflg = ntoz ! ozone data source control flag iswcliq = icliq_sw ! optical property for liquid clouds for sw - iovrsw = iovr_sw ! cloud overlapping control flag for sw - iovrlw = iovr_lw ! cloud overlapping control flag for lw lcrick = crick_proof ! control flag for eliminating CRICK lcnorm = ccnorm ! control flag for in-cld condensate lnoprec = norad_precip ! precip effect on radiation flag (ferrier microphysics) @@ -117,8 +115,8 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics print *,' si =',si print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw - print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr_sw=',iovr_sw, & - ' iovr_lw=',iovr_lw,' isubc_sw=',isubc_sw, & + print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr=',iovr, & + ' isubc_sw=',isubc_sw, & ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & ' iflip=',iflip,' me=',me print *,' crick_proof=',crick_proof, & @@ -128,7 +126,7 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics call radinit( si, levr, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, me, errflg ) + imp_physics_zhao_carr_pdf, imp_physics_mg, iovr, me, errflg ) if ( me == 0 ) then print *,' Radiation sub-cloud initial seed =',ipsd0, & @@ -206,7 +204,7 @@ end subroutine GFS_rrtmgp_setup_finalize subroutine radinit(si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, me, errflg ) + imp_physics_zhao_carr_pdf, imp_physics_mg, iovr, me, errflg ) !................................... ! --- inputs: @@ -291,10 +289,6 @@ subroutine radinit(si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfd ! =8 Thompson microphysics scheme ! ! =6 WSM6 microphysics scheme ! ! =10 MG microphysics scheme ! -! iovrsw : control flag for cloud overlap in sw radiation ! -! iovrlw : control flag for cloud overlap in lw radiation ! -! =0: random overlapping clouds ! -! =1: max/ran overlapping clouds ! ! isubcsw : sub-column cloud approx control flag in sw radiation ! ! isubclw : sub-column cloud approx control flag in lw radiation ! ! =0: with out sub-column cloud approximation ! @@ -331,6 +325,7 @@ subroutine radinit(si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfd ! --- inputs: integer, intent(in) :: & + iovr, & ! imp_physics, & ! Flag for MP scheme imp_physics_fer_hires, & ! Flag for fer-hires scheme imp_physics_gfdl, & ! Flag for gfdl scheme @@ -377,10 +372,8 @@ subroutine radinit(si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfd & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg - print *,' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw, & + print *,' IVFLIP=',ivflip,' IOVR=',iovr, & & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw -! write(0,*)' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw,& -! & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw print *,' LCRICK=',lcrick,' LCNORM=',lcnorm,' LNOPREC=',lnoprec if ( ictmflg==0 .or. ictmflg==-2 ) then diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 45e9d65a2..258c28c96 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -160,17 +160,9 @@ type = integer intent = in optional = F -[iovr_sw] - standard_name = flag_for_cloud_overlap_method_for_shortwave_radiation - long_name = sw: max-random overlap clouds - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_lw] - standard_name = flag_for_cloud_overlap_method_for_longwave_radiation - long_name = lw: max-random overlap clouds +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = max-random overlap clouds units = flag dimensions = () type = integer diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index f6aac60b1..09f830043 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -28,11 +28,11 @@ end subroutine GFS_rrtmgp_sw_pre_init !! \htmlinclude GFS_rrtmgp_sw_pre.html !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & - lndp_prt_list, lsswr, solhr, & + lndp_prt_list, doSWrad, solhr, & lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay, & relhum, p_lev, sw_gas_props, & - nday, idxday, alb1d, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & + nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) ! Inputs @@ -47,7 +47,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ real(kind_phys), dimension(n_var_lndp), intent(in) :: & lndp_prt_list logical,intent(in) :: & - lsswr ! Call RRTMGP SW radiation? + doSWrad ! Call RRTMGP SW radiation? real(kind_phys), intent(in) :: & solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(nCol), intent(in) :: & @@ -86,7 +86,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ integer, dimension(ncol), intent(out) :: & idxday ! Indices for daylit points real(kind_phys), dimension(ncol), intent(out) :: & - alb1d, & ! Surface albedo pertubation coszen, & ! Cosine of SZA coszdg, & ! Cosine of SZA, daytime sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo @@ -103,65 +102,62 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ ! Local variables integer :: i, j, iCol, iBand, iLay real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb + real(kind_phys), dimension(ncol) :: alb1d real(kind_phys) :: lndp_alb ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - if (.not. lsswr) return - - ! ####################################################################################### - ! Compute cosine of zenith angle (only when SW is called) - ! ####################################################################################### - call coszmn (lon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) - ! ####################################################################################### - ! For SW gather daylit points - ! ####################################################################################### - nday = 0 - idxday = 0 - do i = 1, NCOL - if (coszen(i) >= 0.0001) then - nday = nday + 1 - idxday(nday) = i - endif - enddo + if (doSWrad) then - ! ####################################################################################### - ! mg, sfc-perts - ! --- scale random patterns for surface perturbations with perturbation size - ! --- turn vegetation fraction pattern into percentile pattern - ! ####################################################################################### - alb1d(:) = 0. - lndp_alb = -999. - if (lndp_type ==1) then - do k =1,n_var_lndp - if (lndp_var_list(k) == 'alb') then - do i=1,ncol - call cdfnor(sfc_wts(i,k),alb1d(i)) - lndp_alb = lndp_prt_list(k) - enddo - endif - enddo - endif - - ! ####################################################################################### - ! Call module_radiation_surface::setalb() to setup surface albedo. - ! ####################################################################################### - call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, pertalb, sfcalb) + ! #################################################################################### + ! Compute cosine of zenith angle (only when SW is called) + ! #################################################################################### + call coszmn (lon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) + + ! #################################################################################### + ! For SW gather daylit points + ! #################################################################################### + nday = 0 + idxday = 0 + do i = 1, NCOL + if (coszen(i) >= 0.0001) then + nday = nday + 1 + idxday(nday) = i + endif + enddo + + ! #################################################################################### + ! Call module_radiation_surface::setalb() to setup surface albedo. + ! #################################################################################### + alb1d(:) = 0. + lndp_alb = -999. + call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime, alvsf, & + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, lndp_alb, sfcalb) - ! Approximate mean surface albedo from vis- and nir- diffuse values. - sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + ! Approximate mean surface albedo from vis- and nir- diffuse values. + sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - ! Spread across all SW bands - do iBand=1,sw_gas_props%get_nband() - sfc_alb_nir_dir(iBand,1:NCOL) = sfcalb(1:NCOL,1) - sfc_alb_nir_dif(iBand,1:NCOL) = sfcalb(1:NCOL,2) - sfc_alb_uvvis_dir(iBand,1:NCOL) = sfcalb(1:NCOL,3) - sfc_alb_uvvis_dif(iBand,1:NCOL) = sfcalb(1:NCOL,4) - enddo + ! Spread across all SW bands + do iBand=1,sw_gas_props%get_nband() + sfc_alb_nir_dir(iBand,1:NCOL) = sfcalb(1:NCOL,1) + sfc_alb_nir_dif(iBand,1:NCOL) = sfcalb(1:NCOL,2) + sfc_alb_uvvis_dir(iBand,1:NCOL) = sfcalb(1:NCOL,3) + sfc_alb_uvvis_dif(iBand,1:NCOL) = sfcalb(1:NCOL,4) + enddo + else + nday = 0 + idxday = 0 + coszen(1:nCol) = 0. + coszdg(1:nCol) = 0. + sfc_alb_nir_dir(:,1:nCol) = 0. + sfc_alb_nir_dif(:,1:nCol) = 0. + sfc_alb_uvvis_dir(:,1:nCol) = 0. + sfc_alb_uvvis_dif(:,1:nCol) = 0. + sfc_alb_dif(1:nCol) = 0. + endif + end subroutine GFS_rrtmgp_sw_pre_run diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 91e875c00..b24ab5710 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -65,7 +65,7 @@ kind = len=3 intent = in optional = F -[lsswr] +[doSWrad] standard_name = flag_to_calc_sw long_name = logical flags for sw radiation calls units = flag @@ -297,15 +297,6 @@ type = ty_gas_optics_rrtmgp intent = in optional = F -[alb1d] - standard_name = surface_albedo_perturbation - long_name = surface albedo perturbation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [sfc_alb_nir_dir] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 index ea0a703c7..ad4d06e5f 100644 --- a/physics/rrtmg_lw_cloud_optics.F90 +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -1,6 +1,6 @@ module mo_rrtmg_lw_cloud_optics use machine, only: kind_phys - use physparam, only: ilwcliq, ilwcice, iovrlw + use physparam, only: ilwcliq, ilwcice use mersenne_twister, only: random_setseed, random_number, random_stat implicit none diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/rrtmg_sw_cloud_optics.F90 index 37b4e094c..452ab2070 100644 --- a/physics/rrtmg_sw_cloud_optics.F90 +++ b/physics/rrtmg_sw_cloud_optics.F90 @@ -1,6 +1,6 @@ module mo_rrtmg_sw_cloud_optics use machine, only: kind_phys - use physparam, only: iswcliq, iswcice, iovrsw + use physparam, only: iswcliq, iswcice use mersenne_twister, only: random_setseed, random_number, random_stat implicit none diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 35ae3c4a8..3c3e09622 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -1,7 +1,7 @@ module rrtmgp_lw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use physparam, only: isubclw, iovrlw + use physparam, only: isubclw use mo_optical_props, only: ty_optical_props_1scl use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat @@ -45,7 +45,7 @@ end subroutine rrtmgp_lw_cloud_sampling_init !! \section arg_table_rrtmgp_lw_cloud_sampling_run !! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! - subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, & + subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr, & cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) @@ -56,6 +56,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical layers + iovr, & ! Choice of cloud-overlap method ipsdlw0 ! Initial permutation seed for McICA integer,intent(in),dimension(ncol) :: & icseed_lw ! auxiliary special cloud related array when module @@ -96,7 +97,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, errflg = 0 ! - if (iovrlw .ne. 1 .and. iovrlw .ne. 3 .and. iovrlw .ne. 4 .and. iovrlw .ne. 5) then + if (iovr .ne. 1 .and. iovr .ne. 3 .and. iovr .ne. 4 .and. iovr .ne. 5) then errmsg = 'Cloud overlap assumption not supported.' errflg = 1 call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) @@ -134,11 +135,11 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Cloud-overlap. ! Maximum-random - if (iovrlw == 1) then + if (iovr == 1) then call sampled_mask(rng3D, cld_frac, cldfracMCICA) endif ! Exponential decorrelation length overlap - if (iovrlw == 3) then + if (iovr == 3) then ! Generate second RNG do iCol=1,ncol call random_setseed(ipseed_lw(icol),rng_stat) @@ -150,7 +151,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, randoms2 = rng3D2) endif ! Exponential or Exponential-random - if (iovrlw == 4 .or. iovrlw == 5) then + if (iovr == 4 .or. iovr == 5) then call sampled_mask(rng3D, cld_frac, cldfracMCICA, & overlap_param = cloud_overlap_param(:,1:nLev-1)) endif @@ -191,11 +192,11 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Precipitation overlap. ! Maximum-random - if (iovrlw == 1) then + if (iovr == 1) then call sampled_mask(rng3D, precip_frac, precipfracSAMP) endif ! Exponential decorrelation length overlap - if (iovrlw == 3) then + if (iovr == 3) then ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Generate second RNG !do iCol=1,ncol @@ -208,7 +209,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, randoms2 = rng3D2) endif ! Exponential or Exponential-random - if (iovrlw == 4 .or. iovrlw == 5) then + if (iovr == 4 .or. iovr == 5) then call sampled_mask(rng3D, precip_frac, precipfracSAMP, & overlap_param = precip_overlap_param(:,1:nLev-1)) endif diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 35699efb6..4aeee9f07 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -77,6 +77,14 @@ type = integer intent = in optional = F +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F [icseed_lw] standard_name = seed_random_numbers_lw long_name = seed for random number generation for longwave radiation diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 802cad840..bd2ad05af 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -1,7 +1,7 @@ module rrtmgp_sw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use physparam, only: isubcsw, iovrsw + use physparam, only: isubcsw use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat @@ -44,7 +44,7 @@ end subroutine rrtmgp_sw_cloud_sampling_init !! \section arg_table_rrtmgp_sw_cloud_sampling_run !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! - subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & + subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, iovr, & icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) @@ -56,6 +56,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd nCol, & ! Number of horizontal gridpoints nDay, & ! Number of daylit points. nLev, & ! Number of vertical layers + iovr, & ! Choice of cloud-overlap method ipsdsw0 ! Initial permutation seed for McICA integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. @@ -99,7 +100,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd errflg = 0 ! Only works w/ SDFs v15p2 and v16beta - if (iovrsw .ne. 1 .and. iovrsw .ne. 3 .and. iovrsw .ne. 4 .and. iovrsw .ne. 5) then + if (iovr .ne. 1 .and. iovr .ne. 3 .and. iovr .ne. 4 .and. iovr .ne. 5) then errmsg = 'Cloud overlap assumption not supported.' errflg = 1 call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) @@ -115,6 +116,9 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sw_optical_props_clouds%alloc_2str(nday, nLev, sw_gas_props)) + sw_optical_props_clouds%tau(:,:,:) = 0._kind_phys + sw_optical_props_clouds%ssa(:,:,:) = 1._kind_phys + sw_optical_props_clouds%g(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). if(isubcsw == 1) then ! advance prescribed permutation seed @@ -137,11 +141,11 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Cloud overlap. ! Maximum-random overlap - if (iovrsw == 1) then + if (iovr == 1) then call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA) endif ! Decorrelation-length overlap - if (iovrsw == 3) then + if (iovr == 3) then do iday=1,nday call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) @@ -152,7 +156,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd randoms2 = rng3D2) endif ! Exponential overlap - if (iovrsw == 4 .or. iovrsw == 5) then + if (iovr == 4 .or. iovr == 5) then call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA, & overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1)) endif @@ -193,11 +197,11 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Precipitation overlap ! Maximum-random - if (iovrsw == 1) then + if (iovr == 1) then call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:), precipfracSAMP) endif ! Exponential decorrelation length overlap - if (iovrsw == 3) then + if (iovr == 3) then !! Generate second RNG !do iday=1,nday ! call random_setseed(ipseed_sw(iday),rng_stat) @@ -208,7 +212,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1),& randoms2 = rng3D2) endif - if (iovrsw == 4 .or. iovrsw == 5) then + if (iovr == 4 .or. iovr == 5) then call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:),precipfracSAMP, & overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1)) endif @@ -218,42 +222,43 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd draw_samples(precipfracSAMP, & sw_optical_props_precipByBand, & sw_optical_props_precip)) - endif - ! #################################################################################### - ! Just add precipitation optics to cloud-optics - ! #################################################################################### - do iGpt=1,sw_gas_props%get_ngpt() - do iday=1,nDay - do iLay=1,nLev - tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) + & - sw_optical_props_precip%tau(iday,iLay,iGpt) - if (sw_optical_props_precip%tau(iday,iLay,iGpt) > 0) then - ssaloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & - sw_optical_props_clouds%ssa(iday,iLay,iGpt) + & - sw_optical_props_precip%tau(iday,iLay,iGpt) * & - sw_optical_props_precip%ssa(iday,iLay,iGpt)) / & - tauloc - if (ssaloc > 0) then - asyloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & - sw_optical_props_clouds%ssa(iday,iLay,iGpt) * & - sw_optical_props_clouds%g(iday,iLay,iGpt) + & - sw_optical_props_precip%tau(iday,iLay,iGpt) * & - sw_optical_props_precip%ssa(iday,iLay,iGpt) * & - sw_optical_props_precip%g(iday,iLay,iGpt)) / & - (tauloc*ssaloc) - else - tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) - ssaloc = sw_optical_props_clouds%ssa(iday,iLay,iGpt) - asyloc = sw_optical_props_clouds%g(iday,iLay,iGpt) + ! ################################################################################# + ! Just add precipitation optics to cloud-optics + ! ################################################################################# + do iGpt=1,sw_gas_props%get_ngpt() + do iday=1,nDay + do iLay=1,nLev + tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) + if (sw_optical_props_precip%tau(iday,iLay,iGpt) > 0) then + ssaloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) * & + sw_optical_props_precip%ssa(iday,iLay,iGpt)) / & + tauloc + if (ssaloc > 0) then + asyloc = (sw_optical_props_clouds%tau(iday,iLay,iGpt) * & + sw_optical_props_clouds%ssa(iday,iLay,iGpt) * & + sw_optical_props_clouds%g(iday,iLay,iGpt) + & + sw_optical_props_precip%tau(iday,iLay,iGpt) * & + sw_optical_props_precip%ssa(iday,iLay,iGpt) * & + sw_optical_props_precip%g(iday,iLay,iGpt)) / & + (tauloc*ssaloc) + else + tauloc = sw_optical_props_clouds%tau(iday,iLay,iGpt) + ssaloc = sw_optical_props_clouds%ssa(iday,iLay,iGpt) + asyloc = sw_optical_props_clouds%g(iday,iLay,iGpt) + endif + sw_optical_props_clouds%tau(iday,iLay,iGpt) = tauloc + sw_optical_props_clouds%ssa(iday,iLay,iGpt) = ssaloc + sw_optical_props_clouds%g(iday,iLay,iGpt) = asyloc endif - sw_optical_props_clouds%tau(iday,iLay,iGpt) = tauloc - sw_optical_props_clouds%ssa(iday,iLay,iGpt) = ssaloc - sw_optical_props_clouds%g(iday,iLay,iGpt) = asyloc - endif + enddo enddo enddo - enddo + endif + end subroutine rrtmgp_sw_cloud_sampling_run ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 082704462..acbb2a960 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -93,6 +93,14 @@ type = integer intent = in optional = F +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F [icseed_sw] standard_name = seed_random_numbers_sw long_name = seed for random number generation for shortwave radiation diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index efe611e0c..ac643e71d 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -374,6 +374,8 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_pr toa_src_sw(idxday(ij),:) = toa_src_sw(idxday(ij),:)*solcon/ & sum(toa_src_sw(idxday(ij),:)) enddo + else + toa_src_sw(:,:) = 0. endif end subroutine rrtmgp_sw_gas_optics_run From ae2472f9639b7e222120809784793ec14e37cb9a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 29 Oct 2020 18:22:13 +0000 Subject: [PATCH 095/274] New cloud-overlap assumptions in RRTMGP. Replaced magic numbers with parameters. --- physics/GFS_cloud_diagnostics.F90 | 407 +------------------------- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 159 +++++++--- physics/GFS_rrtmgp_gfdlmp_pre.meta | 75 ++++- physics/rrtmgp_lw_cloud_sampling.F90 | 27 +- physics/rrtmgp_lw_cloud_sampling.meta | 48 +++ physics/rrtmgp_sw_cloud_sampling.F90 | 31 +- physics/rrtmgp_sw_cloud_sampling.meta | 48 +++ 7 files changed, 316 insertions(+), 479 deletions(-) diff --git a/physics/GFS_cloud_diagnostics.F90 b/physics/GFS_cloud_diagnostics.F90 index 05a18f15f..1a7258b10 100644 --- a/physics/GFS_cloud_diagnostics.F90 +++ b/physics/GFS_cloud_diagnostics.F90 @@ -5,8 +5,9 @@ ! ######################################################################################## module GFS_cloud_diagnostics use machine, only: kind_phys - use physparam, only: iovr, ivflip, icldflg, idcor - + use physparam, only: icldflg + use module_radiation_clouds, only: gethml + ! Module parameters (imported directly from radiation_cloud.f) integer, parameter :: & NF_CLDS = 9, & ! Number of fields in cloud array @@ -187,406 +188,4 @@ subroutine hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, return end subroutine hml_cloud_diagnostics_initialize - - ! ######################################################################################### - ! ######################################################################################### - subroutine gethml(plyr, ptop1, cldtot, cldcnv, dz, de_lgth, alpha, IX, NLAY, clds, mtop, mbot) - ! =================================================================== ! - ! ! - ! abstract: compute high, mid, low, total, and boundary cloud fractions ! - ! and cloud top/bottom layer indices for model diagnostic output. ! - ! the three cloud domain boundaries are defined by ptopc. the cloud ! - ! overlapping method is defined by control flag 'iovr', which is also ! - ! used by lw and sw radiation programs. ! - ! ! - ! usage: call gethml ! - ! ! - ! subprograms called: none ! - ! ! - ! attributes: ! - ! language: fortran 90 ! - ! machine: ibm-sp, sgi ! - ! ! - ! ! - ! ==================== definition of variables ==================== ! - ! ! - ! input variables: ! - ! plyr (IX,NLAY) : model layer mean pressure in mb (100Pa) ! - ! ptop1 (IX,4) : pressure limits of cloud domain interfaces ! - ! (sfc,low,mid,high) in mb (100Pa) ! - ! cldtot(IX,NLAY) : total or straiform cloud profile in fraction ! - ! cldcnv(IX,NLAY) : convective cloud (for diagnostic scheme only) ! - ! dz (ix,nlay) : layer thickness (km) ! - ! de_lgth(ix) : clouds vertical de-correlation length (km) ! - ! alpha(ix,nlay) : alpha decorrelation parameter ! - ! IX : horizontal dimention ! - ! NLAY : vertical layer dimensions ! - ! ! - ! output variables: ! - ! clds (IX,5) : fraction of clouds for low, mid, hi, tot, bl ! - ! mtop (IX,3) : vertical indices for low, mid, hi cloud tops ! - ! mbot (IX,3) : vertical indices for low, mid, hi cloud bases ! - ! ! - ! external module variables: (in physparam) ! - ! ivflip : control flag of vertical index direction ! - ! =0: index from toa to surface ! - ! =1: index from surface to toa ! - ! ! - ! internal module variables: ! - ! iovr : control flag for cloud overlap ! - ! =0 random overlapping clouds ! - ! =1 max/ran overlapping clouds ! - ! =2 maximum overlapping ( for mcica only ) ! - ! =3 decorr-length ovlp ( for mcica only ) ! - ! =4 exponential cloud overlap (AER; mcica only) ! - ! =5 exponential-random overlap (AER; mcica only) ! - ! ! - ! ==================== end of description ===================== ! - ! - implicit none! - - ! --- inputs: - integer, intent(in) :: IX, NLAY - - real (kind=kind_phys), dimension(:,:), intent(in) :: plyr, ptop1, & - cldtot, cldcnv, dz - real (kind=kind_phys), dimension(:), intent(in) :: de_lgth - real (kind=kind_phys), dimension(:,:), intent(in) :: alpha - - ! --- outputs - real (kind=kind_phys), dimension(:,:), intent(out) :: clds - - integer, dimension(:,:), intent(out) :: mtop, mbot - - ! --- local variables: - real (kind=kind_phys) :: cl1(IX), cl2(IX), dz1(ix) - real (kind=kind_phys) :: pcur, pnxt, ccur, cnxt, alfa - - integer, dimension(IX):: idom, kbt1, kth1, kbt2, kth2 - integer :: i, k, id, id1, kstr, kend, kinc - - ! - !===> ... begin here - ! - clds(:,:) = 0.0 - - do i = 1, IX - cl1(i) = 1.0 - cl2(i) = 1.0 - enddo - - ! --- total and bl clouds, where cl1, cl2 are fractions of clear-sky view - ! layer processed from surface and up - - !> - Calculate total and BL cloud fractions (maximum-random cloud - !! overlapping is operational). - - if ( ivflip == 0 ) then ! input data from toa to sfc - kstr = NLAY - kend = 1 - kinc = -1 - else ! input data from sfc to toa - kstr = 1 - kend = NLAY - kinc = 1 - endif ! end_if_ivflip - - if ( iovr == 0 ) then ! random overlap - - do k = kstr, kend, kinc - do i = 1, IX - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) cl1(i) = cl1(i) * (1.0 - ccur) - enddo - - if (k == llyr) then - do i = 1, IX - clds(i,5) = 1.0 - cl1(i) ! save bl cloud - enddo - endif - enddo - - do i = 1, IX - clds(i,4) = 1.0 - cl1(i) ! save total cloud - enddo - - elseif ( iovr == 1 ) then ! max/ran overlap - - do k = kstr, kend, kinc - do i = 1, IX - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) then ! cloudy layer - cl2(i) = min( cl2(i), (1.0 - ccur) ) - else ! clear layer - cl1(i) = cl1(i) * cl2(i) - cl2(i) = 1.0 - endif - enddo - - if (k == llyr) then - do i = 1, IX - clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud - enddo - endif - enddo - - do i = 1, IX - clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud - enddo - - elseif ( iovr == 2 ) then ! maximum overlap all levels - - cl1(:) = 0.0 - - do k = kstr, kend, kinc - do i = 1, IX - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) cl1(i) = max( cl1(i), ccur ) - enddo - - if (k == llyr) then - do i = 1, IX - clds(i,5) = cl1(i) ! save bl cloud - enddo - endif - enddo - - do i = 1, IX - clds(i,4) = cl1(i) ! save total cloud - enddo - - elseif ( iovr == 3 ) then ! random if clear-layer divided, - ! otherwise de-corrlength method - do i = 1, ix - dz1(i) = - dz(i,kstr) - enddo - - do k = kstr, kend, kinc - do i = 1, ix - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) then ! cloudy layer - alfa = exp( -0.5*((dz1(i)+dz(i,k)))/de_lgth(i) ) - dz1(i) = dz(i,k) - cl2(i) = alfa * min(cl2(i), (1.0 - ccur)) & ! maximum part - + (1.0 - alfa) * (cl2(i) * (1.0 - ccur)) ! random part - else ! clear layer - cl1(i) = cl1(i) * cl2(i) - cl2(i) = 1.0 - if (k /= kend) dz1(i) = -dz(i,k+kinc) - endif - enddo - - if (k == llyr) then - do i = 1, ix - clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud - enddo - endif - enddo - - do i = 1, ix - clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud - enddo - - elseif ( iovr == 4 .or. iovr == 5 ) then ! exponential overlap (iovr=4), or - ! exponential-random (iovr=5); - ! distinction defined by alpha - do k = kstr, kend, kinc - do i = 1, ix - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - if (ccur >= climit) then ! cloudy layer - cl2(i) = alpha(i,k) * min(cl2(i), (1.0 - ccur)) & ! maximum part - + (1.0 - alpha(i,k)) * (cl2(i) * (1.0 - ccur)) ! random part - else ! clear layer - cl1(i) = cl1(i) * cl2(i) - cl2(i) = 1.0 - endif - enddo - if (k == llyr) then - do i = 1, ix - clds(i,5) = 1.0 - cl1(i) * cl2(i) ! save bl cloud - enddo - endif - enddo - do i = 1, ix - clds(i,4) = 1.0 - cl1(i) * cl2(i) ! save total cloud - enddo - endif ! end_if_iovr - - ! --- high, mid, low clouds, where cl1, cl2 are cloud fractions - ! layer processed from one layer below llyr and up - ! --- change! layer processed from surface to top, so low clouds will - ! contains both bl and low clouds. - - !> - Calculte high, mid, low cloud fractions and vertical indices of - !! cloud tops/bases. - if ( ivflip == 0 ) then ! input data from toa to sfc - - do i = 1, IX - cl1 (i) = 0.0 - cl2 (i) = 0.0 - kbt1(i) = NLAY - kbt2(i) = NLAY - kth1(i) = 0 - kth2(i) = 0 - idom(i) = 1 - mbot(i,1) = NLAY - mtop(i,1) = NLAY - mbot(i,2) = NLAY - 1 - mtop(i,2) = NLAY - 1 - mbot(i,3) = NLAY - 1 - mtop(i,3) = NLAY - 1 - enddo - - !org do k = llyr-1, 1, -1 - do k = NLAY, 1, -1 - do i = 1, IX - id = idom(i) - id1= id + 1 - - pcur = plyr(i,k) - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - - if (k > 1) then - pnxt = plyr(i,k-1) - cnxt = min( ovcst, max( cldtot(i,k-1), cldcnv(i,k-1) )) - else - pnxt = -1.0 - cnxt = 0.0 - endif - - if (pcur < ptop1(i,id1)) then - id = id + 1 - id1= id1 + 1 - idom(i) = id - endif - - if (ccur >= climit) then - if (kth2(i) == 0) kbt2(i) = k - kth2(i) = kth2(i) + 1 - - if ( iovr == 0 ) then - cl2(i) = cl2(i) + ccur - cl2(i)*ccur - else - cl2(i) = max( cl2(i), ccur ) - endif - - if (cnxt < climit .or. pnxt < ptop1(i,id1)) then - kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i) ) & - / (cl1(i) + cl2(i)) ) - kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i) ) & - / (cl1(i) + cl2(i)) ) - cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) - - kbt2(i) = k - 1 - kth2(i) = 0 - cl2 (i) = 0.0 - endif ! end_if_cnxt_or_pnxt - endif ! end_if_ccur - - if (pnxt < ptop1(i,id1)) then - clds(i,id) = cl1(i) - mtop(i,id) = min( kbt1(i), kbt1(i)-kth1(i)+1 ) - mbot(i,id) = kbt1(i) - - cl1 (i) = 0.0 - kbt1(i) = k - 1 - kth1(i) = 0 - - if (id1 <= NK_CLDS) then - mbot(i,id1) = kbt1(i) - mtop(i,id1) = kbt1(i) - endif - endif ! end_if_pnxt - - enddo ! end_do_i_loop - enddo ! end_do_k_loop - - else ! input data from sfc to toa - - do i = 1, IX - cl1 (i) = 0.0 - cl2 (i) = 0.0 - kbt1(i) = 1 - kbt2(i) = 1 - kth1(i) = 0 - kth2(i) = 0 - idom(i) = 1 - mbot(i,1) = 1 - mtop(i,1) = 1 - mbot(i,2) = 2 - mtop(i,2) = 2 - mbot(i,3) = 2 - mtop(i,3) = 2 - enddo - - !org do k = llyr+1, NLAY - do k = 1, NLAY - do i = 1, IX - id = idom(i) - id1= id + 1 - - pcur = plyr(i,k) - ccur = min( ovcst, max( cldtot(i,k), cldcnv(i,k) )) - - if (k < NLAY) then - pnxt = plyr(i,k+1) - cnxt = min( ovcst, max( cldtot(i,k+1), cldcnv(i,k+1) )) - else - pnxt = -1.0 - cnxt = 0.0 - endif - - if (pcur < ptop1(i,id1)) then - id = id + 1 - id1= id1 + 1 - idom(i) = id - endif - - if (ccur >= climit) then - if (kth2(i) == 0) kbt2(i) = k - kth2(i) = kth2(i) + 1 - - if ( iovr == 0 ) then - cl2(i) = cl2(i) + ccur - cl2(i)*ccur - else - cl2(i) = max( cl2(i), ccur ) - endif - - if (cnxt < climit .or. pnxt < ptop1(i,id1)) then - kbt1(i) = nint( (cl1(i)*kbt1(i) + cl2(i)*kbt2(i)) & - / (cl1(i) + cl2(i)) ) - kth1(i) = nint( (cl1(i)*kth1(i) + cl2(i)*kth2(i)) & - / (cl1(i) + cl2(i)) ) - cl1 (i) = cl1(i) + cl2(i) - cl1(i)*cl2(i) - - kbt2(i) = k + 1 - kth2(i) = 0 - cl2 (i) = 0.0 - endif ! end_if_cnxt_or_pnxt - endif ! end_if_ccur - - if (pnxt < ptop1(i,id1)) then - clds(i,id) = cl1(i) - mtop(i,id) = max( kbt1(i), kbt1(i)+kth1(i)-1 ) - mbot(i,id) = kbt1(i) - - cl1 (i) = 0.0 - kbt1(i) = min(k+1, nlay) - kth1(i) = 0 - - if (id1 <= NK_CLDS) then - mbot(i,id1) = kbt1(i) - mtop(i,id1) = kbt1(i) - endif - endif ! end_if_pnxt - - enddo ! end_do_i_loop - enddo ! end_do_k_loop - - endif ! end_if_ivflip - - ! - return - !................................... - end subroutine gethml end module GFS_cloud_diagnostics diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index c868de6e3..45f8eefc6 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -4,9 +4,10 @@ ! ######################################################################################## module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys - use physparam, only: lcnorm, lcrick, idcor, iovr + use physparam, only: lcnorm, lcrick use rrtmgp_aux, only: check_error_msg - !use module_radiation_clouds, only: get_alpha_exp, get_alpha_dcorr + use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + ! Parameters real(kind_phys), parameter :: & reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) @@ -33,10 +34,11 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, lsswr, lslwr, effr_in, julian,& lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & - effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, & + effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, dcorr_con, idcor, iovr, & + iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, idcor_oreopoulos, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & - deltaZ, errmsg, errflg) + deltaZb, errmsg, errflg) implicit none ! Inputs @@ -51,7 +53,15 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld i_cldsnow, & ! Index into tracer array for cloud snow. i_cldgrpl, & ! Index into tracer array for cloud groupel. i_cldtot, & ! Index into tracer array for cloud total amount. - yearlen ! Length of current year (365/366) WTF? + yearlen, & ! Length of current year (365/366) WTF? + iovr, & ! Choice of cloud-overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + idcor, & ! Choice of method for decorrelation length computation + idcor_con, & ! Flag for decorrelation-length. Use constant value + idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) logical, intent(in) :: & lsswr, & ! Call SW radiation? lslwr, & ! Call LW radiation @@ -61,7 +71,8 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld con_pi, & ! Physical constant: pi con_g, & ! Physical constant: gravitational constant con_rd, & ! Physical constant: gas-constant for dry air - con_epsq ! Physical constant(?): Minimum value for specific humidity + con_epsq, & ! Physical constant(?): Minimum value for specific humidity + dcorr_con ! Decorrelation-length (used if idcor = 0, default is idcor = 1) real(kind_phys), dimension(nCol), intent(in) :: & lat ! Latitude real(kind_phys), dimension(nCol,nLev), intent(in) :: & @@ -92,18 +103,21 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld precip_frac, & ! Precipitation fraction cloud_overlap_param, & ! Cloud-overlap parameter precip_overlap_param, & ! Precipitation overlap parameter - deltaZ ! Layer thickness (km) + deltaZb ! Layer thickness (km) character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & errflg ! Error flag ! Local variables - real(kind_phys) :: tem1 + real(kind_phys) :: tem1,pfac + real(kind_phys), dimension(nLev+1) :: hgtb + real(kind_phys), dimension(nLev) :: hgtc real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate - integer :: iCol,iLay,l,ncndl - real(kind_phys), dimension(nCol,nLev) :: deltaP - + integer :: iCol,iLay,l,ncndl,iSFC,iTOA + real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ + logical :: top_at_1 + if (.not. (lsswr .or. lslwr)) return ! Initialize CCPP error handling variables @@ -117,30 +131,26 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) return endif - ! - if (lcrick) then - errmsg = 'Namelist option lcrick is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return - endif - ! - if (lcnorm) then - errmsg = 'Namelist option lcnorm is not supported.' - errflg = 1 - call check_error_msg('GFS_rrtmgp_gfdlmp_pre_run',errmsg) - return + + ! What is vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev endif - ! Initialize outputs + ! Initialize outputs cld_lwp(:,:) = 0.0 - cld_reliq(:,:) = 0.0 + cld_reliq(:,:) = reliq_def cld_iwp(:,:) = 0.0 - cld_reice(:,:) = 0.0 + cld_reice(:,:) = reice_def cld_rwp(:,:) = 0.0 - cld_rerain(:,:) = 0.0 + cld_rerain(:,:) = rerain_def cld_swp(:,:) = 0.0 - cld_resnow(:,:) = 0.0 + cld_resnow(:,:) = resnow_def ! #################################################################################### ! Pull out cloud information for GFDL MP scheme. @@ -183,7 +193,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 endif ! Use radii provided from the macrophysics - if (effr_in) then + if (effr_in) then cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) @@ -200,22 +210,83 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! #################################################################################### ! Cloud (and precipitation) overlap ! #################################################################################### - - ! Compute layer-thickness - do iCol=1,nCol - do iLay=1,nLev - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) - enddo + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! + do iCol=1,nCol + if (top_at_1) then + ! Layer thickness (km) + do iLay=1,nLev + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(nLev+1) = 0._kind_phys + do iLay=nLev,1,-1 + hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = nLev, 1, -1 + pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & + abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) + hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) + enddo + ! Layer thickness between centers + do iLay = nLev-1, 1, -1 + deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) + enddo + deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) + else + do iLay=nLev,1,-1 + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(1) = 0._kind_phys + do iLay=1,nLev + hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = 1, nLev + pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & + abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) + hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) + enddo + ! Layer thickness between centers + do iLay = 2, nLev + deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) + enddo + deltaZb(iCol,1) = hgtc(1) - hgtb(1) + endif enddo - - ! - ! Cloud overlap parameter - ! - if (iovr == 3) then -! call get_alpha_dcorr(nCol, nLev, lat, con_pi, deltaZ, de_lgth, cloud_overlap_param) + + ! + ! Cloud decorrelation length + ! + if (idcor == idcor_hogan) then + call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) + endif + if (idcor == idcor_oreopoulos) then + call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) + endif + if (idcor == idcor_con) then + de_lgth(:) = dcorr_con endif - if (iovr == 4 .or. iovr == 5) then -! call get_alpha_exp(nCol, nLev, deltaZ, iovr, lat, julian, yearlen, cld_frac, cloud_overlap_param) + + ! + ! Cloud overlap parameter + ! + call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) + + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (iovr == iovr_exprand) then + do iLay = 1, nLev + do iCol = 1, nCol + if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then + cloud_overlap_param(iCol,iLay) = 0._kind_phys + endif + enddo + enddo endif ! diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 787879340..293cc0c28 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -245,6 +245,79 @@ kind = kind_phys intent = in optional = F +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = flag for cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor] + standard_name = flag_for_decorrelation_length_method + long_name = flag for decorrelation length method used in cloud overlap method (iovr) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_con] + standard_name = flag_for_constant_decorrelation_length_method + long_name = choice of decorrelation length computation (costant) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_hogan] + standard_name = flag_for_hogan_decorrelation_length_method + long_name = choice of decorrelation length computation (hogan) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_oreopoulos] + standard_name = flag_for_oreopoulos_decorrelation_length_method + long_name = choice of decorrelation length computation (oreopoulos) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dcorr_con] + standard_name = decorreltion_length_used_by_overlap_method + long_name = decorrelation length (default) used by cloud overlap method (iovr) + units = km + dimensions = () + type = real + intent = in + kind = kind_phys + optional = F [de_lgth] standard_name = cloud_decorrelation_length long_name = cloud decorrelation length @@ -362,7 +435,7 @@ kind = kind_phys intent = out optional = F -[deltaZ] +[deltaZb] standard_name = layer_thickness long_name = layer_thickness units = m diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 3c3e09622..d0d29e3a2 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -46,6 +46,7 @@ end subroutine rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr, & + iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, & cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) @@ -57,6 +58,12 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical layers iovr, & ! Choice of cloud-overlap method + iovr_max, & ! Flag for maximum cloud overlap method + iovr_maxrand, & ! Flag for maximum-random cloud overlap method + iovr_rand, & ! Flag for random cloud overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method ipsdlw0 ! Initial permutation seed for McICA integer,intent(in),dimension(ncol) :: & icseed_lw ! auxiliary special cloud related array when module @@ -95,14 +102,6 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - ! - if (iovr .ne. 1 .and. iovr .ne. 3 .and. iovr .ne. 4 .and. iovr .ne. 5) then - errmsg = 'Cloud overlap assumption not supported.' - errflg = 1 - call check_error_msg('rrtmgp_lw_cloud_sampling',errmsg) - return - endif if (.not. doLWrad) return @@ -135,11 +134,11 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Cloud-overlap. ! Maximum-random - if (iovr == 1) then + if (iovr == iovr_maxrand) then call sampled_mask(rng3D, cld_frac, cldfracMCICA) endif ! Exponential decorrelation length overlap - if (iovr == 3) then + if (iovr == iovr_dcorr) then ! Generate second RNG do iCol=1,ncol call random_setseed(ipseed_lw(icol),rng_stat) @@ -151,7 +150,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, randoms2 = rng3D2) endif ! Exponential or Exponential-random - if (iovr == 4 .or. iovr == 5) then + if (iovr == iovr_exp .or. iovr == iovr_exprand) then call sampled_mask(rng3D, cld_frac, cldfracMCICA, & overlap_param = cloud_overlap_param(:,1:nLev-1)) endif @@ -192,11 +191,11 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Precipitation overlap. ! Maximum-random - if (iovr == 1) then + if (iovr == iovr_maxrand) then call sampled_mask(rng3D, precip_frac, precipfracSAMP) endif ! Exponential decorrelation length overlap - if (iovr == 3) then + if (iovr == iovr_dcorr) then ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Generate second RNG !do iCol=1,ncol @@ -209,7 +208,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, randoms2 = rng3D2) endif ! Exponential or Exponential-random - if (iovr == 4 .or. iovr == 5) then + if (iovr == iovr_exp .or. iovr == iovr_exprand) then call sampled_mask(rng3D, precip_frac, precipfracSAMP, & overlap_param = precip_overlap_param(:,1:nLev-1)) endif diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 4aeee9f07..b884c6f7e 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -85,6 +85,54 @@ type = integer intent = in optional = F +[iovr_maxrand] + standard_name = flag_for_maximum_random_cloud_overlap_method + long_name = choice of maximum-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_rand] + standard_name = flag_for_random_cloud_overlap_method + long_name = choice of random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_max] + standard_name = flag_for_maximum_cloud_overlap_method + long_name = choice of maximum cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F [icseed_lw] standard_name = seed_random_numbers_lw long_name = seed for random number generation for longwave radiation diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index bd2ad05af..cea0cf59d 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -45,6 +45,7 @@ end subroutine rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, iovr, & + iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, & icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) @@ -56,8 +57,14 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd nCol, & ! Number of horizontal gridpoints nDay, & ! Number of daylit points. nLev, & ! Number of vertical layers - iovr, & ! Choice of cloud-overlap method - ipsdsw0 ! Initial permutation seed for McICA + ipsdsw0, & ! Initial permutation seed for McICA + iovr, & ! Choice of cloud-overlap method + iovr_max, & ! Flag for maximum cloud overlap method + iovr_maxrand, & ! Flag for maximum-random cloud overlap method + iovr_rand, & ! Flag for random cloud overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand ! Flag for exponential-random cloud overlap method integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. integer,intent(in),dimension(ncol) :: & @@ -99,14 +106,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd errmsg = '' errflg = 0 - ! Only works w/ SDFs v15p2 and v16beta - if (iovr .ne. 1 .and. iovr .ne. 3 .and. iovr .ne. 4 .and. iovr .ne. 5) then - errmsg = 'Cloud overlap assumption not supported.' - errflg = 1 - call check_error_msg('rrtmgp_sw_cloud_sampling',errmsg) - return - endif - if (.not. doSWrad) return if (nDay .gt. 0) then ! ################################################################################# @@ -141,11 +140,11 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Cloud overlap. ! Maximum-random overlap - if (iovr == 1) then + if (iovr == iovr_maxrand) then call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA) endif ! Decorrelation-length overlap - if (iovr == 3) then + if (iovr == iovr_dcorr) then do iday=1,nday call random_setseed(ipseed_sw(iday),rng_stat) call random_number(rng1D,rng_stat) @@ -156,7 +155,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd randoms2 = rng3D2) endif ! Exponential overlap - if (iovr == 4 .or. iovr == 5) then + if (iovr == iovr_exp .or. iovr == iovr_exprand) then call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA, & overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1)) endif @@ -197,11 +196,11 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Precipitation overlap ! Maximum-random - if (iovr == 1) then + if (iovr == iovr_maxrand) then call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:), precipfracSAMP) endif ! Exponential decorrelation length overlap - if (iovr == 3) then + if (iovr == iovr_dcorr) then !! Generate second RNG !do iday=1,nday ! call random_setseed(ipseed_sw(iday),rng_stat) @@ -212,7 +211,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1),& randoms2 = rng3D2) endif - if (iovr == 4 .or. iovr == 5) then + if (iovr == iovr_exp .or. iovr == iovr_exprand) then call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:),precipfracSAMP, & overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1)) endif diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index acbb2a960..a9a68f374 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -101,6 +101,54 @@ type = integer intent = in optional = F +[iovr_maxrand] + standard_name = flag_for_maximum_random_cloud_overlap_method + long_name = choice of maximum-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_rand] + standard_name = flag_for_random_cloud_overlap_method + long_name = choice of random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_max] + standard_name = flag_for_maximum_cloud_overlap_method + long_name = choice of maximum cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F [icseed_sw] standard_name = seed_random_numbers_sw long_name = seed for random number generation for shortwave radiation From 01ad186d9f1740932bee1bdb1fb11c3d08888630 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 29 Oct 2020 19:41:13 +0000 Subject: [PATCH 096/274] Removed instanced of physparam in RRTMGP scheme. Information passed directly to routines. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 100 +++++++++++++------------- physics/GFS_rrtmgp_gfdlmp_pre.meta | 4 +- physics/GFS_rrtmgp_sw_pre.F90 | 1 - physics/rrtmgp_lw_cloud_sampling.F90 | 42 +++++++---- physics/rrtmgp_lw_cloud_sampling.meta | 8 +++ physics/rrtmgp_lw_pre.F90 | 1 - physics/rrtmgp_sw_cloud_sampling.F90 | 22 +++--- physics/rrtmgp_sw_cloud_sampling.meta | 8 +++ 8 files changed, 108 insertions(+), 78 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 45f8eefc6..52e1a7b74 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -4,7 +4,6 @@ ! ######################################################################################## module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys - use physparam, only: lcnorm, lcrick use rrtmgp_aux, only: check_error_msg use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp @@ -32,8 +31,8 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, lsswr, lslwr, effr_in, julian,& - lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, doSWrad, doLWrad, effr_in, & + julian, lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, dcorr_con, idcor, iovr, & iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, idcor_oreopoulos, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & @@ -43,53 +42,53 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! Inputs integer, intent(in) :: & - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - ncnd, & ! Number of cloud condensation types. - nTracers, & ! Number of tracers from model. - i_cldliq, & ! Index into tracer array for cloud liquid. - i_cldice, & ! Index into tracer array for cloud ice. - i_cldrain, & ! Index into tracer array for cloud rain. - i_cldsnow, & ! Index into tracer array for cloud snow. - i_cldgrpl, & ! Index into tracer array for cloud groupel. - i_cldtot, & ! Index into tracer array for cloud total amount. - yearlen, & ! Length of current year (365/366) WTF? - iovr, & ! Choice of cloud-overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - idcor, & ! Choice of method for decorrelation length computation - idcor_con, & ! Flag for decorrelation-length. Use constant value - idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + ncnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq, & ! Index into tracer array for cloud liquid. + i_cldice, & ! Index into tracer array for cloud ice. + i_cldrain, & ! Index into tracer array for cloud rain. + i_cldsnow, & ! Index into tracer array for cloud snow. + i_cldgrpl, & ! Index into tracer array for cloud groupel. + i_cldtot, & ! Index into tracer array for cloud total amount. + yearlen, & ! Length of current year (365/366) WTF? + iovr, & ! Choice of cloud-overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + idcor, & ! Choice of method for decorrelation length computation + idcor_con, & ! Flag for decorrelation-length. Use constant value + idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) logical, intent(in) :: & - lsswr, & ! Call SW radiation? - lslwr, & ! Call LW radiation - effr_in ! Provide hydrometeor radii from macrophysics? + doSWrad, & ! Call SW radiation? + doLWrad, & ! Call LW radiation + effr_in ! Provide hydrometeor radii from macrophysics? real(kind_phys), intent(in) :: & - julian, & ! Julian day - con_pi, & ! Physical constant: pi - con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_epsq, & ! Physical constant(?): Minimum value for specific humidity - dcorr_con ! Decorrelation-length (used if idcor = 0, default is idcor = 1) + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq, & ! Physical constant(?): Minimum value for specific humidity + dcorr_con ! Decorrelation-length (used if idcor = idcor_con) real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude + lat ! Latitude real(kind_phys), dimension(nCol,nLev), intent(in) :: & - tv_lay, & ! Virtual temperature (K) - p_lay, & ! Pressure at model-layers (Pa) - effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) - effrin_cldice, & ! Effective radius for ice cloud-particles (microns) - effrin_cldrain, & ! Effective radius for rain cloud-particles (microns) - effrin_cldsnow ! Effective radius for snow cloud-particles (microns) + tv_lay, & ! Virtual temperature (K) + p_lay, & ! Pressure at model-layers (Pa) + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldrain, & ! Effective radius for rain cloud-particles (microns) + effrin_cldsnow ! Effective radius for snow cloud-particles (microns) real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & - p_lev ! Pressure at model-level interfaces (Pa) + p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & - tracer ! Cloud condensate amount in layer by type () + tracer ! Cloud condensate amount in layer by type () ! Outputs real(kind_phys), dimension(nCol),intent(out) :: & - de_lgth ! Decorrelation length + de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path @@ -105,9 +104,9 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld precip_overlap_param, & ! Precipitation overlap parameter deltaZb ! Layer thickness (km) character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error flag + errflg ! Error flag ! Local variables real(kind_phys) :: tem1,pfac @@ -118,7 +117,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ logical :: top_at_1 - if (.not. (lsswr .or. lslwr)) return + if (.not. (doSWrad .or. doLWrad)) return ! Initialize CCPP error handling variables errmsg = '' @@ -271,10 +270,15 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld de_lgth(:) = dcorr_con endif - ! - ! Cloud overlap parameter - ! - call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) + ! + ! Cloud overlap parameter + ! + if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then + call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) + else + de_lgth(:) = 0. + cloud_overlap_param(:,:) = 0. + endif ! For exponential random overlap... ! Decorrelate layers when a clear layer follows a cloudy layer to enforce diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 293cc0c28..3841afc9b 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -39,7 +39,7 @@ type = integer intent = in optional = F -[lsswr] +[doSWrad] standard_name = flag_to_calc_sw long_name = logical flags for sw radiation calls units = flag @@ -47,7 +47,7 @@ type = logical intent = in optional = F -[lslwr] +[doLWrad] standard_name = flag_to_calc_lw long_name = logical flags for lw radiation calls units = flag diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 09f830043..179c622f5 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -1,5 +1,4 @@ module GFS_rrtmgp_sw_pre - use physparam use machine, only: & kind_phys ! Working type use module_radiation_astronomy,only: & diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index d0d29e3a2..00418edec 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -1,7 +1,6 @@ module rrtmgp_lw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use physparam, only: isubclw use mo_optical_props, only: ty_optical_props_1scl use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat @@ -46,7 +45,7 @@ end subroutine rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_run.html !! subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr, & - iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, & + iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, & cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) @@ -64,12 +63,13 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method iovr_exp, & ! Flag for exponential cloud overlap method iovr_exprand, & ! Flag for exponential-random cloud overlap method - ipsdlw0 ! Initial permutation seed for McICA + ipsdlw0, & ! Initial permutation seed for McICA + isubc_lw integer,intent(in),dimension(ncol) :: & icseed_lw ! auxiliary special cloud related array when module - ! variable isubclw=2, it provides permutation seed + ! variable isubc_lw=2, it provides permutation seed ! for each column profile that are used for generating - ! random numbers. when isubclw /=2, it will not be used. + ! random numbers. when isubc_lw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & cld_frac, & ! Total cloud fraction by layer precip_frac ! Precipitation fraction by layer @@ -92,7 +92,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, lw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties by spectral point (precipitation) ! Local variables - integer :: iCol + integer :: iCol, iLay integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 @@ -113,12 +113,12 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) - ! Change random number seed value for each radiation invocation (isubclw =1 or 2). - if(isubclw == 1) then ! advance prescribed permutation seed + ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). + if(isubc_lw == 1) then ! advance prescribed permutation seed do iCol = 1, ncol ipseed_lw(iCol) = ipsdlw0 + iCol enddo - elseif (isubclw == 2) then ! use input array of permutaion seeds + elseif (isubc_lw == 2) then ! use input array of permutaion seeds do iCol = 1, ncol ipseed_lw(iCol) = icseed_lw(iCol) enddo @@ -128,13 +128,25 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) do iCol=1,ncol call random_setseed(ipseed_lw(icol),rng_stat) - call random_number(rng1D,rng_stat) - rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + ! Use same rng for each layer + if (iovr == iovr_max) then + call random_number(rng1D,rng_stat) + do iLay=1,nLev + rng3D(:,iLay,iCol) = rng1D + enddo + else + do iLay=1,nLev + call random_number(rng1D,rng_stat) + rng3D(:,iLay,iCol) = rng1D + enddo + endif +! call random_number(rng1D,rng_stat) +! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo ! Cloud-overlap. ! Maximum-random - if (iovr == iovr_maxrand) then + if (iovr == iovr_maxrand .or. iovr == iovr_rand) then call sampled_mask(rng3D, cld_frac, cldfracMCICA) endif ! Exponential decorrelation length overlap @@ -169,12 +181,12 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) - ! Change random number seed value for each radiation invocation (isubclw =1 or 2). - if(isubclw == 1) then ! advance prescribed permutation seed + ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). + if(isubc_lw == 1) then ! advance prescribed permutation seed do iCol = 1, ncol ipseed_lw(iCol) = ipsdlw0 + iCol enddo - elseif (isubclw == 2) then ! use input array of permutaion seeds + elseif (isubc_lw == 2) then ! use input array of permutaion seeds do iCol = 1, ncol ipseed_lw(iCol) = icseed_lw(iCol) enddo diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index b884c6f7e..7acc6a7d3 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -69,6 +69,14 @@ type = integer intent = in optional = F +[isubc_lw] + standard_name = flag_for_lw_clouds_without_sub_grid_approximation + long_name = flag for lw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F [ipsdlw0] standard_name = initial_permutation_seed_lw long_name = initial seed for McICA LW diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 7ad8bd30d..caee7308e 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -1,5 +1,4 @@ module rrtmgp_lw_pre - use physparam use machine, only: & kind_phys ! Working type use module_radiation_surface, only: & diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index cea0cf59d..b437be5bd 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -1,7 +1,6 @@ module rrtmgp_sw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use physparam, only: isubcsw use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat @@ -45,7 +44,7 @@ end subroutine rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, iovr, & - iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, & + iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_sw, & icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) @@ -64,14 +63,15 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd iovr_rand, & ! Flag for random cloud overlap method iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand ! Flag for exponential-random cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + isubc_sw integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. integer,intent(in),dimension(ncol) :: & icseed_sw ! auxiliary special cloud related array when module - ! variable isubcsw=2, it provides permutation seed + ! variable isubc_sw=2, it provides permutation seed ! for each column profile that are used for generating - ! random numbers. when isubcsw /=2, it will not be used. + ! random numbers. when isubc_sw /=2, it will not be used. real(kind_phys), dimension(ncol,nLev),intent(in) :: & cld_frac, & ! Total cloud fraction by layer precip_frac ! Precipitation fraction by layer @@ -119,12 +119,12 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd sw_optical_props_clouds%ssa(:,:,:) = 1._kind_phys sw_optical_props_clouds%g(:,:,:) = 0._kind_phys - ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). - if(isubcsw == 1) then ! advance prescribed permutation seed + ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). + if(isubc_sw == 1) then ! advance prescribed permutation seed do iday = 1, nday ipseed_sw(iday) = ipsdsw0 + iday enddo - elseif (isubcsw == 2) then ! use input array of permutaion seeds + elseif (isubc_sw == 2) then ! use input array of permutaion seeds do iday = 1, nday ipseed_sw(iday) = icseed_sw(iday) enddo @@ -174,12 +174,12 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sw_optical_props_precip%alloc_2str( nday, nLev, sw_gas_props)) - ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). - if(isubcsw == 1) then ! advance prescribed permutation seed + ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). + if(isubc_sw == 1) then ! advance prescribed permutation seed do iday = 1, nday ipseed_sw(iday) = ipsdsw0 + iday enddo - elseif (isubcsw == 2) then ! use input array of permutaion seeds + elseif (isubc_sw == 2) then ! use input array of permutaion seeds do iday = 1, nday ipseed_sw(iday) = icseed_sw(iday) enddo diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index a9a68f374..fded88bbb 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -77,6 +77,14 @@ type = integer intent = in optional = F +[isubc_sw] + standard_name = flag_for_sw_clouds_without_sub_grid_approximation + long_name = flag for sw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F [ipsdsw0] standard_name = initial_permutation_seed_sw long_name = initial seed for McICA SW From 573d922505a3b1b261d5160d3ccc600af235a8d0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 29 Oct 2020 22:42:01 +0000 Subject: [PATCH 097/274] Assumulated changes. Cleanup GP setup module, remove GP dependecies on physparam.f, some housekeeping. --- physics/GFS_rrtmgp_setup.F90 | 869 ++++++++------------------- physics/rrtmg_lw_cloud_optics.F90 | 9 +- physics/rrtmg_sw_cloud_optics.F90 | 9 +- physics/rrtmgp_lw_cloud_optics.F90 | 16 +- physics/rrtmgp_lw_cloud_optics.meta | 16 + physics/rrtmgp_lw_cloud_sampling.F90 | 17 +- physics/rrtmgp_sw_cloud_optics.F90 | 14 +- physics/rrtmgp_sw_cloud_optics.meta | 16 + physics/rrtmgp_sw_cloud_sampling.F90 | 20 +- 9 files changed, 339 insertions(+), 647 deletions(-) diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 8f7b44e00..a32f96ccf 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -1,627 +1,276 @@ !> \file GFS_rrtmgp_setup.f90 !! This file contains module GFS_rrtmgp_setup - - use physparam, only : & - isolar, ictmflg, ico2flg, ioznflg, iaerflg, iaermdl, icldflg, & - lcrick, lcnorm, lnoprec, ialbflg, iemsflg, & - isubcsw, isubclw, ivflip , ipsd0, iswcliq - use machine, only: & - kind_phys ! Working type - implicit none - - public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_run, GFS_rrtmgp_setup_finalize - - private - - logical :: is_initialized = .false. - - ! Version tag and last revision date - character(40), parameter :: & - VTAGRAD='NCEP-RRTMGP_driver v1.0 Sep 2019 ' - - ! Defaults - !> new data input control variables (set/reset in subroutines radinit/radupdate): - integer :: month0 = 0 - integer :: iyear0 = 0 - integer :: monthd = 0 - - !> control flag for the first time of reading climatological ozone data - !! (set/reset in subroutines radinit/radupdate, it is used only if the - !! control parameter ioznflg=0) - logical :: loz1st = .true. - - contains + use machine, only : kind_phys + use module_radiation_astronomy, only : sol_init, sol_update + use module_radiation_aerosols, only : aer_init, aer_update + use module_radiation_gases, only : gas_init, gas_update + use module_radiation_surface, only : sfc_init + use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize + ! *NOTE* These parameters below are required radiation_****** modules. They are not + ! directly used by the RRTMGP routines. + use physparam, only : isolar, ictmflg, ico2flg, ioznflg, iaerflg, & + iaermdl, ialbflg, iemsflg, ivflip + implicit none + + public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_run, GFS_rrtmgp_setup_finalize + + ! Version tag and last revision date + character(40), parameter :: & + VTAGRAD='NCEP-RRTMGP_driver v1.0 Sep 2019 ' + + ! Module paramaters + integer :: & + month0 = 0, & + iyear0 = 0, & + monthd = 0 + logical :: & + is_initialized = .false. + ! Control flag for the first time of reading climatological ozone data + ! (set/reset in subroutines GFS_rrtmgp_setup_init/GFS_rrtmgp_setuup_run, it is used only if + ! the control parameter ioznflg=0) + logical :: loz1st = .true. + +contains + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_setup_init + ! ######################################################################################### !> \defgroup GFS_rrtmgp_setup GFS RRTMGP Scheme Setup !! @{ !! \section arg_table_GFS_rrtmgp_setup_init !! \htmlinclude GFS_rrtmgp_setup_init.html !! - subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl,& - imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & - ialb, iems, ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & - icliq_sw, crick_proof, ccnorm, norad_precip, idate, iflip, me, errmsg, errflg) - implicit none - - ! Inputs - integer, intent(in) :: & - imp_physics, & ! Flag for MP scheme - imp_physics_fer_hires, & ! Flag for fer-hires scheme - imp_physics_gfdl, & ! Flag for gfdl scheme - imp_physics_thompson, & ! Flag for thompsonscheme - imp_physics_wsm6, & ! Flag for wsm6 scheme - imp_physics_zhao_carr, & ! Flag for zhao-carr scheme - imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme - imp_physics_mg ! Flag for MG scheme - real(kind_phys), dimension(levr+1), intent(in) :: & - si - integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & - ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & - icliq_sw, iflip, me - logical, intent(in) :: & - crick_proof, ccnorm, norad_precip - integer, intent(in), dimension(4) :: & - idate - ! Outputs - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize the CCPP error handling variables - errmsg = '' - errflg = 0 - if (is_initialized) return - - ! Set radiation parameters - isolar = isol ! solar constant control flag - ictmflg = ictm ! data ic time/date control flag - ico2flg = ico2 ! co2 data source control flag - ioznflg = ntoz ! ozone data source control flag - iswcliq = icliq_sw ! optical property for liquid clouds for sw - lcrick = crick_proof ! control flag for eliminating CRICK - lcnorm = ccnorm ! control flag for in-cld condensate - lnoprec = norad_precip ! precip effect on radiation flag (ferrier microphysics) - isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation - isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation - ialbflg = ialb ! surface albedo control flag - iemsflg = iems ! surface emissivity control flag - ivflip = iflip ! vertical index direction control flag - - if ( ictm==0 .or. ictm==-2 ) then - iaerflg = mod(iaer, 100) ! no volcanic aerosols for clim hindcast - else - iaerflg = mod(iaer, 1000) - endif - iaermdl = iaer/1000 ! control flag for aerosol scheme selection - if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then - errmsg = trim(errmsg) // ' Error -- IAER flag is incorrect, Abort' - errflg = 1 - return - endif - - !if ( ntcw > 0 ) then - icldflg = 1 ! prognostic cloud optical prop scheme - !else - ! icldflg = 0 ! no support for diag cloud opt prop scheme - !endif - - ! Set initial permutation seed for mcica cloud-radiation - if ( isubc_sw>0 .or. isubc_lw>0 ) then - ipsd0 = 17*idate(1)+43*idate(2)+37*idate(3)+23*idate(4) - endif - - if ( me == 0 ) then - print *,' In rad_initialize (GFS_rrtmgp_setup_init), before calling radinit' - print *,' si =',si - print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& - ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw - print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr=',iovr, & - ' isubc_sw=',isubc_sw, & - ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & - ' iflip=',iflip,' me=',me - print *,' crick_proof=',crick_proof, & - ' ccnorm=',ccnorm,' norad_precip=',norad_precip - endif - - - call radinit( si, levr, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & - imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, iovr, me, errflg ) - - if ( me == 0 ) then - print *,' Radiation sub-cloud initial seed =',ipsd0, & - ' IC-idate =',idate - print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' - endif - - is_initialized = .true. - return - end subroutine GFS_rrtmgp_setup_init - + subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & + imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, ialb, & + iems, ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, & + norad_precip, idate, iflip, me, errmsg, errflg) + + ! Inputs + integer, intent(in) :: & + imp_physics, & ! Flag for MP scheme + imp_physics_fer_hires, & ! Flag for fer-hires scheme + imp_physics_gfdl, & ! Flag for gfdl scheme + imp_physics_thompson, & ! Flag for thompsonscheme + imp_physics_wsm6, & ! Flag for wsm6 scheme + imp_physics_zhao_carr, & ! Flag for zhao-carr scheme + imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme + imp_physics_mg ! Flag for MG scheme + real(kind_phys), dimension(levr+1), intent(in) :: & + si + integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & + ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & + icliq_sw, iflip, me + logical, intent(in) :: & + crick_proof, ccnorm, norad_precip + integer, intent(in), dimension(4) :: & + idate + + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Set radiation parameters + isolar = isol ! solar constant control flag + ictmflg = ictm ! data ic time/date control flag + ico2flg = ico2 ! co2 data source control flag + ioznflg = ntoz ! ozone data source control flag + ialbflg = ialb ! surface albedo control flag + iemsflg = iems ! surface emissivity control flag + ivflip = iflip ! vertical index direction control flag + + if ( ictm==0 .or. ictm==-2 ) then + iaerflg = mod(iaer, 100) ! no volcanic aerosols for clim hindcast + else + iaerflg = mod(iaer, 1000) + endif + iaermdl = iaer/1000 ! control flag for aerosol scheme selection + if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then + errmsg = trim(errmsg) // ' Error -- IAER flag is incorrect, Abort' + errflg = 1 + return + endif + + if ( me == 0 ) then + print *,' In rad_initialize (GFS_rrtmgp_setup_init), before calling radinit' + print *,' si = ',si + print *,' levr = ',levr, & + ' ictm = ',ictm, & + ' isol = ',isol, & + ' ico2 = ',ico2, & + ' iaer = ',iaer, & + ' ialb = ',ialb, & + ' iems = ',iems, & + ' ntcw = ',ntcw + print *,' np3d = ',num_p3d, & + ' ntoz = ',ntoz, & + ' iovr = ',iovr, & + ' isubc_sw = ',isubc_sw, & + ' isubc_lw = ',isubc_lw, & + ' icliq_sw = ',icliq_sw, & + ' iflip = ',iflip, & + ' me = ',me + endif + +#if 0 + ! GFS_radiation_driver.F90 may in the future initialize air/ground + ! temperature differently; however, this is not used at the moment + ! and as such we avoid the difficulty of dealing with exchanging + ! itsfc between GFS_rrtmgp_setup and a yet-to-be-created/-used + ! interstitial routine (or GFS_radiation_driver.F90) + itsfc = iemsflg / 10 ! sfc air/ground temp control +#endif + loz1st = (ioznflg == 0) ! first-time clim ozone data read flag + month0 = 0 + iyear0 = 0 + monthd = 0 + + ! Call initialization routines.. + call sol_init ( me ) + call aer_init ( levr, me ) + call gas_init ( me ) + call sfc_init ( me ) + call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, levr, me, si,& + errflg) + + if ( me == 0 ) then + print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' + endif + + is_initialized = .true. + + return + end subroutine GFS_rrtmgp_setup_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_setup_run + ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_setup_run !! \htmlinclude GFS_rrtmgp_setup_run.html !! - subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & - slag, sdec, cdec, solcon, errmsg, errflg) - - implicit none - - ! interface variables - integer, intent(in) :: idate(:) - integer, intent(in) :: jdate(:) - real(kind=kind_phys), intent(in) :: deltsw - real(kind=kind_phys), intent(in) :: deltim - logical, intent(in) :: lsswr - integer, intent(in) :: me - real(kind=kind_phys), intent(out) :: slag - real(kind=kind_phys), intent(out) :: sdec - real(kind=kind_phys), intent(out) :: cdec - real(kind=kind_phys), intent(out) :: solcon - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Check initialization state - if (.not.is_initialized) then - write(errmsg, fmt='((a))') 'GFS_rrtmgp_setup_run called before GFS_rrtmgp_setup_init' - errflg = 1 - return - end if - - ! Initialize the CCPP error handling variables - errmsg = '' - errflg = 0 + subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & + slag, sdec, cdec, solcon, errmsg, errflg) - call radupdate(idate,jdate,deltsw,deltim,lsswr,me, & - slag,sdec,cdec,solcon) - - end subroutine GFS_rrtmgp_setup_run - + ! Inputs + integer, intent(in) :: idate(:) + integer, intent(in) :: jdate(:) + real(kind_phys), intent(in) :: deltsw + real(kind_phys), intent(in) :: deltim + logical, intent(in) :: lsswr + integer, intent(in) :: me + + ! Outputs + real(kind_phys), intent(out) :: slag + real(kind_phys), intent(out) :: sdec + real(kind_phys), intent(out) :: cdec + real(kind_phys), intent(out) :: solcon + character(len=*),intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Locals + integer :: iyear, imon, iday, ihour + integer :: kyear, kmon, kday, khour + logical :: lmon_chg ! month change flag + logical :: lco2_chg ! cntrl flag for updating co2 data + logical :: lsol_chg ! cntrl flag for updating solar constant + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization state + if (.not.is_initialized) then + write(errmsg, fmt='((a))') 'GFS_rrtmgp_setup_run called before GFS_rrtmgp_setup_init' + errflg = 1 + return + end if + + ! Set up time stamp at fcst time and that for green house gases + iyear = jdate(1) + imon = jdate(2) + iday = jdate(3) + ihour = jdate(5) + + ! Set up time stamp used for green house gases (** currently co2 only) + ! get external data at initial condition time + if ( ictmflg==0 .or. ictmflg==-2 ) then + kyear = idate(1) + kmon = idate(2) + kday = idate(3) + khour = idate(5) + ! get external data at fcst or specified time + else + kyear = iyear + kmon = imon + kday = iday + khour = ihour + endif + + if ( month0 /= imon ) then + lmon_chg = .true. + month0 = imon + else + lmon_chg = .false. + endif + + ! Update solar forcing... + if (lsswr) then + if ( isolar == 0 .or. isolar == 10 ) then + lsol_chg = .false. + elseif ( iyear0 /= iyear ) then + lsol_chg = .true. + else + lsol_chg = ( isolar==4 .and. lmon_chg ) + endif + iyear0 = iyear + call sol_update(jdate, kyear, deltsw, deltim, lsol_chg, me, slag, sdec, cdec, solcon) + endif + + ! Update aerosols... + if ( lmon_chg ) then + call aer_update ( iyear, imon, me ) + endif + + ! Update trace gases (co2 only)... + if ( monthd /= kmon ) then + monthd = kmon + lco2_chg = .true. + else + lco2_chg = .false. + endif + call gas_update (kyear, kmon, kday, khour, loz1st, lco2_chg, me ) + + if ( loz1st ) loz1st = .false. + + return + end subroutine GFS_rrtmgp_setup_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_setup_finalize + ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_setup_finalize !! \htmlinclude GFS_rrtmgp_setup_finalize.html !! - subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) + subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 - implicit none - - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Initialize the CCPP error handling variables - errmsg = '' - errflg = 0 - - if (.not.is_initialized) return - - ! do finalization stuff if needed - - is_initialized = .false. - - end subroutine GFS_rrtmgp_setup_finalize - - - ! Private functions - - - subroutine radinit(si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & - imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, iovr, me, errflg ) - !................................... - -! --- inputs: -! & ( si, NLAY, imp_physics, imp_physics_fer_hires, imp_physics_gfdl, & -! & imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & -! & imp_physics_zhao_carr_pdf, imp_physics_mg, me ) -! --- outputs: -! ( errflg ) - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: radinit initialization of radiation calculations ! -! ! -! usage: call radinit ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: wcoss ! -! ! -! ==================== definition of variables ==================== ! -! ! -! input parameters: ! -! si : model vertical sigma interface ! -! NLAY : number of model vertical layers ! -! imp_physics : MP identifier ! -! me : print control flag ! -! ! -! outputs: (none) ! -! ! -! external module variables: (in module physparam) ! -! isolar : solar constant cntrol flag ! -! = 0: use the old fixed solar constant in "physcon" ! -! =10: use the new fixed solar constant in "physcon" ! -! = 1: use noaa ann-mean tsi tbl abs-scale with cycle apprx! -! = 2: use noaa ann-mean tsi tbl tim-scale with cycle apprx! -! = 3: use cmip5 ann-mean tsi tbl tim-scale with cycl apprx! -! = 4: use cmip5 mon-mean tsi tbl tim-scale with cycl apprx! -! iaerflg : 3-digit aerosol flag (abc for volc, lw, sw) ! -! a:=0 use background stratospheric aerosol ! -! =1 include stratospheric vocanic aeros ! -! b:=0 no topospheric aerosol in lw radiation ! -! =1 compute tropspheric aero in 1 broad band for lw ! -! =2 compute tropspheric aero in multi bands for lw ! -! c:=0 no topospheric aerosol in sw radiation ! -! =1 include tropspheric aerosols for sw ! -! ico2flg : co2 data source control flag ! -! =0: use prescribed global mean co2 (old oper) ! -! =1: use observed co2 annual mean value only ! -! =2: use obs co2 monthly data with 2-d variation ! -! ictmflg : =yyyy#, external data ic time/date control flag ! -! = -2: same as 0, but superimpose seasonal cycle ! -! from climatology data set. ! -! = -1: use user provided external data for the ! -! forecast time, no extrapolation. ! -! = 0: use data at initial cond time, if not ! -! available, use latest, no extrapolation. ! -! = 1: use data at the forecast time, if not ! -! available, use latest and extrapolation. ! -! =yyyy0: use yyyy data for the forecast time, ! -! no further data extrapolation. ! -! =yyyy1: use yyyy data for the fcst. if needed, do ! -! extrapolation to match the fcst time. ! -! ioznflg : ozone data source control flag ! -! =0: use climatological ozone profile ! -! =1: use interactive ozone profile ! -! ialbflg : albedo scheme control flag ! -! =0: climatology, based on surface veg types ! -! =1: modis retrieval based surface albedo scheme ! -! iemsflg : emissivity scheme cntrl flag (ab 2-digit integer) ! -! a:=0 set sfc air/ground t same for lw radiation ! -! =1 set sfc air/ground t diff for lw radiation ! -! b:=0 use fixed sfc emissivity=1.0 (black-body) ! -! =1 use varying climtology sfc emiss (veg based) ! -! =2 future development (not yet) ! -! icldflg : cloud optical property scheme control flag ! -! =0: use diagnostic cloud scheme ! -! =1: use prognostic cloud scheme (default) ! -! imp_physics : cloud microphysics scheme control flag ! -! =99 zhao/carr/sundqvist microphysics scheme ! -! =98 zhao/carr/sundqvist microphysics+pdf cloud&cnvc,cnvw ! -! =11 GFDL cloud microphysics ! -! =8 Thompson microphysics scheme ! -! =6 WSM6 microphysics scheme ! -! =10 MG microphysics scheme ! -! isubcsw : sub-column cloud approx control flag in sw radiation ! -! isubclw : sub-column cloud approx control flag in lw radiation ! -! =0: with out sub-column cloud approximation ! -! =1: mcica sub-col approx. prescribed random seed ! -! =2: mcica sub-col approx. provided random seed ! -! lcrick : control flag for eliminating CRICK ! -! =t: apply layer smoothing to eliminate CRICK ! -! =f: do not apply layer smoothing ! -! lcnorm : control flag for in-cld condensate ! -! =t: normalize cloud condensate ! -! =f: not normalize cloud condensate ! -! lnoprec : precip effect in radiation flag (ferrier microphysics) ! -! =t: snow/rain has no impact on radiation ! -! =f: snow/rain has impact on radiation ! -! ivflip : vertical index direction control flag ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! ! -! subroutines called: sol_init, aer_init, gas_init, cld_init, ! -! sfc_init, rlwinit, rswinit ! -! ! -! usage: call radinit ! -! ! -! =================================================================== ! -! - - use module_radiation_astronomy, only : sol_init - use module_radiation_aerosols, only : aer_init - use module_radiation_gases, only : gas_init - use module_radiation_surface, only : sfc_init - use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize - - implicit none - -! --- inputs: - integer, intent(in) :: & - iovr, & ! - imp_physics, & ! Flag for MP scheme - imp_physics_fer_hires, & ! Flag for fer-hires scheme - imp_physics_gfdl, & ! Flag for gfdl scheme - imp_physics_thompson, & ! Flag for thompsonscheme - imp_physics_wsm6, & ! Flag for wsm6 scheme - imp_physics_zhao_carr, & ! Flag for zhao-carr scheme - imp_physics_zhao_carr_pdf, & ! Flag for zhao-carr+PDF scheme - imp_physics_mg ! Flag for MG scheme - integer, intent(in) :: NLAY, me - real (kind=kind_phys), intent(in) :: si(:) - -! --- outputs: (none, to module variables) - integer, intent(out) :: & - errflg - -! --- locals: - - ! Initialize - errflg = 0 -! -!===> ... begin here -! -!> -# Set up control variables and external module variables in -!! module physparam -#if 0 - ! GFS_radiation_driver.F90 may in the future initialize air/ground - ! temperature differently; however, this is not used at the moment - ! and as such we avoid the difficulty of dealing with exchanging - ! itsfc between GFS_rrtmgp_setup and a yet-to-be-created/-used - ! interstitial routine (or GFS_radiation_driver.F90) - itsfc = iemsflg / 10 ! sfc air/ground temp control -#endif - loz1st = (ioznflg == 0) ! first-time clim ozone data read flag - month0 = 0 - iyear0 = 0 - monthd = 0 - - if (me == 0) then -! print *,' NEW RADIATION PROGRAM STRUCTURES -- SEP 01 2004' - print *,' NEW RADIATION PROGRAM STRUCTURES BECAME OPER. ', & - & ' May 01 2007' - print *, VTAGRAD !print out version tag - print *,' - Selected Control Flag settings: ICTMflg=',ictmflg, & - & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & - & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & - & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg - print *,' IVFLIP=',ivflip,' IOVR=',iovr, & - & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw - print *,' LCRICK=',lcrick,' LCNORM=',lcnorm,' LNOPREC=',lnoprec - - if ( ictmflg==0 .or. ictmflg==-2 ) then - print *,' Data usage is limited by initial condition!' - print *,' No volcanic aerosols' - endif - - if ( isubclw == 0 ) then - print *,' - ISUBCLW=',isubclw,' No McICA, use grid ', & - & 'averaged cloud in LW radiation' - elseif ( isubclw == 1 ) then - print *,' - ISUBCLW=',isubclw,' Use McICA with fixed ', & - & 'permutation seeds for LW random number generator' - elseif ( isubclw == 2 ) then - print *,' - ISUBCLW=',isubclw,' Use McICA with random ', & - & 'permutation seeds for LW random number generator' - else - print *,' - ERROR!!! ISUBCLW=',isubclw,' is not a ', & - & 'valid option ' - stop - endif - - if ( isubcsw == 0 ) then - print *,' - ISUBCSW=',isubcsw,' No McICA, use grid ', & - & 'averaged cloud in SW radiation' - elseif ( isubcsw == 1 ) then - print *,' - ISUBCSW=',isubcsw,' Use McICA with fixed ', & - & 'permutation seeds for SW random number generator' - elseif ( isubcsw == 2 ) then - print *,' - ISUBCSW=',isubcsw,' Use McICA with random ', & - & 'permutation seeds for SW random number generator' - else - print *,' - ERROR!!! ISUBCSW=',isubcsw,' is not a ', & - & 'valid option ' - stop - endif - - if ( isubcsw /= isubclw ) then - print *,' - *** Notice *** ISUBCSW /= ISUBCLW !!!', & - & isubcsw, isubclw - endif - endif - - ! Initialization - - call sol_init ( me ) ! --- ... astronomy initialization routine - call aer_init ( NLAY, me ) ! --- ... aerosols initialization routine - call gas_init ( me ) ! --- ... co2 and other gases initialization routine - call sfc_init ( me ) ! --- ... surface initialization routine - call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, NLAY, me, si,& - errflg) - - return - !................................... - end subroutine radinit - !----------------------------------- - -!> This subroutine checks and updates time sensitive data used by -!! radiation computations. This subroutine needs to be placed inside -!! the time advancement loop but outside of the horizontal grid loop. -!! It is invoked at radiation calling frequncy but before any actual -!! radiative transfer computations. -!! \param idate NCEP absolute date and time of intial condition -!! (year,month,day,time-zone,hour,minute,second, -!! mil-second) -!! \param jdate NCEP absolute date and time at forecast time -!! (year,month,day,time-zone,hour,minute,second, -!! mil-second) -!! \param deltsw SW radiation calling time interval in seconds -!! \param deltim model advancing time-step duration in seconds -!! \param lsswr logical control flag for SW radiation calculations -!! \param me print control flag -!! \param slag equation of time in radians -!! \param sdec,cdec sine and cosine of the solar declination angle -!! \param solcon solar constant adjusted by sun-earth distance \f$(W/m^2)\f$ -!> \section gen_radupdate General Algorithm -!> @{ -!----------------------------------- - subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & - & slag,sdec,cdec,solcon) -!................................... - -! ================= subprogram documentation block ================ ! -! ! -! subprogram: radupdate calls many update subroutines to check and ! -! update radiation required but time varying data sets and module ! -! variables. ! -! ! -! usage: call radupdate ! -! ! -! attributes: ! -! language: fortran 90 ! -! machine: ibm sp ! -! ! -! ==================== definition of variables ==================== ! -! ! -! input parameters: ! -! idate(8) : ncep absolute date and time of initial condition ! -! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! -! jdate(8) : ncep absolute date and time at fcst time ! -! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! -! deltsw : sw radiation calling frequency in seconds ! -! deltim : model timestep in seconds ! -! lsswr : logical flags for sw radiation calculations ! -! me : print control flag ! -! ! -! outputs: ! -! slag : equation of time in radians ! -! sdec, cdec : sin and cos of the solar declination angle ! -! solcon : sun-earth distance adjusted solar constant (w/m2) ! -! ! -! external module variables: ! -! isolar : solar constant cntrl (in module physparam) ! -! = 0: use the old fixed solar constant in "physcon" ! -! =10: use the new fixed solar constant in "physcon" ! -! = 1: use noaa ann-mean tsi tbl abs-scale with cycle apprx! -! = 2: use noaa ann-mean tsi tbl tim-scale with cycle apprx! -! = 3: use cmip5 ann-mean tsi tbl tim-scale with cycl apprx! -! = 4: use cmip5 mon-mean tsi tbl tim-scale with cycl apprx! -! ictmflg : =yyyy#, external data ic time/date control flag ! -! = -2: same as 0, but superimpose seasonal cycle ! -! from climatology data set. ! -! = -1: use user provided external data for the ! -! forecast time, no extrapolation. ! -! = 0: use data at initial cond time, if not ! -! available, use latest, no extrapolation. ! -! = 1: use data at the forecast time, if not ! -! available, use latest and extrapolation. ! -! =yyyy0: use yyyy data for the forecast time, ! -! no further data extrapolation. ! -! =yyyy1: use yyyy data for the fcst. if needed, do ! -! extrapolation to match the fcst time. ! -! ! -! module variables: ! -! loz1st : first-time clim ozone data read flag ! -! ! -! subroutines called: sol_update, aer_update, gas_update ! -! ! -! =================================================================== ! -! - use module_radiation_astronomy, only : sol_update - use module_radiation_aerosols, only : aer_update - use module_radiation_gases, only : gas_update - - implicit none - -! --- inputs: - integer, intent(in) :: idate(:), jdate(:), me - logical, intent(in) :: lsswr - - real (kind=kind_phys), intent(in) :: deltsw, deltim - -! --- outputs: - real (kind=kind_phys), intent(out) :: slag, sdec, cdec, solcon - -! --- locals: - integer :: iyear, imon, iday, ihour - integer :: kyear, kmon, kday, khour - - logical :: lmon_chg ! month change flag - logical :: lco2_chg ! cntrl flag for updating co2 data - logical :: lsol_chg ! cntrl flag for updating solar constant -! -!===> ... begin here -! -!> -# Set up time stamp at fcst time and that for green house gases -!! (currently co2 only) -! --- ... time stamp at fcst time - - iyear = jdate(1) - imon = jdate(2) - iday = jdate(3) - ihour = jdate(5) - -! --- ... set up time stamp used for green house gases (** currently co2 only) - - if ( ictmflg==0 .or. ictmflg==-2 ) then ! get external data at initial condition time - kyear = idate(1) - kmon = idate(2) - kday = idate(3) - khour = idate(5) - else ! get external data at fcst or specified time - kyear = iyear - kmon = imon - kday = iday - khour = ihour - endif ! end if_ictmflg_block - - if ( month0 /= imon ) then - lmon_chg = .true. - month0 = imon - else - lmon_chg = .false. - endif - -!> -# Call module_radiation_astronomy::sol_update(), yearly update, no -!! time interpolation. - if (lsswr) then - - if ( isolar == 0 .or. isolar == 10 ) then - lsol_chg = .false. - elseif ( iyear0 /= iyear ) then - lsol_chg = .true. - else - lsol_chg = ( isolar==4 .and. lmon_chg ) - endif - iyear0 = iyear - - call sol_update & -! --- inputs: - & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & -! --- outputs: - & slag,sdec,cdec,solcon & - & ) - - endif ! end_if_lsswr_block - -!> -# Call module_radiation_aerosols::aer_update(), monthly update, no -!! time interpolation - if ( lmon_chg ) then - call aer_update ( iyear, imon, me ) - endif - -!> -# Call co2 and other gases update routine: -!! module_radiation_gases::gas_update() - if ( monthd /= kmon ) then - monthd = kmon - lco2_chg = .true. - else - lco2_chg = .false. - endif - - call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me ) - - if ( loz1st ) loz1st = .false. - -!> -# Call surface update routine (currently not needed) -! call sfc_update ( iyear, imon, me ) - -!> -# Call clouds update routine (currently not needed) -! call cld_update ( iyear, imon, me ) -! - return -!................................... - end subroutine radupdate -!----------------------------------- - -!! @} + if (.not.is_initialized) return + + ! do finalization stuff if needed + is_initialized = .false. + + end subroutine GFS_rrtmgp_setup_finalize end module GFS_rrtmgp_setup diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 index ad4d06e5f..02f32096a 100644 --- a/physics/rrtmg_lw_cloud_optics.F90 +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -1,6 +1,5 @@ module mo_rrtmg_lw_cloud_optics use machine, only: kind_phys - use physparam, only: ilwcliq, ilwcice use mersenne_twister, only: random_setseed, random_number, random_stat implicit none @@ -554,13 +553,15 @@ module mo_rrtmg_lw_cloud_optics ! subroutine rrtmg_lw_cloud_optics ! ####################################################################################### subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld_iwp, & - cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, tau_cld, & - tau_precip) + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, ilwcliq, & + ilwcice, tau_cld, tau_precip) ! Inputs integer,intent(in) :: & nBandsLW, & ! Number of spectral bands ncol, & ! Number of horizontal gridpoints - nlay ! Number of vertical layers + nlay, & ! Number of vertical layers + ilwcliq, & ! + ilwcice real(kind_phys), dimension(ncol,nlay), intent(in) :: & cld_frac, & ! Cloud-fraction (1) cld_lwp, & ! Cloud liquid water path (g/m2) diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/rrtmg_sw_cloud_optics.F90 index 452ab2070..01cab76e2 100644 --- a/physics/rrtmg_sw_cloud_optics.F90 +++ b/physics/rrtmg_sw_cloud_optics.F90 @@ -1,6 +1,5 @@ module mo_rrtmg_sw_cloud_optics use machine, only: kind_phys - use physparam, only: iswcliq, iswcice use mersenne_twister, only: random_setseed, random_number, random_stat implicit none @@ -2044,13 +2043,15 @@ module mo_rrtmg_sw_cloud_optics ! rrtmg_sw_cloud_optics ! ######################################################################################### subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld_iwp, & - cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, & - tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip) + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, iswcliq, & + iswcice, tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip) ! Inputs integer,intent(in) :: & nBandsSW, & ! Number of spectral bands ncol, & ! Number of horizontal gridpoints - nlay ! Number of vertical layers + nlay, & ! Number of vertical layers + iswcliq, & ! + iswcice ! real(kind_phys), dimension(ncol,nlay), intent(in) :: & cld_frac, & ! Cloud-fraction (1) cld_lwp, & ! Cloud liquid water path (g/m2) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 93e38994b..f45f08dd1 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -270,11 +270,11 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \section arg_table_rrtmgp_lw_cloud_optics_run !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PADE, & - doGP_cldoptics_LUT, nCol, nLev, nrghice, p_lay, cld_frac, cld_lwp, cld_reliq, & - cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & - lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, lw_optical_props_cloudsByBand, & - lw_optical_props_precipByBand, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nrghice, p_lay, cld_frac, & + cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & + precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & + lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -285,7 +285,9 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PAD integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels - nrghice ! Number of ice-roughness categories + nrghice, & ! Number of ice-roughness categories + icliq_lw, & ! Choice of treatment of liquid cloud optical properties (RRTMG legacy) + icice_lw ! Choice of treatment of ice cloud optical properties (RRTMG legacy) real(kind_phys), dimension(nCol), intent(in) :: & lon, & ! Longitude lat ! Latitude @@ -378,7 +380,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, doGP_cldoptics_PAD if (any(cld_frac .gt. 0)) then call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & - cld_frac, tau_cld, tau_precip) + cld_frac, icliq_lw, icice_lw, tau_cld, tau_precip) endif lw_optical_props_cloudsByBand%tau = tau_cld lw_optical_props_precipByBand%tau = tau_precip diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index d6575fa14..809e8abf0 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -127,6 +127,22 @@ type = logical intent = in optional = F +[icliq_lw] + standard_name = flag_for_optical_property_for_liquid_clouds_for_longwave_radiation + long_name = lw optical property for liquid clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icice_lw] + standard_name = flag_for_optical_property_for_ice_clouds_for_longwave_radiation + long_name = lw optical property for ice clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F [doGP_cldoptics_PADE] standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE long_name = logical flag to control cloud optics scheme. diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 00418edec..d95dbf8c1 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -140,13 +140,11 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, rng3D(:,iLay,iCol) = rng1D enddo endif -! call random_number(rng1D,rng_stat) -! rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo ! Cloud-overlap. - ! Maximum-random - if (iovr == iovr_maxrand .or. iovr == iovr_rand) then + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then call sampled_mask(rng3D, cld_frac, cldfracMCICA) endif ! Exponential decorrelation length overlap @@ -167,7 +165,9 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, overlap_param = cloud_overlap_param(:,1:nLev-1)) endif + ! ! Sampling. Map band optical depth to each g-point using McICA + ! call check_error_msg('rrtmgp_lw_cloud_sampling_run_draw_samples',& draw_samples(cldfracMCICA, & lw_optical_props_cloudsByBand, & @@ -202,11 +202,11 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, !enddo ! Precipitation overlap. - ! Maximum-random - if (iovr == iovr_maxrand) then + ! Maximum-random, random or maximum. + if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then call sampled_mask(rng3D, precip_frac, precipfracSAMP) endif - ! Exponential decorrelation length overlap + ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then ! No need to call RNG second time for now, just use the same seeds for precip as clouds. !! Generate second RNG @@ -225,8 +225,9 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, overlap_param = precip_overlap_param(:,1:nLev-1)) endif - + ! ! Sampling. Map band optical depth to each g-point using McICA + ! call check_error_msg('rrtmgp_lw_precip_sampling_run_draw_samples',& draw_samples(precipfracSAMP, & lw_optical_props_precipByBand, & diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index e1b8fec33..505fe7853 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -286,10 +286,10 @@ end subroutine rrtmgp_sw_cloud_optics_init !! \section arg_table_rrtmgp_sw_cloud_optics_run !! \htmlinclude rrtmgp_sw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PADE, & - doGP_cldoptics_LUT, nCol, nLev, nDay, idxday, nrghice, cld_frac, cld_lwp, cld_reliq, & - cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, precip_frac, & - sw_cloud_props, sw_gas_props, sw_optical_props_cloudsByBand, & + subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nDay, idxday, nrghice, cld_frac,& + cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & + precip_frac, sw_cloud_props, sw_gas_props, sw_optical_props_cloudsByBand, & sw_optical_props_precipByBand, cldtausw, errmsg, errflg) ! Inputs @@ -302,7 +302,9 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels nday, & ! Number of daylit points. - nrghice ! Number of ice-roughness categories + nrghice, & ! Number of ice-roughness categories + icliq_sw, & ! Choice of treatment of liquid cloud optical properties (RRTMG legacy) + icice_sw ! Choice of treatment of ice cloud optical properties (RRTMG legacy) integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. real(kind_phys), dimension(ncol,nLev),intent(in) :: & @@ -416,7 +418,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, doGP_cldoptics_PAD cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & - cld_frac(idxday(1:nday),:), & + cld_frac(idxday(1:nday),:), icliq_sw, icice_sw, & tau_cld, ssa_cld, asy_cld, & tau_precip, ssa_precip, asy_precip) diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index 0251120d3..4439a607b 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -143,6 +143,22 @@ type = logical intent = in optional = F +[icliq_sw] + standard_name = flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation + long_name = sw optical property for liquid clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icice_sw] + standard_name = flag_for_optical_property_for_ice_clouds_for_shortwave_radiation + long_name = sw optical property for ice clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F [doGP_cldoptics_PADE] standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE long_name = logical flag to control cloud optics scheme. diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index b437be5bd..396e65671 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -139,8 +139,8 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd enddo ! Cloud overlap. - ! Maximum-random overlap - if (iovr == iovr_maxrand) then + ! Maximum-random, random, or maximum cloud overlap + if (iovr == iovr_maxrand .or. iovr == iovr_max .or. iovr == iovr_rand) then call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA) endif ! Decorrelation-length overlap @@ -154,13 +154,15 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1),& randoms2 = rng3D2) endif - ! Exponential overlap + ! Exponential or exponential-random cloud overlap if (iovr == iovr_exp .or. iovr == iovr_exprand) then call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA, & overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1)) endif - + + ! ! Sampling. Map band optical depth to each g-point using McICA + ! call check_error_msg('rrtmgp_sw_cloud_sampling_run_draw_samples', & draw_samples(cldfracMCICA, & sw_optical_props_cloudsByBand, & @@ -195,11 +197,11 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd !enddo ! Precipitation overlap - ! Maximum-random - if (iovr == iovr_maxrand) then + ! Maximum-random, random or maximum precipitation overlap + if (iovr == iovr_maxrand .or. iovr == iovr_max .or. iovr == iovr_rand) then call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:), precipfracSAMP) endif - ! Exponential decorrelation length overlap + ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then !! Generate second RNG !do iday=1,nday @@ -216,7 +218,9 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1)) endif - ! Map band optical depth to each g-point using McICA + ! + ! Sampling. Map band optical depth to each g-point using McICA + ! call check_error_msg('rrtmgp_sw_precip_sampling_run_draw_samples', & draw_samples(precipfracSAMP, & sw_optical_props_precipByBand, & From e7b4531d5fa5d0aae4ec4f96105354c3ffb68df2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 3 Nov 2020 07:25:36 -0700 Subject: [PATCH 098/274] physics/GFS_surface_composites.F90: update tsfc correctly when there is ice on open water grid points --- physics/GFS_surface_composites.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index b3000b008..cc61662d2 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -547,6 +547,7 @@ subroutine GFS_surface_composites_post_run ( if (.not. flag_cice(i)) then tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) zorl(i) = cice(i) * zorl_ice(i) + (one - cice(i)) * zorl_wat(i) + tsfc(i) = tsfc_ice(i) elseif (wet(i)) then if (cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice txi = cice(i) From 58bee865180c25ccbc8f404f9e55bc2706127e15 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 3 Nov 2020 18:57:52 +0000 Subject: [PATCH 099/274] Bug fix in hydraulic conductivity computation. --- physics/module_sf_ruclsm.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 024f97772..f7ce8cfbe 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -6197,7 +6197,13 @@ SUBROUTINE SOILPROP( debug_print, & !--- Next 3 lines are for Johansen thermal conduct. gamd=(1.-ws)*2700. kdry=(0.135*gamd+64.7)/(2700.-0.947*gamd) - kas=kqwrtz**qwrtz*kzero**(1.-qwrtz) + !kas=kqwrtz**qwrtz*kzero**(1.-qwrtz) + !-- one more option from Christa's paper + if(qwrtz > 0.2) then + kas=kqwrtz**qwrtz*kzero**(1.-qwrtz) + else + kas=kqwrtz**qwrtz*3.**(1.-qwrtz) + endif DO K=1,NZS1 tn=tav(k) - 273.15 @@ -6256,13 +6262,13 @@ SUBROUTINE SOILPROP( debug_print, & if((ws-a).lt.0.12)then diffu(K)=0. else - H=max(0.,(soilmoism(K)-a)/(max(1.e-8,(dqm-a)))) + H=max(0.,(soilmoism(K)+qmin-a)/(max(1.e-8,(dqm-a)))) facd=1. if(a.ne.0.)facd=1.-a/max(1.e-8,soilmoism(K)) ame=max(1.e-8,dqm-riw*soilicem(K)) !--- DIFFU is diffusional conductivity of soil water diffu(K)=-BCLH*KSAT*PSIS/ame* & - (dqm/ame)**3. & + (ws/ame)**3. & *H**(BCLH+2.)*facd endif @@ -6288,7 +6294,7 @@ SUBROUTINE SOILPROP( debug_print, & fach=1. if(soilice(k).ne.0.) & fach=1.-riw*soilice(k)/max(1.e-8,soilmois(k)) - am=max(1.e-8,dqm-riw*soilice(k)) + am=max(1.e-8,ws-riw*soilice(k)) !--- HYDRO is hydraulic conductivity of soil water hydro(K)=min(KSAT,KSAT/am* & (soiliqw(K)/am) & From 7b0434bfc10389f1284a58b4c7f890fb3ee326ba Mon Sep 17 00:00:00 2001 From: Tanya Smirnova Date: Wed, 4 Nov 2020 20:45:42 +0000 Subject: [PATCH 100/274] A version that uses local arrays for albedo over land and ice. --- physics/sfc_drv_ruc.F90 | 77 +++++++++++++++------------------------- physics/sfc_drv_ruc.meta | 18 ---------- 2 files changed, 28 insertions(+), 67 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 985bee414..f84583a35 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -204,8 +204,6 @@ end subroutine lsm_ruc_finalize ! shdmin - real, min fractional coverage of green veg im ! ! shdmax - real, max fractnl cover of green veg (not used) im ! ! snoalb - real, upper bound on max albedo over deep snow im ! -! sfalb - real, mean sfc diffused sw albedo with effect ! -! of snow (fractional) im ! ! flag_iter- logical, im ! ! flag_guess-logical, im ! ! isot - integer, sfc soil type data source zobler or statsgo ! @@ -265,8 +263,8 @@ subroutine lsm_ruc_run & ! inputs & ch_wat, tskin_wat, & ! --- in/outs for ice and land & semis_lnd, semis_ice, & - & sncovr1_lnd, weasd_lnd, snwdph_lnd, tskin_lnd, sfalb_lnd, & - & sncovr1_ice, weasd_ice, snwdph_ice, tskin_ice, sfalb_ice, & + & sncovr1_lnd, weasd_lnd, snwdph_lnd, tskin_lnd, & + & sncovr1_ice, weasd_ice, snwdph_ice, tskin_ice, & ! for land & smois, tsice, tslb, sh2o, keepfr, smfrkeep, & ! on RUC levels & canopy, trans, tsurf_lnd, tsnow_lnd, z0rl_lnd, & @@ -335,11 +333,11 @@ subroutine lsm_ruc_run & ! inputs ! for land & weasd_lnd, snwdph_lnd, tskin_lnd, & & tsurf_lnd, z0rl_lnd, tsnow_lnd, & - & sfcqc_lnd, sfcqv_lnd, sfcdew_lnd, sfalb_lnd, & + & sfcqc_lnd, sfcqv_lnd, sfcdew_lnd, & ! for ice & weasd_ice, snwdph_ice, tskin_ice, & & tsurf_ice, z0rl_ice, tsnow_ice, & - & sfcqc_ice, sfcqv_ice, sfcdew_ice, fice, tice, sfalb_ice + & sfcqc_ice, sfcqv_ice, sfcdew_ice, fice, tice ! --- in real (kind=kind_phys), dimension(im), intent(in) :: & @@ -372,12 +370,12 @@ subroutine lsm_ruc_run & ! inputs & acsnow_old, wetness_old, & ! for land & weasd_lnd_old, snwdph_lnd_old, tskin_lnd_old, & - & tsnow_lnd_old, snowfallac_lnd_old, sfalb_lnd_old, & + & tsnow_lnd_old, snowfallac_lnd_old, & & sfcqv_lnd_old, sfcqc_lnd_old, z0rl_lnd_old, & & sncovr1_lnd_old, & ! for ice & weasd_ice_old, snwdph_ice_old, tskin_ice_old, & - & tsnow_ice_old, snowfallac_ice_old, sfalb_ice_old, & + & tsnow_ice_old, snowfallac_ice_old, & & sfcqv_ice_old, sfcqc_ice_old, z0rl_ice_old, & & sncovr1_ice_old @@ -486,30 +484,6 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'flag_restart =',flag_restart endif - !if( (flag_init .and. iter==1)) then - do i = 1, im ! n - horizontal loop - ! - Initialize land and ice surface albedo - if(land(i)) then - ! snow-free - sfalb_lnd(i) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) - if (weasd_lnd(i) > 0.) then - !- averaged of snow-free and snow-covered - sfalb_lnd(i) = sfalb_lnd(i) * (1.-sncovr1_lnd(i)) + snoalb(i) * sncovr1_lnd(i) - endif - endif - - if(icy(i)) then - ! snow-free ice - sfalb_ice(i) = 0.55 - if (weasd_ice(i) > 0.) then - ! averaged of snow-free and snow-covered ice - sfalb_ice(i) = sfalb_ice(i) * (1.-sncovr1_ice(i)) + 0.75 * sncovr1_ice(i) - endif - endif - - enddo ! i - !endif ! flag_init=.true.,iter=1 - ims = 1 its = 1 ime = 1 @@ -586,7 +560,6 @@ subroutine lsm_ruc_run & ! inputs tskin_lnd_old(i) = tskin_lnd(i) tsnow_lnd_old(i) = tsnow_lnd(i) snowfallac_lnd_old(i) = snowfallac_lnd(i) - sfalb_lnd_old(i) = sfalb_lnd(i) sfcqv_lnd_old(i) = sfcqv_lnd(i) sfcqc_lnd_old(i) = sfcqc_lnd(i) z0rl_lnd_old(i) = z0rl_lnd(i) @@ -597,7 +570,6 @@ subroutine lsm_ruc_run & ! inputs tskin_ice_old(i) = tskin_ice(i) tsnow_ice_old(i) = tsnow_ice(i) snowfallac_ice_old(i) = snowfallac_ice(i) - sfalb_ice_old(i) = sfalb_ice(i) sfcqv_ice_old(i) = sfcqv_ice(i) sfcqc_ice_old(i) = sfcqc_ice(i) z0rl_ice_old(i) = z0rl_ice(i) @@ -778,7 +750,6 @@ subroutine lsm_ruc_run & ! inputs !!\n \a sfcems - surface emmisivity -> sfcemis !!\n \a 0.5*(alvwf + alnwf) - backround snow-free surface albedo (fraction) -> albbck !!\n \a snoalb - upper bound on maximum albedo over deep snow -> snoalb1d -!!\n \a sfalb - surface albedo including snow effect (unitless fraction) -> alb if(ivegsrc == 1) then ! IGBP - MODIS vtype_wat(i,j) = 17 ! 17 - water (oceans and lakes) in MODIS @@ -837,16 +808,23 @@ subroutine lsm_ruc_run & ! inputs !!\n \a qcg_lnd - cloud water mixing ratio at surface (\f$kg kg^{-1}\f$) !!\n \a solnet_lnd - net sw radiation flux (dn-up) (\f$W m^{-2}\f$) - solnet_lnd(i,j) = dswsfc(i)*(1.-sfalb_lnd(i)) !snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 qvg_lnd(i,j) = sfcqv_lnd(i) qsfc_lnd(i,j) = sfcqv_lnd(i)/(1.+sfcqv_lnd(i)) qsg_lnd(i,j) = rslf(prsl1(i),tsurf_lnd(i)) qcg_lnd(i,j) = sfcqc_lnd(i) sfcems_lnd(i,j) = semis_lnd(i) + sncovr_lnd(i,j) = sncovr1_lnd(i) snoalb1d_lnd(i,j) = snoalb(i) albbck_lnd(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) - ! sfalb_lnd takes into account snow on the ground - alb_lnd(i,j) = sfalb_lnd(i) + ! alb_lnd takes into account snow on the ground + if (sncovr_lnd(i,j) > 0.) then + !- averaged of snow-free and snow-covered + alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) + else + alb_lnd(i,j) = albbck_lnd(i,j) + endif + solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 + cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! clu_q2m_iter tsnav_lnd(i,j) = 0.5*(soilt_lnd(i,j) + soilt1_lnd(i,j)) - 273.15 @@ -880,7 +858,6 @@ subroutine lsm_ruc_run & ! inputs snowh_lnd(i,j) = snwdph_lnd(i) * 0.001 ! convert from mm to m sneqv_lnd(i,j) = weasd_lnd(i) ! [mm] snfallac_lnd(i,j) = snowfallac_lnd(i) - sncovr_lnd(i,j) = sncovr1_lnd(i) !> -- sanity checks on sneqv and snowh if (sneqv_lnd(i,j) /= 0.0 .and. snowh_lnd(i,j) == 0.0) then snowh_lnd(i,j) = 0.003 * sneqv_lnd(i,j) ! snow density ~300 kg m-3 @@ -914,7 +891,6 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'znt(i,j) =',i,j,znt_lnd(i,j) write (0,*)'z0(i,j) =',i,j,z0_lnd(i,j) write (0,*)'snoalb1d(i,j) =',i,j,snoalb1d_lnd(i,j) - write (0,*)'alb(i,j) =',i,j,alb_lnd(i,j) write (0,*)'landusef(i,:,j) =',i,j,landusef(i,:,j) write (0,*)'soilctop(i,:,j) =',i,j,soilctop(i,:,j) write (0,*)'nlcat=',nlcat @@ -1105,7 +1081,6 @@ subroutine lsm_ruc_run & ! inputs ! ---- ... outside RUC LSM, roughness uses cm as unit ! (update after snow's effect) z0rl_lnd(i) = znt_lnd(i,j)*100. - sfalb_lnd(i)= alb_lnd(i,j) do k = 1, lsoil_ruc smois(i,k) = smsoil(i,k,j) @@ -1124,15 +1099,23 @@ subroutine lsm_ruc_run & ! inputs if (flag_ice_uncoupled(i)) then ! at least some ice in the grid cell !-- ice point - solnet_ice(i,j) = dswsfc(i)*(1.-sfalb_ice(i)) + sncovr_ice(i,j) = sncovr1_ice(i) + snoalb1d_ice(i,j) = 0.75 ! RAP value for max snow alb on ice + albbck_ice(i,j) = 0.55 ! RAP value for ice alb + if (sncovr_ice(i,j) > 0.) then + !- averaged of snow-free and snow-covered ice + alb_ice(i,j) = albbck_ice(i,j) * (1.-sncovr_ice(i,j)) + snoalb1d_ice(i,j) * sncovr_ice(i,j) + else + ! snow-free ice + alb_ice(i,j) = albbck_ice(i,j) + endif + + solnet_ice(i,j) = dswsfc(i)*(1.-alb_ice(i,j)) qvg_ice(i,j) = sfcqv_ice(i) qsfc_ice(i,j) = sfcqv_ice(i)/(1.+sfcqv_ice(i)) qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i)) qcg_ice(i,j) = sfcqc_ice(i) sfcems_ice(i,j) = semis_ice(i) - snoalb1d_ice(i,j) = 0.75 ! RAP value for max snow alb on ice - albbck_ice(i,j) = 0.55 ! RAP value for ice alb - alb_ice(i,j) = sfalb_ice(i) soilt_ice(i,j) = tsurf_ice(i) ! clu_q2m_iter tsnav_ice(i,j) = 0.5*(soilt_ice(i,j) + soilt1_ice(i,j)) - 273.15 if (tsnow_ice(i) > 0. .and. tsnow_ice(i) < 273.15) then @@ -1157,7 +1140,6 @@ subroutine lsm_ruc_run & ! inputs cmm_ice(i) = cm_ice (i) * wind(i) chh_ice(i) = chs_ice(i,j) * rho(i) - sncovr_ice(i,j) = sncovr1_ice(i) snowh_ice(i,j) = snwdph_ice(i) * 0.001 ! convert from mm to m sneqv_ice(i,j) = weasd_ice(i) ! [mm] @@ -1238,7 +1220,6 @@ subroutine lsm_ruc_run & ! inputs weasd_ice(i) = sneqv_ice(i,j) ! mm sncovr1_ice(i) = sncovr_ice(i,j) z0rl_ice(i) = znt_ice(i,j)*100. - sfalb_ice(i)= alb_ice(i,j) do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) @@ -1315,7 +1296,6 @@ subroutine lsm_ruc_run & ! inputs tsnow_lnd(i) = tsnow_lnd_old(i) snowfallac_lnd(i) = snowfallac_lnd_old(i) acsnow(i) = acsnow_old(i) - sfalb_lnd(i) = sfalb_lnd_old(i) sfcqv_lnd(i) = sfcqv_lnd_old(i) sfcqc_lnd(i) = sfcqc_lnd_old(i) wetness(i) = wetness_old(i) @@ -1327,7 +1307,6 @@ subroutine lsm_ruc_run & ! inputs tskin_ice(i) = tskin_ice_old(i) tsnow_ice(i) = tsnow_ice_old(i) snowfallac_ice(i) = snowfallac_ice_old(i) - sfalb_ice(i) = sfalb_ice_old(i) sfcqv_ice(i) = sfcqv_ice_old(i) sfcqc_ice(i) = sfcqc_ice_old(i) z0rl_ice(i) = z0rl_ice_old(i) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index ba61ed899..31baf5628 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -870,15 +870,6 @@ kind = kind_phys intent = inout optional = F -[sfalb_lnd] - standard_name = surface_diffused_shortwave_albedo_over_land - long_name = mean surface diffused sw albedo over land with snow effect - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [sncovr1_ice] standard_name = surface_snow_area_fraction_over_ice long_name = surface snow area fraction over ice @@ -915,15 +906,6 @@ kind = kind_phys intent = inout optional = F -[sfalb_ice] - standard_name = surface_diffused_shortwave_albedo_over_ice - long_name = mean surface diffused sw albedo over ice with snow effect - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [smois] standard_name = volume_fraction_of_soil_moisture_for_land_surface_model long_name = volumetric fraction of soil moisture for lsm From e3f7f64df3b232d080df1e186798abf2b24e1067 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 20 Oct 2020 14:02:59 -0600 Subject: [PATCH 101/274] Fix uninitialized variable mvd_r in physics/module_mp_thompson.F90 From 8b3545ae6ca54e51f31e6701e13f2c5bdd5e063a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 5 Nov 2020 15:48:35 -0700 Subject: [PATCH 102/274] Add reminders for sncovr_ice initialization to GFS_phys_time_vary.{fv3,scm}.F90 --- physics/GFS_phys_time_vary.fv3.F90 | 1 + physics/GFS_phys_time_vary.scm.F90 | 1 + 2 files changed, 2 insertions(+) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 3c894b777..d547eb308 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -519,6 +519,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, endif enddo enddo + ! DH* 20201104: don't forget snocvr_ice for RUC LSM (see FV3GFS_io.F90) endif endif #endif diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 5fcc9ed84..ece9d5ee9 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -389,6 +389,7 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, endif endif enddo + ! DH* 20201104: don't forget snocvr_ice for RUC LSM (see FV3GFS_io.F90) endif endif #endif From 0d22b36916930503fc5febbc18ea04bff19dc49a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 6 Nov 2020 01:32:10 +0000 Subject: [PATCH 103/274] Synced with NCAR master --- physics/radiation_clouds.f | 1 - physics/radlw_main.F90 | 24 ++++++++++++------------ physics/radsw_main.F90 | 16 ++++++++-------- physics/rrtmgp_lw_cloud_sampling.meta | 4 ++-- physics/rrtmgp_sw_cloud_sampling.meta | 4 ++-- 5 files changed, 24 insertions(+), 25 deletions(-) diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 4a83c040e..056bede28 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -4554,7 +4554,6 @@ SUBROUTINE adjust_cloudFinal(cfr, qc, qi, Rho,dz, kts,kte,k_tropo) END SUBROUTINE adjust_cloudFinal ! ->>>>>>> c95a1ae3a8ce59cb09f9383557688a59d462d103 !........................................! end module module_radiation_clouds ! !! @} diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index d2a4fa72b..f2c3ee034 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -852,7 +852,7 @@ subroutine rrtmg_lw_run & if (iovr == 3) delgth= de_lgth(iplon) ! clouds decorr-length ! mz*: HWRF - if (iovrlw == 4 ) then + if (iovr == 4 ) then !Add layer height needed for exponential (icld=4) and ! exponential-random (icld=5) overlap options @@ -876,7 +876,7 @@ subroutine rrtmg_lw_run & enddo enddo - call mcica_subcol_lw(1, iplon, nlay, iovrlw, permuteseed, & + call mcica_subcol_lw(1, iplon, nlay, iovr, permuteseed, & & irng, plyr, hgt, & & cld_cf, cld_iwp, cld_lwp,cld_swp, & & cld_ref_ice, cld_ref_liq, & @@ -989,7 +989,7 @@ subroutine rrtmg_lw_run & cda4(k) = cld_ref_snow(iplon,k1) enddo ! HWRF RRMTG - if (iovrlw == 4) then !mz HWRF + if (iovr == 4) then !mz HWRF do k = 1, nlay k1 = nlp1 - k do ig = 1, ngptlw @@ -1112,7 +1112,7 @@ subroutine rrtmg_lw_run & cda3(k) = cld_swp(iplon,k) cda4(k) = cld_ref_snow(iplon,k) enddo - if (iovrlw == 4) then + if (iovr == 4) then !mz* Move incoming GCM cloud arrays to RRTMG cloud arrays. !For GCM input, incoming reicmcl is defined based on selected !ice parameterization (inflglw) @@ -1206,7 +1206,7 @@ subroutine rrtmg_lw_run & if ( lcf1 ) then !mz* for HWRF, save cldfmc with mcica - if (iovrlw == 4) then + if (iovr == 4) then do k = 1, nlay do ig = 1, ngptlw cldfmc_save(ig,k)=cldfmc (ig,k) @@ -1217,12 +1217,12 @@ subroutine rrtmg_lw_run & call cldprop & ! --- inputs: & ( cldfrc,clwp,relw,ciwp,reiw,cda1,cda2,cda3,cda4, & - & nlay, nlp1, ipseed(iplon), dz, delgth, iovrlw, alph, & + & nlay, nlp1, ipseed(iplon), dz, delgth, iovr, alph, & ! --- outputs: & cldfmc, taucld & & ) - if (iovrlw == 4) then + if (iovr == 4) then !mz for HWRF, still using mcica cldfmc do k = 1, nlay do ig = 1, ngptlw @@ -1251,7 +1251,7 @@ subroutine rrtmg_lw_run & endif !mz* HWRF: calculate taucmc with mcica - if (iovrlw == 4) then + if (iovr == 4) then call cldprmc(nlay, inflglw, iceflglw, liqflglw, & & cldfmc, ciwpmc, & & clwpmc, cswpmc, reicmc, relqmc, resnmc, & @@ -1713,7 +1713,7 @@ end subroutine rlwinit !> @{ subroutine cldprop & & ( cfrac,cliqp,reliq,cicep,reice,cdat1,cdat2,cdat3,cdat4, & ! --- inputs - & nlay, nlp1, ipseed, dz, de_lgth, iovrlw, alpha, & + & nlay, nlp1, ipseed, dz, de_lgth, iovr, alpha, & & cldfmc, taucld & ! --- outputs & ) @@ -1814,7 +1814,7 @@ subroutine cldprop & use module_radlw_cldprlw ! --- inputs: - integer, intent(in) :: nlay, nlp1, ipseed, iovrlw + integer, intent(in) :: nlay, nlp1, ipseed, iovr real (kind=kind_phys), dimension(0:nlp1), intent(in) :: cfrac real (kind=kind_phys), dimension(nlay), intent(in) :: cliqp, & @@ -1994,7 +1994,7 @@ subroutine cldprop & ! --- ... call sub-column cloud generator !mz* - if (iovrlw .ne. 4) then + if (iovr .ne. 4) then call mcica_subcol & ! --- inputs: & ( cldf, nlay, ipseed, dz, de_lgth, alpha, & @@ -2011,7 +2011,7 @@ subroutine cldprop & endif enddo enddo - endif !iovrlw + endif !iovr endif ! end if_isubclw_block diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index 60119e4a8..a63b7060c 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -982,7 +982,7 @@ subroutine rrtmg_sw_run & ! mz*: HWRF - if (iovrsw == 4 ) then + if (iovr == 4 ) then !Add layer height needed for exponential (icld=4) and @@ -993,7 +993,7 @@ subroutine rrtmg_sw_run & permuteseed = 1 !mz* Derive height of each layer mid-point from layer thickness. -! Needed for exponential (iovrsw=4) and exponential-random overlap +! Needed for exponential (iovr=4) and exponential-random overlap ! option (iovr=5)only. dzsum =0.0 do k = 1,nlay @@ -1012,7 +1012,7 @@ subroutine rrtmg_sw_run & enddo enddo - call mcica_subcol_sw (1, 1, nlay, iovrsw, permuteseed, & + call mcica_subcol_sw (1, 1, nlay, iovr, permuteseed, & & irng, plyr(j1:j1,:), hgt(j1:j1,:), & & cld_cf(j1:j1,:), cld_iwp(j1:j1,:), cld_lwp(j1:j1,:), & & cld_swp(j1:j1,:), cld_ref_ice(j1:j1,:), cld_ref_liq(j1:j1,:), & @@ -1111,7 +1111,7 @@ subroutine rrtmg_sw_run & cdat3(k) = cld_swp(j1,kk) ! cloud snow path cdat4(k) = cld_ref_snow(j1,kk) ! snow partical effctive radius enddo - if (iovrsw == 4) then !mz* HWRF + if (iovr == 4) then !mz* HWRF do k = 1, nlay kk = nlp1 - k do ig = 1, ngptsw @@ -1226,7 +1226,7 @@ subroutine rrtmg_sw_run & cdat3(k) = cld_swp(j1,k) ! cloud snow path cdat4(k) = cld_ref_snow(j1,k) ! snow partical effctive radius enddo - if (iovrsw == 4) then !mz* HWRF + if (iovr == 4) then !mz* HWRF !mz* Move incoming GCM cloud arrays to RRTMG cloud arrays. !For GCM input, incoming reicmcl is defined based on selected !ice parameterization (inflglw) @@ -1299,7 +1299,7 @@ subroutine rrtmg_sw_run & if (zcf1 > f_zero) then ! cloudy sky column !mz* for HWRF, save cldfmc with mcica - if (iovrsw == 4) then + if (iovr == 4) then do k = 1, nlay do ig = 1, ngptsw cldfmc_save(k,ig)=cldfmc (k,ig) @@ -1315,7 +1315,7 @@ subroutine rrtmg_sw_run & & taucw, ssacw, asycw, cldfrc, cldfmc & & ) - if (iovrsw == 4) then + if (iovr == 4) then !mz for HWRF, still using mcica cldfmc do k = 1, nlay do ig = 1, ngptsw @@ -2116,7 +2116,7 @@ subroutine cldprop & !> -# if physparam::isubcsw > 0, call mcica_subcol() to distribute !! cloud properties to each g-point. - if ( isubcsw > 0 .and. iovrsw /= 4 ) then ! mcica sub-col clouds approx + if ( isubcsw > 0 .and. iovr /= 4 ) then ! mcica sub-col clouds approx cldf(:) = cfrac(:) where (cldf(:) < ftiny) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 7acc6a7d3..54f3c63af 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -70,8 +70,8 @@ intent = in optional = F [isubc_lw] - standard_name = flag_for_lw_clouds_without_sub_grid_approximation - long_name = flag for lw clouds without sub-grid approximation + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation units = flag dimensions = () type = integer diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index fded88bbb..01a311fd4 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -78,8 +78,8 @@ intent = in optional = F [isubc_sw] - standard_name = flag_for_sw_clouds_without_sub_grid_approximation - long_name = flag for sw clouds without sub-grid approximation + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation units = flag dimensions = () type = integer From 8364e618a0e02bde9cf50fbda12b039794c40e65 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 6 Nov 2020 15:35:19 -0700 Subject: [PATCH 104/274] Thompson MP in GP. Not complete. --- physics/GFS_rrtmgp_pre.F90 | 20 +- physics/GFS_rrtmgp_pre.meta | 18 + physics/GFS_rrtmgp_thompsonmp_pre.F90 | 358 ++++++++++++++++ physics/GFS_rrtmgp_thompsonmp_pre.meta | 555 +++++++++++++++++++++++++ physics/module_SGSCloud_RadPre.F90 | 49 --- 5 files changed, 942 insertions(+), 58 deletions(-) create mode 100644 physics/GFS_rrtmgp_thompsonmp_pre.F90 create mode 100644 physics/GFS_rrtmgp_thompsonmp_pre.meta diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 0e5d65f5c..f4542dffb 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -143,10 +143,10 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & - fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, & - con_eps, con_epsm1, con_fvirt, con_epsqs, & - raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, tv_lay, relhum, tracer, & + subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & + fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, con_eps,& + con_epsm1, con_fvirt, con_epsqs, & + raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,& gas_concentrations, errmsg, errflg) ! Inputs @@ -195,8 +195,10 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, real(kind_phys), dimension(nCol,nLev), intent(out) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer + q_lay, & ! Water-vapor mixing ratio (kg/kg) tv_lay, & ! Virtual temperature at model-layers - relhum ! Relative-humidity at model-layers + relhum, & ! Relative-humidity at model-layers + qs_lay ! Saturation vapor pressure at model-layers real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface @@ -209,8 +211,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, integer :: i, j, iCol, iBand, iSFC, iTOA, iLay logical :: top_at_1 real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o - real(kind_phys) :: es, qs, tem1, tem2 - real(kind_phys), dimension(nCol,nLev) :: o3_lay, q_lay + real(kind_phys) :: es, tem1, tem2 + real(kind_phys), dimension(nCol,nLev) :: o3_lay real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables @@ -265,8 +267,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, do iCol=1,NCOL do iLay=1,nLev es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa - qs = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) - relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs ) ) + qs_lay(iCol,iLay) = max( con_epsqs, con_eps * es / (p_lay(iCol,iLay) + con_epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(con_epsqs, q_lay(iCol,iLay))/qs_lay(iCol,iLay) ) ) tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + con_fvirt*q_lay(iCol,iLay)) enddo enddo diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 7fa69c0f6..904c0e4e7 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -328,6 +328,24 @@ kind = kind_phys intent = out optional = F +[qs_lay] + standard_name = saturation_vapor_pressure + long_name = saturation vapor pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water vaport mixing ratio + units = kg/kg + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F [tracer] standard_name = chemical_tracers long_name = chemical tracers diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 new file mode 100644 index 000000000..f815ba0cc --- /dev/null +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -0,0 +1,358 @@ +! ######################################################################################## +! This module contains the interface between the THOMPSON macrophysics and the RRTMGP radiation +! schemes. Only compatable with Model%imp_physics = Model%imp_physics_thompson +! ######################################################################################## +module GFS_rrtmgp_thompsonmp_pre + use machine, only: & + kind_phys + use rrtmgp_aux, only: & + check_error_msg + use module_radiation_cloud_overlap, only: & + cmp_dcorr_lgth, & + get_alpha_exp + use module_mp_thompson, only: & + calc_effectRad, & + Nt_c + use module_mp_thompson_make_number_concentrations, only: & + make_IceNumber, & + make_DropletNumber, & + make_RainNumber + + ! Parameters specific to THOMPSONMP scheme. + real(kind_phys), parameter :: & + reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) + reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) + rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) + resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) + cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme + + public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_thompsonmp_pre_init() + end subroutine GFS_rrtmgp_thompsonmp_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run +!! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html +!! + subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice,& + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, yearlen, doSWrad, doLWrad, effr_in, julian, & + lat, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, & + qs_lay, q_lay, relhum, cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, lmfdeep2, ltaerosol, & + iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, idcor_hogan, idcor_oreopoulos, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & + deltaZb, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + ncnd, & ! Number of cloud condensation types. + nTracers, & ! Number of tracers from model. + i_cldliq, & ! Index into tracer array for cloud liquid amount. + i_cldice, & ! cloud ice amount. + i_cldrain, & ! cloud rain amount. + i_cldsnow, & ! cloud snow amount. + i_cldgrpl, & ! cloud groupel amount. + i_cldtot, & ! cloud total amount. + i_cldliq_nc, & ! cloud liquid number concentration. + i_cldice_nc, & ! cloud ice number concentration. + i_twa, & ! water friendly aerosol. + yearlen, & ! Length of current year (365/366) WTF? + iovr, & ! Choice of cloud-overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + idcor, & ! Choice of method for decorrelation length computation + idcor_con, & ! Flag for decorrelation-length. Use constant value + idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + logical, intent(in) :: & + doSWrad, & ! Call SW radiation? + doLWrad, & ! Call LW radiation + effr_in, & ! Use cloud effective radii provided by model? + uni_cld, & ! + lmfshal, & ! + lmfdeep2, & ! + ltaerosol ! + real(kind_phys), intent(in) :: & + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq, & ! Physical constant(?): Minimum value for specific humidity + dcorr_con ! Decorrelation-length (used if idcor = 0, default is idcor = 1) + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude (radians) + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + t_lay, & ! Temperature (K) + qs_lay, & ! Saturation vapor pressure (Pa) + q_lay, & ! water-vapor mixing ratio (kg/kg) + relhum, & ! Relative humidity + p_lay, & ! Pressure at model-layers (Pa) + cld_frac_mg ! Cloud-fraction from MG scheme. WTF????? + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + + ! In/Outs + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) + effrin_cldice, & ! Effective radius for ice cloud-particles (microns) + effrin_cldsnow ! Effective radius for snow cloud-particles (microns) + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac, & ! Precipitation fraction + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param, & ! Precipitation overlap parameter + deltaZb ! Layer thickness (km) + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, xrc3 + real(kind_phys), dimension(nLev+1) :: hgtb + real(kind_phys), dimension(nLev) :: hgtc + real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate + integer :: iCol,iLay,l,iSFC,iTOA + real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& + re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa + logical :: top_at_1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. (doSWrad .or. doLWrad)) return + + ! What is vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + ! Initialize outputs + cld_lwp(:,:) = 0.0 + cld_reliq(:,:) = 0.0 + cld_iwp(:,:) = 0.0 + cld_reice(:,:) = 0.0 + cld_rwp(:,:) = 0.0 + cld_rerain(:,:) = 0.0 + cld_swp(:,:) = 0.0 + cld_resnow(:,:) = 0.0 + + ! #################################################################################### + ! Pull out cloud information for THOMPSON MP scheme. + ! #################################################################################### + + ! Cloud condensate + cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water + cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water + cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water + cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel + tracer(1:nCol,1:nLev,i_cldgrpl) + + ! + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds + ! + + ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re + rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) + orho = 1./rho + do iLay = 1, nLev + do iCol = 1, nCol + qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) + qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) + qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) + qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) + nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + if (ltaerosol) then + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) + else + nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + endif + enddo + enddo + + ! Update number concentration, consistent with sub-grid clouds + do iLay = 1, nLev + do iCol = 1, nCol + if (ltaerosol .and. qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then + nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho(iCol,iLay), nwfa(iCol,iLay)) * orho(iCol,iLay) + endif + if (qi_mp(iCol,iLay) > 1.e-12 .and. ni_mp(iCol,iLay) < 100.) then + ni_mp(iCol,iLay) = make_IceNumber(qi_mp(iCol,iLay)*rho(iCol,iLay), t_lay(iCol,iLay)) * orho(iCol,iLay) + endif + enddo + enddo + + ! Call Thompson's subroutine to compute effective radii + do iCol=1,nCol + call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & + nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & + re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) + enddo + + ! Scale Thompson's effective radii from meter to micron and update global effective radii. + effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 + effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 + effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 + + if (uni_cld) then + if (effr_in) then + cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) + cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) + cld_rerain(1:nCol,1:nLev) = rerain_def + cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) + else + cld_reliq(1:nCol,1:nLev) = reliq_def + cld_reice(1:nCol,1:nLev) = reice_def + cld_rerain(1:nCol,1:nLev) = rerain_def + cld_resnow(1:nCol,1:nLev) = resnow_def + endif ! effr_in + endif ! uni_cld + + ! Cloud-fraction + cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) + + ! Condensate and effective size + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay = 1, nLev + do iCol = 1, nCol + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + if (cld_frac(iCol,iLay) .ge. cllimit) then + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 + cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 + cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 + cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 + endif + enddo + enddo + + ! #################################################################################### + ! Cloud (and precipitation) overlap + ! #################################################################################### + + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! + do iCol=1,nCol + if (top_at_1) then + ! Layer thickness (km) + do iLay=1,nLev + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(nLev+1) = 0._kind_phys + do iLay=nLev,1,-1 + hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = nLev, 1, -1 + pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & + abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) + hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) + enddo + ! Layer thickness between centers + do iLay = nLev-1, 1, -1 + deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) + enddo + deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) + else + do iLay=nLev,1,-1 + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(1) = 0._kind_phys + do iLay=1,nLev + hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = 1, nLev + pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & + abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) + hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) + enddo + ! Layer thickness between centers + do iLay = 2, nLev + deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) + enddo + deltaZb(iCol,1) = hgtc(1) - hgtb(1) + endif + enddo + + ! + ! Cloud decorrelation length + ! + if (idcor == idcor_hogan) then + call cmp_dcorr_lgth(nCol, abs(lat/con_pi), con_pi, de_lgth) + endif + if (idcor == idcor_oreopoulos) then + call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) + endif + if (idcor == idcor_con) then + de_lgth(:) = dcorr_con + endif + + ! + ! Cloud overlap parameter + ! + call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) + + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (iovr == iovr_exprand) then + do iLay = 1, nLev + do iCol = 1, nCol + if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then + cloud_overlap_param(iCol,iLay) = 0._kind_phys + endif + enddo + enddo + endif + + ! + ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) + ! + precip_overlap_param = cloud_overlap_param + + end subroutine GFS_rrtmgp_thompsonmp_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_thompsonmp_pre_finalize() + end subroutine GFS_rrtmgp_thompsonmp_pre_finalize +end module GFS_rrtmgp_thompsonmp_pre \ No newline at end of file diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta new file mode 100644 index 000000000..a2bc0af2b --- /dev/null +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -0,0 +1,555 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_thompsonmp_pre + type = scheme + dependencies = rrtmgp_aux.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_thompspnmp_pre_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracers] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncnd] + standard_name = number_of_cloud_condensate_types + long_name = number of cloud condensate types + units = count + dimensions = () + type = integer + intent = in + optional = F +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[effr_in] + standard_name = flag_for_cloud_effective_radii + long_name = flag for cloud effective radii calculations in GFDL microphysics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[uni_cld] + standard_name = flag_for_uni_cld + long_name = flag for uni_cld + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfshal] + standard_name = flag_for_lmfshal + long_name = flag for lmfshal + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lmfdeep2] + standard_name = flag_for_scale_aware_mass_flux_convection + long_name = flag for some scale-aware mass-flux convection scheme active + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ltaerosol] + standard_name = flag_for_aerosol_physics + long_name = flag for aerosol physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[i_cldliq] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldrain] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldsnow] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldgrpl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldtot] + standard_name = index_for_cloud_amount + long_name = tracer index for cloud amount integer + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldliq_nc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_cldice_nc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[i_twa] + standard_name = index_for_water_friendly_aerosols + long_name = tracer index for water friendly aerosol + units = index + dimensions = () + type = integer + intent = in + optional = F +[effrin_cldliq] + standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um + long_name = eff. radius of cloud liquid water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[effrin_cldice] + standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um + long_name = eff. radius of cloud ice water particle in micrometer + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[effrin_cldsnow] + standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um + long_name = effective radius of cloud snow particle in micrometers + units = um + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cld_frac_mg] + standard_name = cloud_fraction_for_MG + long_name = cloud fraction used by Morrison-Gettelman MP + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[iovr] + standard_name = flag_for_cloud_overlap_method + long_name = flag for cloud overlap method used by radiation scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = F +[idcor] + standard_name = flag_for_decorrelation_length_method + long_name = flag for decorrelation length method used in cloud overlap method (iovr) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dcorr_con] + standard_name = decorreltion_length_used_by_overlap_method + long_name = decorrelation length (default) used by cloud overlap method (iovr) + units = km + dimensions = () + type = real + intent = in + kind = kind_phys + optional = F +[idcor_con] + standard_name = flag_for_constant_decorrelation_length_method + long_name = choice of decorrelation length computation (costant) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_hogan] + standard_name = flag_for_hogan_decorrelation_length_method + long_name = choice of decorrelation length computation (hogan) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_oreopoulos] + standard_name = flag_for_oreopoulos_decorrelation_length_method + long_name = choice of decorrelation length computation (oreopoulos) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qs_lay] + standard_name = saturation_vapor_pressure + long_name = saturation vapor pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q_lay] + standard_name = water_vapor_mixing_ratio + long_name = water vaport mixing ratio + units = kg/kg + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_frac] + standard_name = precipitation_fraction_by_layer + long_name = precipitation fraction in each layer + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZb] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/module_SGSCloud_RadPre.F90 b/physics/module_SGSCloud_RadPre.F90 index ebc5ea2ae..592b88e32 100644 --- a/physics/module_SGSCloud_RadPre.F90 +++ b/physics/module_SGSCloud_RadPre.F90 @@ -293,55 +293,6 @@ subroutine sgscloud_radpre_run( & endif ! timestep > 1 -!> - Compute SFC/low/middle/high cloud top pressure for each cloud domain for given latitude. - - do i =1, im - rxlat(i) = abs( xlat(i) / con_pi ) ! if xlat in pi/2 -> -pi/2 range -! rxlat(i) = abs(0.5 - xlat(i)/con_pi) ! if xlat in 0 -> pi range - enddo - - do id = 1, 4 - tem1 = ptopc(id,2) - ptopc(id,1) - do i =1, im - ptop1(i,id) = ptopc(id,1) + tem1*max( 0.0, 4.0*rxlat(i)-1.0 ) - enddo - enddo - - cldcnv = 0. - -! DH* 20200723 -! iovr == 4 or 5 requires alpha, which is computed in GFS_rrmtg_pre, -! which comes after SGSCloud_RadPre. Computing alpha here requires -! a lot more input variables and computations (dzlay etc.), and -! recomputing it in GFS_rrmtg_pre is a waste of time. Workaround: -! pass a dummy array initialized to zero to gethml for other values of iovr. - if ( iovr == 4 .or. iovr == 5 ) then - errmsg = 'Logic error in sgscloud_radpre: iovr==4 or 5 not implemented' - errflg = 1 - return - end if -!! Call subroutine get_alpha_exp to define alpha parameter for EXP and ER cloud overlap options -! if ( iovr == 4 .or. iovr == 5 ) then -! call get_alpha_exp & -!! --- inputs: -! (im, nlay, dzlay, iovr, latdeg, julian, yearlen, clouds1, & -!! --- outputs: -! alpha & -! ) -! endif - alpha_dummy = 0.0 -! *DH 2020723 - -!> - Recompute the diagnostic high, mid, low, total and bl cloud fraction - call gethml & -! --- inputs: - ( plyr, ptop1, clouds1, cldcnv, dz, de_lgth, alpha_dummy, & -! --- outputs: - im, nlay, cldsa, mtopa, mbota) - - !print*,"===Finished adding subgrid clouds to the resolved-scale clouds" - !print*,"qc_save:",qc_save(1,1)," qi_save:",qi_save(1,1) - end subroutine sgscloud_radpre_run end module sgscloud_radpre From f2291a581d5516221ac85c3d292978b7a2f87e27 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 9 Nov 2020 08:54:00 -0700 Subject: [PATCH 105/274] physics/sfc_drv_ruc.{F90,meta}: use local variables where possible, remove unneeded acsnow --- physics/sfc_drv_ruc.F90 | 30 +++++++++++++----------------- physics/sfc_drv_ruc.meta | 33 +++------------------------------ 2 files changed, 16 insertions(+), 47 deletions(-) diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index f84583a35..0d41c3e4a 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -268,18 +268,18 @@ subroutine lsm_ruc_run & ! inputs ! for land & smois, tsice, tslb, sh2o, keepfr, smfrkeep, & ! on RUC levels & canopy, trans, tsurf_lnd, tsnow_lnd, z0rl_lnd, & - & sfcqc_lnd, sfcdew_lnd, sfcqv_lnd, & + & sfcqc_lnd, sfcqv_lnd, & & qsurf_lnd, gflux_lnd, evap_lnd, hflx_lnd, & & runof, runoff, srunoff, drain, & & cm_lnd, ch_lnd, evbs, evcw, stm, wetness, & & snowfallac_lnd, & ! for ice - & sfcqc_ice, sfcdew_ice, sfcqv_ice, & + & sfcqc_ice, sfcqv_ice, & & tice, tsurf_ice, tsnow_ice, z0rl_ice, & & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, & & cm_ice, ch_ice, snowfallac_ice, & ! --- out - & acsnow, rhosnf, sbsno, & + & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & ! & flag_iter, flag_guess, flag_init, flag_restart, & @@ -333,14 +333,14 @@ subroutine lsm_ruc_run & ! inputs ! for land & weasd_lnd, snwdph_lnd, tskin_lnd, & & tsurf_lnd, z0rl_lnd, tsnow_lnd, & - & sfcqc_lnd, sfcqv_lnd, sfcdew_lnd, & + & sfcqc_lnd, sfcqv_lnd, & ! for ice & weasd_ice, snwdph_ice, tskin_ice, & & tsurf_ice, z0rl_ice, tsnow_ice, & - & sfcqc_ice, sfcqv_ice, sfcdew_ice, fice, tice + & sfcqc_ice, sfcqv_ice, fice, tice ! --- in - real (kind=kind_phys), dimension(im), intent(in) :: & + real (kind=kind_phys), dimension(im), intent(in) :: & & rainnc, rainc, ice, snow, graupel ! --- in/out: ! --- on RUC levels @@ -348,7 +348,7 @@ subroutine lsm_ruc_run & ! inputs & smois, tsice, tslb, sh2o, keepfr, smfrkeep ! --- output: - real (kind=kind_phys), dimension(im), intent(inout) :: acsnow, & + real (kind=kind_phys), dimension(im), intent(inout) :: & & rhosnf, runof, drain, runoff, srunoff, evbs, evcw, & & stm, wetness, semis_lnd, semis_ice, & ! for land @@ -366,8 +366,7 @@ subroutine lsm_ruc_run & ! inputs ! --- locals: real (kind=kind_phys), dimension(im) :: rho, & & q0, qs1, & - & tprcp_old, srflag_old, sr_old, canopy_old, & - & acsnow_old, wetness_old, & + & tprcp_old, srflag_old, sr_old, canopy_old, wetness_old, & ! for land & weasd_lnd_old, snwdph_lnd_old, tskin_lnd_old, & & tsnow_lnd_old, snowfallac_lnd_old, & @@ -553,7 +552,7 @@ subroutine lsm_ruc_run & ! inputs wetness_old(i) = wetness(i) canopy_old(i) = canopy(i) !srflag_old(i) = srflag(i) - acsnow_old(i) = acsnow(i) + !acsnow_old(i) = acsnow(i) ! for land weasd_lnd_old(i) = weasd_lnd(i) snwdph_lnd_old(i) = snwdph_lnd(i) @@ -600,8 +599,6 @@ subroutine lsm_ruc_run & ! inputs gflux_ice(i) = 0.0 drain(i) = 0.0 canopy(i) = max(canopy(i), 0.0) - sfcdew_lnd(i) = 0.0 - sfcdew_ice(i) = 0.0 evbs (i) = 0.0 evcw (i) = 0.0 @@ -735,7 +732,8 @@ subroutine lsm_ruc_run & ! inputs ! ice not used ! precipfr(i,j) = rainncv(i,j) * ffrozp(i,j) - acsn(i,j) = acsnow(i) + !acsn(i,j) = acsnow(i) + acsn(i,j) = 0.0 ! --- units % shdfac(i,j) = sigmaf(i)*100. @@ -1049,7 +1047,6 @@ subroutine lsm_ruc_run & ! inputs evap_lnd(i) = qfx_lnd(i,j) / rho(i) ! kinematic hflx_lnd(i) = hfx_lnd(i,j) / (con_cp*rho(i)) ! kinematic gflux_lnd(i) = ssoil_lnd(i,j) - sfcdew_lnd(i) = dew_lnd(i,j) qsurf_lnd(i) = qsfc_lnd(i,j) tsurf_lnd(i) = soilt_lnd(i,j) stm(i) = soilm(i,j) * 1.e-3 ! convert to [m] @@ -1064,7 +1061,7 @@ subroutine lsm_ruc_run & ! inputs sfcqc_lnd(i) = qcg_lnd(i,j) ! --- ... units [m/s] = [g m-2 s-1] rhosnf(i) = rhosnfr(i,j) - acsnow(i) = acsn(i,j) ! kg m-2 + !acsnow(i) = acsn(i,j) ! kg m-2 ! --- ... accumulated total runoff and surface runoff runoff(i) = runoff(i) + (drain(i)+runof(i)) * delt * 0.001 ! kg m-2 @@ -1207,7 +1204,6 @@ subroutine lsm_ruc_run & ! inputs hflx_ice(i) = hfx_ice(i,j) / (con_cp*rho(i)) ! kinematic gflux_ice(i) = ssoil_ice(i,j) - sfcdew_ice(i) = dew_ice(i,j) qsurf_ice(i) = qsfc_ice(i,j) tsurf_ice(i) = soilt_ice(i,j) @@ -1295,7 +1291,7 @@ subroutine lsm_ruc_run & ! inputs !srflag(i) = srflag_old(i) tsnow_lnd(i) = tsnow_lnd_old(i) snowfallac_lnd(i) = snowfallac_lnd_old(i) - acsnow(i) = acsnow_old(i) + !acsnow(i) = acsnow_old(i) sfcqv_lnd(i) = sfcqv_lnd_old(i) sfcqc_lnd(i) = sfcqc_lnd_old(i) wetness(i) = wetness_old(i) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 31baf5628..49ee875d6 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -1006,25 +1006,16 @@ intent = inout optional = F [sfcqc_lnd] - standard_name = cloud_condensed_water_mixing_ratio_at_surface - long_name = moist cloud water mixing ratio at surface + standard_name = cloud_condensed_water_mixing_ratio_at_surface_over_land + long_name = moist cloud water mixing ratio at surface over land units = kg kg-1 dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[sfcdew_lnd] - standard_name = surface_condensation_mass_over_land - long_name = surface condensation mass over land - units = kg m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [sfcqv_lnd] - standard_name = water_vapor_mixing_ratio_at_surface + standard_name = water_vapor_mixing_ratio_at_surface_over_land long_name = water vapor mixing ratio at surface over land units = kg kg-1 dimensions = (horizontal_dimension) @@ -1176,15 +1167,6 @@ kind = kind_phys intent = inout optional = F -[sfcdew_ice] - standard_name = surface_condensation_mass_over_ice - long_name = surface condensation mass over ice - units = kg m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [sfcqv_ice] standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice @@ -1302,15 +1284,6 @@ kind = kind_phys intent = inout optional = F -[acsnow] - standard_name = accumulated_water_equivalent_of_frozen_precip - long_name = snow water equivalent of run-total frozen precip - units = kg m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [rhosnf] standard_name = density_of_frozen_precipitation long_name = density of frozen precipitation From ea8b130d0b8f4d4c61624060eb8229d155747417 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 9 Nov 2020 09:16:49 -0700 Subject: [PATCH 106/274] Update physics/GFS_debug.F90 with changes to RUC LSM arrays --- physics/GFS_debug.F90 | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 4680f8de7..cbb1765f0 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -491,18 +491,19 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end if ! CCPP/RUC only if (Model%lsm == Model%lsm_ruc) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sh2o', Sfcprop%sh2o) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%smois', Sfcprop%smois) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tslb', Sfcprop%tslb) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zs', Sfcprop%zs) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%clw_surf', Sfcprop%clw_surf) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%qwv_surf', Sfcprop%qwv_surf) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%cndm_surf', Sfcprop%cndm_surf) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%flag_frsoil', Sfcprop%flag_frsoil) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%rhofr', Sfcprop%rhofr) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tsnow', Sfcprop%tsnow) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac ', Sfcprop%snowfallac) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%acsnow ', Sfcprop%acsnow) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sh2o', Sfcprop%sh2o) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%smois', Sfcprop%smois) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tslb', Sfcprop%tslb) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%clw_surf_land', Sfcprop%clw_surf_land) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%clw_surf_ice', Sfcprop%clw_surf_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%qwv_surf_land', Sfcprop%qwv_surf_land) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%qwv_surf_ice', Sfcprop%qwv_surf_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%flag_frsoil', Sfcprop%flag_frsoil) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%rhofr', Sfcprop%rhofr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tsnow_land', Sfcprop%tsnow_land) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tsnow_ice', Sfcprop%tsnow_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac_land', Sfcprop%snowfallac_land) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac_ice', Sfcprop%snowfallac_ice) end if ! Radtend call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%upfxc', Radtend%sfcfsw(:)%upfxc) From 50c6e6f9a1bbe93b3f1b997401e58848e76c73fb Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 9 Nov 2020 16:00:50 -0700 Subject: [PATCH 107/274] ThompsonMP w/ RRTMGP working --- physics/GFS_rrtmgp_gfdlmp_pre.meta | 2 +- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 136 +++++++++++++++---------- physics/GFS_rrtmgp_thompsonmp_pre.meta | 48 ++++++--- 3 files changed, 117 insertions(+), 69 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 3841afc9b..90f4d5daf 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_gfdlmp_pre type = scheme - dependencies = rrtmgp_aux.F90 + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index f815ba0cc..646e45c31 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -17,6 +17,7 @@ module GFS_rrtmgp_thompsonmp_pre make_IceNumber, & make_DropletNumber, & make_RainNumber + implicit none ! Parameters specific to THOMPSONMP scheme. real(kind_phys), parameter :: & @@ -44,6 +45,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i lat, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, & qs_lay, q_lay, relhum, cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, lmfdeep2, ltaerosol, & iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, idcor_hogan, idcor_oreopoulos, & + do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & deltaZb, errmsg, errflg) @@ -72,7 +74,9 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i idcor, & ! Choice of method for decorrelation length computation idcor_con, & ! Flag for decorrelation-length. Use constant value idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + idcor_oreopoulos, & ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + imfdeepcnv, & ! Choice of mass-flux deep convection scheme + imfdeepcnv_gf ! Flag for Grell-Freitas deep convection scheme logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation @@ -80,7 +84,8 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i uni_cld, & ! lmfshal, & ! lmfdeep2, & ! - ltaerosol ! + ltaerosol, & ! + do_mynnedmf ! Flag to activate MYNN-EDMF real(kind_phys), intent(in) :: & julian, & ! Julian day con_pi, & ! Physical constant: pi @@ -104,7 +109,12 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i tracer ! Cloud condensate amount in layer by type () ! In/Outs - real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) effrin_cldice, & ! Effective radius for ice cloud-particles (microns) effrin_cldsnow ! Effective radius for snow cloud-particles (microns) @@ -113,11 +123,6 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i real(kind_phys), dimension(nCol),intent(out) :: & de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cld_frac, & ! Total cloud fraction - cld_lwp, & ! Cloud liquid water path - cld_reliq, & ! Cloud liquid effective radius - cld_iwp, & ! Cloud ice water path - cld_reice, & ! Cloud ice effecive radius cld_swp, & ! Cloud snow water path cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path @@ -132,7 +137,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i errflg ! Error flag ! Local variables - real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, xrc3 + real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, clwmin, clwf real(kind_phys), dimension(nLev+1) :: hgtb real(kind_phys), dimension(nLev) :: hgtc real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate @@ -156,16 +161,6 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i iSFC = 1 iTOA = nLev endif - - ! Initialize outputs - cld_lwp(:,:) = 0.0 - cld_reliq(:,:) = 0.0 - cld_iwp(:,:) = 0.0 - cld_reice(:,:) = 0.0 - cld_rwp(:,:) = 0.0 - cld_rerain(:,:) = 0.0 - cld_swp(:,:) = 0.0 - cld_resnow(:,:) = 0.0 ! #################################################################################### ! Pull out cloud information for THOMPSON MP scheme. @@ -177,11 +172,20 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel tracer(1:nCol,1:nLev,i_cldgrpl) - - ! - ! Compute effective radii for liquid/ice/snow using subgrid scale clouds - ! - + + ! Cloud particle size + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + do iLay = 1, nLev + do iCol = 1, nCol + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,1) * tem1) + cld_iwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,2) * tem1) + cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) + cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) + enddo + enddo + ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) orho = 1./rho @@ -214,6 +218,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i enddo enddo + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds ! Call Thompson's subroutine to compute effective radii do iCol=1,nCol call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & @@ -225,42 +230,61 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 - - if (uni_cld) then - if (effr_in) then - cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) - cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) - cld_rerain(1:nCol,1:nLev) = rerain_def - cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) - else - cld_reliq(1:nCol,1:nLev) = reliq_def - cld_reice(1:nCol,1:nLev) = reice_def - cld_rerain(1:nCol,1:nLev) = rerain_def - cld_resnow(1:nCol,1:nLev) = resnow_def - endif ! effr_in - endif ! uni_cld + cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) + cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) + cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) + cld_rerain(1:nCol,1:nLev) = rerain_def - ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these + ! magic numbers are coming from. + if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv + ! Cloud-fraction + if (uni_cld) then + cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + else + clwmin = 0.0 + if (.not. lmfshal) then + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + endif + enddo + enddo + else + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + endif + enddo + enddo + endif + endif + endif + ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) - - ! Condensate and effective size - deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. - do iLay = 1, nLev - do iCol = 1, nCol - ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - if (cld_frac(iCol,iLay) .ge. cllimit) then - tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) - cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 - cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 - cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 - cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 - endif - enddo - enddo - + ! #################################################################################### ! Cloud (and precipitation) overlap ! #################################################################################### diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index a2bc0af2b..bcc394c82 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -1,11 +1,11 @@ [ccpp-table-properties] name = GFS_rrtmgp_thompsonmp_pre type = scheme - dependencies = rrtmgp_aux.F90 + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] - name = GFS_rrtmgp_thompspnmp_pre_run + name = GFS_rrtmgp_thompsonmp_pre_run type = scheme [nCol] standard_name = horizontal_loop_extent @@ -212,7 +212,7 @@ intent = in optional = F [iovr] - standard_name = flag_for_cloud_overlap_method + standard_name = flag_for_cloud_overlap_method_for_radiation long_name = flag for cloud overlap method used by radiation scheme units = flag dimensions = () @@ -302,6 +302,30 @@ type = integer intent = in optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation @@ -426,7 +450,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_lwp] standard_name = cloud_liquid_water_path @@ -435,16 +459,16 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_iwp] standard_name = cloud_ice_water_path @@ -453,16 +477,16 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reice] standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_swp] standard_name = cloud_snow_water_path @@ -476,7 +500,7 @@ [cld_resnow] standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys @@ -494,7 +518,7 @@ [cld_rerain] standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud - units = micron + units = um dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys From 0865ca98a4ac71c743d22e70acd7e204143adee0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 9 Nov 2020 16:08:58 -0700 Subject: [PATCH 108/274] Some readability changes --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 171 +++++++++++++------------- 1 file changed, 85 insertions(+), 86 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 646e45c31..c10252fee 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -4,19 +4,19 @@ ! ######################################################################################## module GFS_rrtmgp_thompsonmp_pre use machine, only: & - kind_phys + kind_phys use rrtmgp_aux, only: & - check_error_msg + check_error_msg use module_radiation_cloud_overlap, only: & - cmp_dcorr_lgth, & - get_alpha_exp + cmp_dcorr_lgth, & + get_alpha_exp use module_mp_thompson, only: & - calc_effectRad, & - Nt_c + calc_effectRad, & + Nt_c use module_mp_thompson_make_number_concentrations, only: & - make_IceNumber, & - make_DropletNumber, & - make_RainNumber + make_IceNumber, & + make_DropletNumber, & + make_RainNumber implicit none ! Parameters specific to THOMPSONMP scheme. @@ -26,30 +26,30 @@ module GFS_rrtmgp_thompsonmp_pre rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme - - public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize - + + public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize + contains ! ###################################################################################### ! ###################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_init() end subroutine GFS_rrtmgp_thompsonmp_pre_init - + ! ###################################################################################### ! ###################################################################################### !! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run !! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html !! subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice,& - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, yearlen, doSWrad, doLWrad, effr_in, julian, & - lat, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, & - qs_lay, q_lay, relhum, cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, lmfdeep2, ltaerosol, & - iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, idcor_hogan, idcor_oreopoulos, & - do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, & + yearlen, doSWrad, doLWrad, effr_in, julian, lat, p_lev, p_lay, tv_lay, t_lay, & + effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, & + cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, & + lmfdeep2, ltaerosol, iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, & + idcor_hogan, idcor_oreopoulos, do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & deltaZb, errmsg, errflg) - implicit none ! Inputs integer, intent(in) :: & @@ -107,8 +107,8 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & tracer ! Cloud condensate amount in layer by type () - - ! In/Outs + + ! In/Outs real(kind_phys), dimension(nCol,nLev), intent(inout) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path @@ -143,15 +143,15 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate integer :: iCol,iLay,l,iSFC,iTOA real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& - re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa + re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa logical :: top_at_1 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + if (.not. (doSWrad .or. doLWrad)) return - + ! What is vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then @@ -165,7 +165,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i ! #################################################################################### ! Pull out cloud information for THOMPSON MP scheme. ! #################################################################################### - + ! Cloud condensate cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water @@ -191,21 +191,21 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i orho = 1./rho do iLay = 1, nLev do iCol = 1, nCol - qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) - qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) - qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) - qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) - nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) - if (ltaerosol) then - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) - nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) - else - nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) - endif + qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) + qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) + qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) + qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) + nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + if (ltaerosol) then + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) + else + nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) + endif enddo enddo - + ! Update number concentration, consistent with sub-grid clouds do iLay = 1, nLev do iCol = 1, nCol @@ -217,13 +217,13 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i endif enddo enddo - + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds ! Call Thompson's subroutine to compute effective radii do iCol=1,nCol call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & - nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & - re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) + nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & + re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) enddo ! Scale Thompson's effective radii from meter to micron and update global effective radii. @@ -234,61 +234,60 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) cld_rerain(1:nCol,1:nLev) = rerain_def - - ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these - ! magic numbers are coming from. + + ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these + ! magic numbers are coming from. if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv - ! Cloud-fraction - if (uni_cld) then + ! Cloud-fraction + if (uni_cld) then cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) else - clwmin = 0.0 - if (.not. lmfshal) then - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + clwmin = 0.0 + if (.not. lmfshal) then + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) endif - enddo - enddo - else - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) - endif - enddo + enddo enddo - endif - endif - endif - + else + do iLay = 1, nLev + do iCol = 1, nCol + clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & + tracer(iCol,iLay,i_cldsnow) + clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) + if (clwf > clwt) then + onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) + clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) + tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan + tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) + tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) + ! + cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) + endif + enddo + enddo + endif + endif + endif + ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) ! #################################################################################### ! Cloud (and precipitation) overlap ! #################################################################################### - + ! ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) ! @@ -379,4 +378,4 @@ end subroutine GFS_rrtmgp_thompsonmp_pre_run ! ######################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_finalize() end subroutine GFS_rrtmgp_thompsonmp_pre_finalize -end module GFS_rrtmgp_thompsonmp_pre \ No newline at end of file +end module GFS_rrtmgp_thompsonmp_pre From 7cef35e03a42f3fd797a10dd1dfa8a482a1f636d Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 10 Nov 2020 17:09:50 +0000 Subject: [PATCH 109/274] Removed redundant importing of kind_phys --- physics/radlw_main.F90 | 3 +-- physics/radsw_main.F90 | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index f2c3ee034..de8d9e973 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -279,8 +279,7 @@ module rrtmg_lw ! use physparam, only : ilwrate, ilwrgas, ilwcliq, ilwcice, & - & isubclw, icldflg, iovr, ivflip, & - & kind_phys + & isubclw, icldflg, iovr, ivflip use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 use mersenne_twister, only : random_setseed, random_number, & diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index a63b7060c..8ebbb3ab1 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -306,7 +306,7 @@ module rrtmg_sw ! use physparam, only : iswrate, iswrgas, iswcliq, iswcice, & & isubcsw, icldflg, iovr, ivflip, & - & iswmode, kind_phys + & iswmode use physcons, only : con_g, con_cp, con_avgd, con_amd, & & con_amw, con_amo3 use machine, only : rb => kind_phys, im => kind_io4, & From e6cac7bd89c154c8961d114eb6c2d60b3215e510 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 10 Nov 2020 14:22:58 -0700 Subject: [PATCH 110/274] Remove physics/lsm_ruc_sfc_sice_interstitial.F90 --- physics/lsm_ruc_sfc_sice_interstitial.F90 | 123 ---------------------- 1 file changed, 123 deletions(-) delete mode 100644 physics/lsm_ruc_sfc_sice_interstitial.F90 diff --git a/physics/lsm_ruc_sfc_sice_interstitial.F90 b/physics/lsm_ruc_sfc_sice_interstitial.F90 deleted file mode 100644 index 27033fcc8..000000000 --- a/physics/lsm_ruc_sfc_sice_interstitial.F90 +++ /dev/null @@ -1,123 +0,0 @@ -module lsm_ruc_sfc_sice_pre - - use machine, only: kind_phys - - implicit none - - private - - public :: lsm_ruc_sfc_sice_pre_init, lsm_ruc_sfc_sice_pre_run, lsm_ruc_sfc_sice_pre_finalize - -contains - - subroutine lsm_ruc_sfc_sice_pre_init () - end subroutine lsm_ruc_sfc_sice_pre_init - - subroutine lsm_ruc_sfc_sice_pre_finalize () - end subroutine lsm_ruc_sfc_sice_pre_finalize - -#if 0 -!> \section arg_table_lsm_ruc_sfc_sice_pre_run Argument Table -!! \htmlinclude lsm_ruc_sfc_sice_pre_run.html -!! -#endif - subroutine lsm_ruc_sfc_sice_pre_run(im, lsoil_ruc, lsoil, kice, land, icy, stc, tslb, tiice, errmsg, errflg) - - implicit none - - ! Interface variables - integer, intent(in) :: im, lsoil_ruc, lsoil, kice - logical, dimension(im), intent(in) :: land, icy -! --- on Noah levels - real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: stc -! --- on RUC levels - real (kind=kind_phys), dimension(im,lsoil_ruc), intent(in) :: tslb - real (kind=kind_phys), dimension(im,kice), intent(inout) :: tiice - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - if (icy(i)) then - do k=1,kice - tiice(i,k) = tslb(i,k) - end do - else if (.not.land(i)) then - do k=1,min(lsoil,lsoil_ruc) - stc(i,k) = tslb(i,k) - end do - end if - end do - - end subroutine lsm_ruc_sfc_sice_pre_run - -end module lsm_ruc_sfc_sice_pre - -module lsm_ruc_sfc_sice_post - - use machine, only: kind_phys - - implicit none - - private - - public :: lsm_ruc_sfc_sice_post_init, lsm_ruc_sfc_sice_post_run, lsm_ruc_sfc_sice_post_finalize - -contains - - subroutine lsm_ruc_sfc_sice_post_init () - end subroutine lsm_ruc_sfc_sice_post_init - - subroutine lsm_ruc_sfc_sice_post_finalize () - end subroutine lsm_ruc_sfc_sice_post_finalize - -#if 0 -!> \section arg_table_lsm_ruc_sfc_sice_post_run Argument Table -!! \htmlinclude lsm_ruc_sfc_sice_post_run.html -!! -#endif - subroutine lsm_ruc_sfc_sice_post_run(im, lsoil_ruc, lsoil, kice, land, icy, stc, tslb, tiice, errmsg, errflg) - - implicit none - - ! Interface variables - integer, intent(in) :: im, lsoil_ruc, lsoil, kice - logical, dimension(im), intent(in) :: land, icy -! --- on Noah levels - real (kind=kind_phys), dimension(im,lsoil), intent(in) :: stc - real (kind=kind_phys), dimension(im,kice), intent(in) :: tiice -! --- on RUC levels - real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - integer :: i, k - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do i=1,im - if (icy(i)) then - do k=1,kice - tslb(i,k) = tiice(i,k) - end do - else if (.not.land(i)) then - do k=1,min(lsoil,lsoil_ruc) - tslb(i,k) = stc(i,k) - end do - end if - end do - - end subroutine lsm_ruc_sfc_sice_post_run - -end module lsm_ruc_sfc_sice_post From 53619d892b8a9e92e8d5f02689170ebcb94c5776 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 10 Nov 2020 21:59:21 +0000 Subject: [PATCH 111/274] add units to index_for_diagnostic_printout metadata --- physics/GFS_time_vary_pre.scm.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta index 98d0d3b63..6241e29f1 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/GFS_time_vary_pre.scm.meta @@ -212,7 +212,7 @@ [ipt] standard_name = index_for_diagnostic_printout long_name = horizontal index for point used for diagnostic printout - units = + units = index dimensions = () type = integer intent = out From c30535ff5fc1050b40f0e9d0536af08850e55087 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 10 Nov 2020 15:35:31 -0700 Subject: [PATCH 112/274] Further refinements to ThompsonMP - RRTMGP coupling --- physics/GFS_rrtmgp_cloud_overlap_pre.F90 | 192 ++++++++++++++++ physics/GFS_rrtmgp_cloud_overlap_pre.meta | 265 ++++++++++++++++++++++ physics/GFS_rrtmgp_thompsonmp_pre.F90 | 257 ++++++--------------- physics/GFS_rrtmgp_thompsonmp_pre.meta | 159 +------------ 4 files changed, 532 insertions(+), 341 deletions(-) create mode 100644 physics/GFS_rrtmgp_cloud_overlap_pre.F90 create mode 100644 physics/GFS_rrtmgp_cloud_overlap_pre.meta diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 new file mode 100644 index 000000000..08bc82d05 --- /dev/null +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -0,0 +1,192 @@ +! ######################################################################################## +! +! ######################################################################################## +module GFS_rrtmgp_cloud_overlap_pre + use machine, only: kind_phys + use rrtmgp_aux, only: check_error_msg + use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + + public GFS_rrtmgp_cloud_overlap_pre_init, GFS_rrtmgp_cloud_overlap_pre_run, GFS_rrtmgp_cloud_overlap_pre_finalize + +contains + ! ###################################################################################### + ! ###################################################################################### + subroutine GFS_rrtmgp_cloud_overlap_pre_init() + end subroutine GFS_rrtmgp_cloud_overlap_pre_init + + ! ###################################################################################### + ! ###################################################################################### +!! \section arg_table_GFS_rrtmgp_cloud_overlap_pre_run +!! \htmlinclude GFS_rrtmgp_cloud_overlap_pre_run.html +!! + subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWrad, & + julian, lat, p_lev, p_lay, tv_lay, con_pi, con_g, con_rd, con_epsq, dcorr_con, & + idcor, iovr, iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, & + idcor_oreopoulos, cld_frac, & + cloud_overlap_param, precip_overlap_param, de_lgth, deltaZc, errmsg, errflg) + implicit none + + ! Inputs + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + yearlen, & ! Length of current year (365/366) WTF? + iovr, & ! Choice of cloud-overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method + idcor, & ! Choice of method for decorrelation length computation + idcor_con, & ! Flag for decorrelation-length. Use constant value + idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) + idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + logical, intent(in) :: & + doSWrad, & ! Call SW radiation? + doLWrad ! Call LW radiation + real(kind_phys), intent(in) :: & + julian, & ! Julian day + con_pi, & ! Physical constant: pi + con_g, & ! Physical constant: gravitational constant + con_rd, & ! Physical constant: gas-constant for dry air + con_epsq, & ! Physical constant: Minimum value for specific humidity + dcorr_con ! Decorrelation-length (used if idcor = idcor_con) + real(kind_phys), dimension(nCol), intent(in) :: & + lat ! Latitude + real(kind_phys), dimension(nCol,nLev), intent(in) :: & + tv_lay, & ! Virtual temperature (K) + p_lay, & ! Pressure at model-layers (Pa) + cld_frac ! Total cloud fraction + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + p_lev ! Pressure at model-level interfaces (Pa) + + ! Outputs + real(kind_phys), dimension(nCol),intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(nCol,nLev),intent(out) :: & + cloud_overlap_param, & ! Cloud-overlap parameter + precip_overlap_param, & ! Precipitation overlap parameter + deltaZc ! Layer thickness (from layer-centers)(km) + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + real(kind_phys) :: tem1,pfac + real(kind_phys), dimension(nLev+1) :: hgtb + real(kind_phys), dimension(nLev) :: hgtc + integer :: iCol,iLay,l,iSFC,iTOA + real(kind_phys), dimension(nCol,nLev) :: deltaZ + logical :: top_at_1 + + if (.not. (doSWrad .or. doLWrad)) return + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! What is vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + if (top_at_1) then + iSFC = nLev + iTOA = 1 + else + iSFC = 1 + iTOA = nLev + endif + + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! + do iCol=1,nCol + if (top_at_1) then + ! Layer thickness (km) + do iLay=1,nLev + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(nLev+1) = 0._kind_phys + do iLay=nLev,1,-1 + hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = nLev, 1, -1 + pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & + abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) + hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) + enddo + ! Layer thickness between centers + do iLay = nLev-1, 1, -1 + deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) + enddo + deltaZc(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) + else + do iLay=nLev,1,-1 + deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + ! Height at layer boundaries + hgtb(1) = 0._kind_phys + do iLay=1,nLev + hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) + enddo + ! Height at layer centers + do iLay = 1, nLev + pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & + abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) + hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) + enddo + ! Layer thickness between centers + do iLay = 2, nLev + deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) + enddo + deltaZc(iCol,1) = hgtc(1) - hgtb(1) + endif + enddo + + ! + ! Cloud decorrelation length + ! + if (idcor == idcor_hogan) then + call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) + endif + if (idcor == idcor_oreopoulos) then + call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) + endif + if (idcor == idcor_con) then + de_lgth(:) = dcorr_con + endif + + ! + ! Cloud overlap parameter + ! + if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then + call get_alpha_exp(nCol, nLev, deltaZc, de_lgth, cloud_overlap_param) + else + de_lgth(:) = 0. + cloud_overlap_param(:,:) = 0. + endif + + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers + if (iovr == iovr_exprand) then + do iLay = 1, nLev + do iCol = 1, nCol + if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then + cloud_overlap_param(iCol,iLay) = 0._kind_phys + endif + enddo + enddo + endif + + ! + ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) + ! + precip_overlap_param = cloud_overlap_param + + end subroutine GFS_rrtmgp_cloud_overlap_pre_run + + ! ######################################################################################### + ! ######################################################################################### + subroutine GFS_rrtmgp_cloud_overlap_pre_finalize() + end subroutine GFS_rrtmgp_cloud_overlap_pre_finalize +end module GFS_rrtmgp_cloud_overlap_pre diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.meta b/physics/GFS_rrtmgp_cloud_overlap_pre.meta new file mode 100644 index 000000000..273832362 --- /dev/null +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.meta @@ -0,0 +1,265 @@ +[ccpp-table-properties] + name = GFS_rrtmgp_cloud_overlap_pre + type = scheme + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_cloud_overlap_pre_run + type = scheme +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[yearlen] + standard_name = number_of_days_in_year + long_name = number of days in a year + units = days + dimensions = () + type = integer + intent = in + optional = F +[julian] + standard_name = julian_day + long_name = julian day + units = days + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + intent = in + kind = kind_phys + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsq] + standard_name = minimum_value_of_specific_humidity + long_name = floor value for specific humidity + units = kg kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[iovr] + standard_name = flag_for_cloud_overlap_method_for_radiation + long_name = flag for cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_dcorr] + standard_name = flag_for_decorrelation_length_cloud_overlap_method + long_name = choice of decorrelation-length cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exp] + standard_name = flag_for_exponential_cloud_overlap_method + long_name = choice of exponential cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_exprand] + standard_name = flag_for_exponential_random_cloud_overlap_method + long_name = choice of exponential-random cloud overlap method + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor] + standard_name = flag_for_decorrelation_length_method + long_name = flag for decorrelation length method used in cloud overlap method (iovr) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_con] + standard_name = flag_for_constant_decorrelation_length_method + long_name = choice of decorrelation length computation (costant) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_hogan] + standard_name = flag_for_hogan_decorrelation_length_method + long_name = choice of decorrelation length computation (hogan) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[idcor_oreopoulos] + standard_name = flag_for_oreopoulos_decorrelation_length_method + long_name = choice of decorrelation length computation (oreopoulos) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[dcorr_con] + standard_name = decorreltion_length_used_by_overlap_method + long_name = decorrelation length (default) used by cloud overlap method (iovr) + units = km + dimensions = () + type = real + intent = in + kind = kind_phys + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[cloud_overlap_param] + standard_name = cloud_overlap_param + long_name = cloud overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[precip_overlap_param] + standard_name = precip_overlap_param + long_name = precipitation overlap parameter + units = km + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[deltaZc] + standard_name = layer_thickness + long_name = layer_thickness + units = m + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index c10252fee..758e810fb 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -7,9 +7,6 @@ module GFS_rrtmgp_thompsonmp_pre kind_phys use rrtmgp_aux, only: & check_error_msg - use module_radiation_cloud_overlap, only: & - cmp_dcorr_lgth, & - get_alpha_exp use module_mp_thompson, only: & calc_effectRad, & Nt_c @@ -40,16 +37,14 @@ end subroutine GFS_rrtmgp_thompsonmp_pre_init !! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run !! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html !! - subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice,& - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, i_cldice_nc, i_twa, & - yearlen, doSWrad, doLWrad, effr_in, julian, lat, p_lev, p_lay, tv_lay, t_lay, & - effrin_cldliq, effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, & - cld_frac_mg, con_pi, con_g, con_rd, con_epsq, iovr, iovr_dcorr, uni_cld, lmfshal, & - lmfdeep2, ltaerosol, iovr_exp,iovr_exprand, idcor, dcorr_con, idcor_con, & - idcor_hogan, idcor_oreopoulos, do_mynnedmf, imfdeepcnv, imfdeepcnv_gf, & - cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & - deltaZb, errmsg, errflg) + subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, doLWrad, & + i_cldliq, i_cldice, i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, & + i_cldice_nc, i_twa, effr_in, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, & + effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, cld_frac_mg, con_g, & + con_rd, uni_cld, lmfshal, lmfdeep2, ltaerosol, do_mynnedmf, imfdeepcnv, & + imfdeepcnv_gf, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -66,15 +61,6 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i i_cldliq_nc, & ! cloud liquid number concentration. i_cldice_nc, & ! cloud ice number concentration. i_twa, & ! water friendly aerosol. - yearlen, & ! Length of current year (365/366) WTF? - iovr, & ! Choice of cloud-overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - idcor, & ! Choice of method for decorrelation length computation - idcor_con, & ! Flag for decorrelation-length. Use constant value - idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos, & ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) imfdeepcnv, & ! Choice of mass-flux deep convection scheme imfdeepcnv_gf ! Flag for Grell-Freitas deep convection scheme logical, intent(in) :: & @@ -87,14 +73,9 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i ltaerosol, & ! do_mynnedmf ! Flag to activate MYNN-EDMF real(kind_phys), intent(in) :: & - julian, & ! Julian day - con_pi, & ! Physical constant: pi con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_epsq, & ! Physical constant(?): Minimum value for specific humidity - dcorr_con ! Decorrelation-length (used if idcor = 0, default is idcor = 1) - real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude (radians) + con_rd ! Physical constant: gas-constant for dry air + real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) t_lay, & ! Temperature (K) @@ -120,28 +101,21 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i effrin_cldsnow ! Effective radius for snow cloud-particles (microns) ! Outputs - real(kind_phys), dimension(nCol),intent(out) :: & - de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain, & ! Cloud rain effective radius - precip_frac, & ! Precipitation fraction - cloud_overlap_param, & ! Cloud-overlap parameter - precip_overlap_param, & ! Precipitation overlap parameter - deltaZb ! Layer thickness (km) + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & errflg ! Error flag ! Local variables - real(kind_phys) :: tem0, tem1, tem2, pfac, clwt, clwm, onemrh, clwmin, clwf - real(kind_phys), dimension(nLev+1) :: hgtb - real(kind_phys), dimension(nLev) :: hgtc + real(kind_phys) :: alpha0, pfac, tem1, cld_mr real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate - integer :: iCol,iLay,l,iSFC,iTOA + integer :: iCol,iLay,l real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa logical :: top_at_1 @@ -151,21 +125,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i errflg = 0 if (.not. (doSWrad .or. doLWrad)) return - - ! What is vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev - iTOA = 1 - else - iSFC = 1 - iTOA = nLev - endif - - ! #################################################################################### - ! Pull out cloud information for THOMPSON MP scheme. - ! #################################################################################### - + ! Cloud condensate cld_condensate(1:nCol,1:nLev,1) = tracer(1:nCol,1:nLev,i_cldliq) ! -liquid water cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water @@ -235,147 +195,74 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) cld_rerain(1:nCol,1:nLev) = rerain_def - ! Compute cloud-fraction. The logic is a mess here. I don't have any idea where these - ! magic numbers are coming from. + ! Compute cloud-fraction. Else, use value provided if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv ! Cloud-fraction if (uni_cld) then cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) else - clwmin = 0.0 - if (.not. lmfshal) then - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 2000.0 / min(max(sqrt(sqrt(onemrh*qs_lay(iCol,iLay))),0.0001),1.0) - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) - endif - enddo - enddo - else - do iLay = 1, nLev - do iCol = 1, nCol - clwf = tracer(iCol,iLay,i_cldliq) + tracer(iCol,iLay,i_cldice) + & - tracer(iCol,iLay,i_cldsnow) - clwt = 1.0e-6 * (p_lay(iCol,iLay)*0.001) - if (clwf > clwt) then - onemrh= max( 1.e-10, 1.0-relhum(iCol,iLay) ) - clwm = clwmin / max( 0.01, p_lay(iCol,iLay)*0.001 ) - tem1 = 100.0 / min(max((onemrh*qs_lay(iCol,iLay))**0.49,0.0001),1.0) !jhan - tem1 = max( min( tem1*(clwf-clwm), 50.0 ), 0.0 ) - tem2 = sqrt( sqrt(relhum(iCol,iLay)) ) - ! - cld_frac(iCol,iLay) = max( tem2*(1.0-exp(-tem1)), 0.0 ) - endif - enddo + if( lmfshal) alpha0 = 100. ! Default + if(.not. lmfshal) alpha0 = 2000. + ! Xu-Randall (1996) cloud-fraction + do iLay = 1, nLev + do iCol = 1, nCol + cld_mr = cld_condensate(iCol,iLay,1) + cld_condensate(iCol,iLay,2) + & + cld_condensate(iCol,iLay,4) + cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0) enddo - endif + enddo endif endif ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) - ! #################################################################################### - ! Cloud (and precipitation) overlap - ! #################################################################################### - - ! - ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) - ! - do iCol=1,nCol - if (top_at_1) then - ! Layer thickness (km) - do iLay=1,nLev - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(nLev+1) = 0._kind_phys - do iLay=nLev,1,-1 - hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = nLev, 1, -1 - pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & - abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) - hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) - enddo - ! Layer thickness between centers - do iLay = nLev-1, 1, -1 - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) - enddo - deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) - else - do iLay=nLev,1,-1 - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(1) = 0._kind_phys - do iLay=1,nLev - hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = 1, nLev - pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & - abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) - hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) - enddo - ! Layer thickness between centers - do iLay = 2, nLev - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) - enddo - deltaZb(iCol,1) = hgtc(1) - hgtb(1) - endif - enddo - - ! - ! Cloud decorrelation length - ! - if (idcor == idcor_hogan) then - call cmp_dcorr_lgth(nCol, abs(lat/con_pi), con_pi, de_lgth) - endif - if (idcor == idcor_oreopoulos) then - call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) - endif - if (idcor == idcor_con) then - de_lgth(:) = dcorr_con - endif - - ! - ! Cloud overlap parameter - ! - call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) - - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (iovr == iovr_exprand) then - do iLay = 1, nLev - do iCol = 1, nCol - if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then - cloud_overlap_param(iCol,iLay) = 0._kind_phys - endif - enddo - enddo - endif - - ! - ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) - ! - precip_overlap_param = cloud_overlap_param - end subroutine GFS_rrtmgp_thompsonmp_pre_run - ! ######################################################################################### - ! ######################################################################################### + ! ###################################################################################### + ! ###################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_finalize() end subroutine GFS_rrtmgp_thompsonmp_pre_finalize + + ! ###################################################################################### + ! This function computes the cloud-fraction following. + ! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models + ! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 + ! + ! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P + ! + ! ###################################################################################### + function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) + + ! Inputs + real(kind_phys), intent(in) :: & + p_lay, & ! Pressure (Pa) + qs_lay, & ! Saturation vapor-pressure (Pa) + relhum, & ! Relative humidity + cld_mr, & ! Total cloud mixing ratio + alpha ! Scheme parameter (default=100) + ! Outputs + real(kind_phys) :: cld_frac_XuRandall + ! Locals + real(kind_phys) :: clwt, clwm, onemrh, tem1, tem2, tem3 + ! Parameters + real(kind_phys) :: & + lambda = 0.50, & ! + P = 0.25 + + clwt = 1.0e-6 * (p_lay*0.001) + if (cld_mr > clwt) then + onemrh = max(1.e-10, 1.0 - relhum) + tem1 = alpha / min(max((onemrh*qs_lay)**lambda,0.0001),1.0) + tem2 = max(min(tem1*(cld_mr - clwt), 50.0 ), 0.0 ) + tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p + ! + cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) + else + cld_frac_XuRandall = 0.0 + endif + + return + end function end module GFS_rrtmgp_thompsonmp_pre diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index bcc394c82..b00e27fd8 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_thompsonmp_pre type = scheme - dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 + dependencies = rrtmgp_aux.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] @@ -203,105 +203,6 @@ kind = kind_phys intent = in optional = F -[yearlen] - standard_name = number_of_days_in_year - long_name = number of days in a year - units = days - dimensions = () - type = integer - intent = in - optional = F -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = flag for cloud overlap method used by radiation scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[julian] - standard_name = julian_day - long_name = julian day - units = days - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_dimension) - type = real - intent = in - kind = kind_phys - optional = F -[idcor] - standard_name = flag_for_decorrelation_length_method - long_name = flag for decorrelation length method used in cloud overlap method (iovr) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[dcorr_con] - standard_name = decorreltion_length_used_by_overlap_method - long_name = decorrelation length (default) used by cloud overlap method (iovr) - units = km - dimensions = () - type = real - intent = in - kind = kind_phys - optional = F -[idcor_con] - standard_name = flag_for_constant_decorrelation_length_method - long_name = choice of decorrelation length computation (costant) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_hogan] - standard_name = flag_for_hogan_decorrelation_length_method - long_name = choice of decorrelation length computation (hogan) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_oreopoulos] - standard_name = flag_for_oreopoulos_decorrelation_length_method - long_name = choice of decorrelation length computation (oreopoulos) - units = flag - dimensions = () - type = integer - intent = in - optional = F [do_mynnedmf] standard_name = do_mynnedmf long_name = flag to activate MYNN-EDMF @@ -398,15 +299,6 @@ kind = kind_phys intent = in optional = F -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -424,25 +316,7 @@ type = real kind = kind_phys intent = in - optional = F -[con_epsq] - standard_name = minimum_value_of_specific_humidity - long_name = floor value for specific humidity - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -532,34 +406,7 @@ type = real kind = kind_phys intent = out - optional = F -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[deltaZb] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 0ecf50b8fce366410d39f40be727460c45b2dd23 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 12 Nov 2020 18:00:23 +0000 Subject: [PATCH 113/274] Bugfix in GP sampling routines. --- physics/rrtmgp_lw_cloud_sampling.F90 | 7 ++++--- physics/rrtmgp_sw_cloud_sampling.F90 | 27 ++++++++++++++++++++++----- 2 files changed, 26 insertions(+), 8 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index d95dbf8c1..cfb86eb3a 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -96,7 +96,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 - real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng1D + real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D + real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables @@ -152,8 +153,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Generate second RNG do iCol=1,ncol call random_setseed(ipseed_lw(icol),rng_stat) - call random_number(rng1D,rng_stat) - rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + call random_number(rng2D,rng_stat) + rng3D2(:,:,iCol) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo call sampled_mask(rng3D, cld_frac, cldfracMCICA, & overlap_param = cloud_overlap_param(:,1:nLev-1), & diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 396e65671..ba4097e96 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -99,7 +99,8 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd type(random_stat) :: rng_stat real(kind_phys) :: tauloc,asyloc,ssaloc real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 - real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D + real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng2D + real(kind_phys), dimension(sw_gas_props%get_ngpt()) :: rng1D logical, dimension(nday,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables @@ -134,8 +135,24 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! and layers. ([nGpts,nLev,nDayumn]-> [nGpts*nLev]*nDayumn) do iday=1,nday call random_setseed(ipseed_sw(iday),rng_stat) - call random_number(rng1D,rng_stat) - rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + ! Use same rng for each layer + if (iovr == iovr_max) then + call random_number(rng1D,rng_stat) + do iLay=1,nLev + rng3D(:,iLay,iday) = rng1D + enddo + else + do iLay=1,nLev + call random_number(rng1D,rng_stat) + rng3D(:,iLay,iday) = rng1D + enddo + endif + enddo + + do iday=1,nday + call random_setseed(ipseed_sw(iday),rng_stat) + call random_number(rng2D,rng_stat) + rng3D(:,:,iday) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo ! Cloud overlap. @@ -147,8 +164,8 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd if (iovr == iovr_dcorr) then do iday=1,nday call random_setseed(ipseed_sw(iday),rng_stat) - call random_number(rng1D,rng_stat) - rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + call random_number(rng2D,rng_stat) + rng3D2(:,:,iday) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), cldfracMCICA, & overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1),& From 254382d85426c65a5c1b3193ad50fd4255d2267c Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 12 Nov 2020 13:27:45 -0700 Subject: [PATCH 114/274] Cleanup of GP-ThMP interface. New scheme file for cloud-overlap pre. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 192 ++++---------------------- physics/GFS_rrtmgp_gfdlmp_pre.meta | 155 +-------------------- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 36 ++--- 3 files changed, 45 insertions(+), 338 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 52e1a7b74..31c67d62f 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -14,8 +14,7 @@ module GFS_rrtmgp_gfdlmp_pre rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) reice_min = 10.0, & ! Minimum ice size allowed by scheme - reice_max = 150.0, & ! Maximum ice size allowed by scheme - cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme + reice_max = 150.0 ! Maximum ice size allowed by scheme public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize @@ -31,13 +30,11 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, yearlen, doSWrad, doLWrad, effr_in, & - julian, lat, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & - effrin_cldsnow, tracer, con_pi, con_g, con_rd, con_epsq, dcorr_con, idcor, iovr, & - iovr_dcorr, iovr_exprand, iovr_exp, idcor_con, idcor_hogan, idcor_oreopoulos, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, doSWrad, doLWrad, effr_in, & + p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & + effrin_cldsnow, tracer, con_g, con_rd, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, cloud_overlap_param, precip_overlap_param, de_lgth, & - deltaZb, errmsg, errflg) + cld_rerain, precip_frac, errmsg, errflg) implicit none ! Inputs @@ -51,29 +48,14 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld i_cldrain, & ! Index into tracer array for cloud rain. i_cldsnow, & ! Index into tracer array for cloud snow. i_cldgrpl, & ! Index into tracer array for cloud groupel. - i_cldtot, & ! Index into tracer array for cloud total amount. - yearlen, & ! Length of current year (365/366) WTF? - iovr, & ! Choice of cloud-overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method - idcor, & ! Choice of method for decorrelation length computation - idcor_con, & ! Flag for decorrelation-length. Use constant value - idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) - idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) + i_cldtot ! Index into tracer array for cloud total amount. logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation effr_in ! Provide hydrometeor radii from macrophysics? real(kind_phys), intent(in) :: & - julian, & ! Julian day - con_pi, & ! Physical constant: pi con_g, & ! Physical constant: gravitational constant - con_rd, & ! Physical constant: gas-constant for dry air - con_epsq, & ! Physical constant(?): Minimum value for specific humidity - dcorr_con ! Decorrelation-length (used if idcor = idcor_con) - real(kind_phys), dimension(nCol), intent(in) :: & - lat ! Latitude + con_rd ! Physical constant: gas-constant for dry air real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) p_lay, & ! Pressure at model-layers (Pa) @@ -87,8 +69,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld tracer ! Cloud condensate amount in layer by type () ! Outputs - real(kind_phys), dimension(nCol),intent(out) :: & - de_lgth ! Decorrelation length real(kind_phys), dimension(nCol,nLev),intent(out) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path @@ -99,10 +79,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_resnow, & ! Cloud snow effective radius cld_rwp, & ! Cloud rain water path cld_rerain, & ! Cloud rain effective radius - precip_frac, & ! Precipitation fraction - cloud_overlap_param, & ! Cloud-overlap parameter - precip_overlap_param, & ! Precipitation overlap parameter - deltaZb ! Layer thickness (km) + precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -110,10 +87,8 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld ! Local variables real(kind_phys) :: tem1,pfac - real(kind_phys), dimension(nLev+1) :: hgtb - real(kind_phys), dimension(nLev) :: hgtc real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate - integer :: iCol,iLay,l,ncndl,iSFC,iTOA + integer :: iCol,iLay,l,ncndl real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ logical :: top_at_1 @@ -131,16 +106,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld return endif - ! What is vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev - iTOA = 1 - else - iSFC = 1 - iTOA = nLev - endif - ! Initialize outputs cld_lwp(:,:) = 0.0 cld_reliq(:,:) = reliq_def @@ -161,143 +126,38 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel tracer(1:nCol,1:nLev,i_cldgrpl) - ! Since we combine the snow and grapuel, define local variable for number of condensate types. - ncndl = min(4,ncnd) - - ! Set really tiny suspended particle amounts to clear - do l=1,ncndl - do iLay=1,nLev - do iCol=1,nCol - if (cld_condensate(iCol,iLay,l) < con_epsq) cld_condensate(iCol,iLay,l) = 0.0 - enddo - enddo - enddo - - ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) - - ! Precipitation fraction (Hack. For now use cloud-fraction) - precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) - - ! Condensate and effective size + ! Cloud water path (g/m2) deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay = 1, nLev do iCol = 1, nCol ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) - if (cld_frac(iCol,iLay) .ge. cllimit) then - tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) - cld_lwp(iCol,iLay) = cld_condensate(iCol,iLay,1) * tem1 - cld_iwp(iCol,iLay) = cld_condensate(iCol,iLay,2) * tem1 - cld_rwp(iCol,iLay) = cld_condensate(iCol,iLay,3) * tem1 - cld_swp(iCol,iLay) = cld_condensate(iCol,iLay,4) * tem1 - endif + tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) + cld_lwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,1) * tem1) + cld_iwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,2) * tem1) + cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) + cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) + enddo + enddo + + ! Particle size + do iLay = 1, nLev + do iCol = 1, nCol ! Use radii provided from the macrophysics if (effr_in) then cld_reliq(iCol,iLay) = effrin_cldliq(iCol,iLay) cld_reice(iCol,iLay) = max(reice_min, min(reice_max,effrin_cldice(iCol,iLay))) cld_rerain(iCol,iLay) = effrin_cldrain(iCol,iLay) cld_resnow(iCol,iLay) = effrin_cldsnow(iCol,iLay) - else - cld_reliq(iCol,iLay) = reliq_def - cld_reice(iCol,iLay) = reice_def - cld_rerain(iCol,iLay) = rerain_def - cld_resnow(iCol,iLay) = resnow_def endif enddo enddo - ! #################################################################################### - ! Cloud (and precipitation) overlap - ! #################################################################################### - ! - ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) - ! - do iCol=1,nCol - if (top_at_1) then - ! Layer thickness (km) - do iLay=1,nLev - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(nLev+1) = 0._kind_phys - do iLay=nLev,1,-1 - hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = nLev, 1, -1 - pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & - abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) - hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) - enddo - ! Layer thickness between centers - do iLay = nLev-1, 1, -1 - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) - enddo - deltaZb(iCol,nLev) = hgtc(nLev) - hgtb(nLev+1) - else - do iLay=nLev,1,-1 - deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) - enddo - ! Height at layer boundaries - hgtb(1) = 0._kind_phys - do iLay=1,nLev - hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) - enddo - ! Height at layer centers - do iLay = 1, nLev - pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & - abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) - hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) - enddo - ! Layer thickness between centers - do iLay = 2, nLev - deltaZb(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) - enddo - deltaZb(iCol,1) = hgtc(1) - hgtb(1) - endif - enddo - - ! - ! Cloud decorrelation length - ! - if (idcor == idcor_hogan) then - call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) - endif - if (idcor == idcor_oreopoulos) then - call cmp_dcorr_lgth(nCol, lat*(180._kind_phys/con_pi), julian, yearlen, de_lgth) - endif - if (idcor == idcor_con) then - de_lgth(:) = dcorr_con - endif - - ! - ! Cloud overlap parameter - ! - if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then - call get_alpha_exp(nCol, nLev, deltaZb, de_lgth, cloud_overlap_param) - else - de_lgth(:) = 0. - cloud_overlap_param(:,:) = 0. - endif - - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers - if (iovr == iovr_exprand) then - do iLay = 1, nLev - do iCol = 1, nCol - if (cld_frac(iCol,iLay) .eq. 0. .and. cld_frac(iCol,iLay-1) .gt. 0.) then - cloud_overlap_param(iCol,iLay) = 0._kind_phys - endif - enddo - enddo - endif - - ! - ! Compute precipitation overlap parameter (Hack. Using same as cloud for now) - ! - precip_overlap_param = cloud_overlap_param + ! Cloud-fraction + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + ! Precipitation fraction (Hack. For now use cloud-fraction) + precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + end subroutine GFS_rrtmgp_gfdlmp_pre_run ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 90f4d5daf..5894d9f5d 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -146,32 +146,6 @@ type = real kind = kind_phys intent = in - optional = F -[yearlen] - standard_name = number_of_days_in_year - long_name = number of days in a year - units = days - dimensions = () - type = integer - intent = in - optional = F -[julian] - standard_name = julian_day - long_name = julian day - units = days - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[lat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - intent = in - kind = kind_phys optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa @@ -209,15 +183,6 @@ kind = kind_phys intent = in optional = F -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [con_g] standard_name = gravitational_acceleration long_name = gravitational acceleration @@ -236,97 +201,6 @@ kind = kind_phys intent = in optional = F -[con_epsq] - standard_name = minimum_value_of_specific_humidity - long_name = floor value for specific humidity - units = kg kg-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[iovr] - standard_name = flag_for_cloud_overlap_method_for_radiation - long_name = flag for cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_dcorr] - standard_name = flag_for_decorrelation_length_cloud_overlap_method - long_name = choice of decorrelation-length cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exp] - standard_name = flag_for_exponential_cloud_overlap_method - long_name = choice of exponential cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iovr_exprand] - standard_name = flag_for_exponential_random_cloud_overlap_method - long_name = choice of exponential-random cloud overlap method - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor] - standard_name = flag_for_decorrelation_length_method - long_name = flag for decorrelation length method used in cloud overlap method (iovr) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_con] - standard_name = flag_for_constant_decorrelation_length_method - long_name = choice of decorrelation length computation (costant) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_hogan] - standard_name = flag_for_hogan_decorrelation_length_method - long_name = choice of decorrelation length computation (hogan) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[idcor_oreopoulos] - standard_name = flag_for_oreopoulos_decorrelation_length_method - long_name = choice of decorrelation length computation (oreopoulos) - units = flag - dimensions = () - type = integer - intent = in - optional = F -[dcorr_con] - standard_name = decorreltion_length_used_by_overlap_method - long_name = decorrelation length (default) used by cloud overlap method (iovr) - units = km - dimensions = () - type = real - intent = in - kind = kind_phys - optional = F -[de_lgth] - standard_name = cloud_decorrelation_length - long_name = cloud decorrelation length - units = km - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -416,34 +290,7 @@ type = real kind = kind_phys intent = out - optional = F -[cloud_overlap_param] - standard_name = cloud_overlap_param - long_name = cloud overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[precip_overlap_param] - standard_name = precip_overlap_param - long_name = precipitation overlap parameter - units = km - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[deltaZb] - standard_name = layer_thickness - long_name = layer_thickness - units = m - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 758e810fb..8b63090c0 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -16,13 +16,9 @@ module GFS_rrtmgp_thompsonmp_pre make_RainNumber implicit none - ! Parameters specific to THOMPSONMP scheme. + ! Parameters specific to THOMPSON MP scheme. real(kind_phys), parameter :: & - reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) - reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) - rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) - resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) - cllimit = 0.001 ! Lowest cloud fraction in GFDL MP scheme + rerain_def = 1000.0 ! Default rain radius to 1000 microns public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize @@ -67,10 +63,10 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation effr_in, & ! Use cloud effective radii provided by model? - uni_cld, & ! - lmfshal, & ! - lmfdeep2, & ! - ltaerosol, & ! + uni_cld, & ! Use provided cloud-fraction? + lmfshal, & ! Flag for mass-flux shallow convection scheme used by Xu-Randall + lmfdeep2, & ! Flag for some scale-aware mass-flux convection scheme active + ltaerosol, & ! Flag for aerosol option do_mynnedmf ! Flag to activate MYNN-EDMF real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant @@ -133,7 +129,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel tracer(1:nCol,1:nLev,i_cldgrpl) - ! Cloud particle size + ! Cloud water path (g/m2) deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay = 1, nLev do iCol = 1, nCol @@ -146,22 +142,23 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do enddo enddo + ! Cloud particle sizes and number concentrations... + ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) orho = 1./rho do iLay = 1, nLev do iCol = 1, nCol qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) - qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) - qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) - qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) - nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) + qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) + qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) + nc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq_nc) / (1.-q_lay(iCol,iLay)) + ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) if (ltaerosol) then - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) else nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) - ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) endif enddo enddo @@ -201,7 +198,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do if (uni_cld) then cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) else - if( lmfshal) alpha0 = 100. ! Default + if( lmfshal) alpha0 = 100. ! Default (from GATE simulations) if(.not. lmfshal) alpha0 = 2000. ! Xu-Randall (1996) cloud-fraction do iLay = 1, nLev @@ -242,10 +239,13 @@ function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) relhum, & ! Relative humidity cld_mr, & ! Total cloud mixing ratio alpha ! Scheme parameter (default=100) + ! Outputs real(kind_phys) :: cld_frac_XuRandall + ! Locals real(kind_phys) :: clwt, clwm, onemrh, tem1, tem2, tem3 + ! Parameters real(kind_phys) :: & lambda = 0.50, & ! From e2143c4b0cc7f3c9550b3258029ac8dbbb2726f2 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 16 Nov 2020 14:45:39 -0700 Subject: [PATCH 115/274] Added option for including scattering in LW clouds. --- physics/rrtmgp_lw_cloud_optics.F90 | 47 +++++++------ physics/rrtmgp_lw_cloud_optics.meta | 12 +++- physics/rrtmgp_lw_cloud_sampling.F90 | 19 ++--- physics/rrtmgp_lw_cloud_sampling.meta | 16 +++-- physics/rrtmgp_lw_rte.F90 | 99 ++++++++++++++++++--------- physics/rrtmgp_lw_rte.meta | 14 +++- physics/rrtmgp_sampling.F90 | 9 ++- physics/rrtmgp_sw_cloud_optics.F90 | 16 ++--- physics/rrtmgp_sw_cloud_sampling.F90 | 4 +- 9 files changed, 152 insertions(+), 84 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index f45f08dd1..a7aeecffe 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -3,7 +3,7 @@ module rrtmgp_lw_cloud_optics use mo_rte_kind, only: wl use mo_cloud_optics, only: ty_cloud_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics use rrtmgp_aux, only: check_error_msg use netcdf @@ -20,14 +20,15 @@ module rrtmgp_lw_cloud_optics contains - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_init() - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & - nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, & + mpirank, mpiroot, lw_cloud_props, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -52,7 +53,7 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ integer, intent(out) :: & errflg ! Error code - ! Variables that will be passed to cloud_optics%load() + ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -264,16 +265,16 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ end subroutine rrtmgp_lw_cloud_optics_init - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE rrtmgp_lw_cloud_optics_run() - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_lw_cloud_optics_run !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nrghice, p_lay, cld_frac, & - cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & - precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, nCol, nLev, nrghice, p_lay, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, errmsg, errflg) ! Inputs @@ -281,7 +282,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw doLWrad, & ! Logical flag for longwave radiation call doG_cldoptics, & ! Use legacy RRTMG cloud-optics? doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -313,7 +315,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag - type(ty_optical_props_1scl),intent(out) :: & + type(ty_optical_props_2str),intent(inout) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) real(kind_phys), dimension(ncol,nLev), intent(out) :: & @@ -337,14 +339,19 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw ! Allocate space for RRTMGP DDTs containing cloud radiative properties ! Cloud optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + lw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + ! Precipitation optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_1scl(& - ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + lw_optical_props_precipByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys + ! Compute cloud-optics for RTE. if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then ! i) RRTMGP cloud-optics. @@ -388,7 +395,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw ! All-sky LW optical depth ~10microns (DJS asks: Same as SW, move to cloud-diagnostics?) cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) - + end subroutine rrtmgp_lw_cloud_optics_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 809e8abf0..cf0418eb4 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -159,6 +159,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -321,7 +329,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [lw_optical_props_precipByBand] @@ -329,7 +337,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [errmsg] diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index cfb86eb3a..7120e125b 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -1,7 +1,7 @@ module rrtmgp_lw_cloud_sampling use machine, only: kind_phys use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg @@ -47,12 +47,13 @@ end subroutine rrtmgp_lw_cloud_sampling_init subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr, & iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, & cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & - lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & + doGP_lwscat, lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for shortwave radiation call + doLWrad, & ! Logical flag for shortwave radiation call + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical layers @@ -78,7 +79,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, precip_overlap_param ! Precipitation overlap parameter type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: K-distribution data - type(ty_optical_props_1scl),intent(in) :: & + type(ty_optical_props_2str),intent(in) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) @@ -87,7 +88,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - type(ty_optical_props_1scl),intent(out) :: & + type(ty_optical_props_2str),intent(out) :: & lw_optical_props_clouds, & ! RRTMGP DDT: Shortwave optical properties by spectral point (clouds) lw_optical_props_precip ! RRTMGP DDT: Shortwave optical properties by spectral point (precipitation) @@ -112,7 +113,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& - lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) + lw_optical_props_clouds%alloc_2str(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -170,7 +171,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_lw_cloud_sampling_run_draw_samples',& - draw_samples(cldfracMCICA, & + draw_samples(cldfracMCICA, doGP_lwscat, & lw_optical_props_cloudsByBand, & lw_optical_props_clouds)) @@ -180,7 +181,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& - lw_optical_props_precip%alloc_1scl(nCol, nLev, lw_gas_props)) + lw_optical_props_precip%alloc_2str(nCol, nLev, lw_gas_props)) ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -230,7 +231,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_lw_precip_sampling_run_draw_samples',& - draw_samples(precipfracSAMP, & + draw_samples(precipfracSAMP, doGP_lwscat, & lw_optical_props_precipByBand, & lw_optical_props_precip)) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 54f3c63af..2438f715c 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -53,6 +53,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -198,7 +206,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = in optional = F [lw_optical_props_precipByBand] @@ -206,7 +214,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = in optional = F [lw_optical_props_clouds] @@ -214,7 +222,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [lw_optical_props_precip] @@ -222,7 +230,7 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl + type = ty_optical_props_2str intent = out optional = F [errmsg] diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index dc49260f6..ccbd80629 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -5,7 +5,7 @@ module rrtmgp_lw_rte use mo_rte_kind, only: wl use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_cloud_optics, only: ty_cloud_optics - use mo_optical_props, only: ty_optical_props_1scl + use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rte_lw, only: rte_lw use mo_fluxes_byband, only: ty_fluxes_byband use mo_source_functions, only: ty_source_func_lw @@ -28,17 +28,18 @@ end subroutine rrtmgp_lw_rte_init !! \section arg_table_rrtmgp_lw_rte_run !! \htmlinclude rrtmgp_lw_rte_run.html !! - subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p_lay, & - t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky,& - lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & - fluxlwDOWN_jac, errmsg, errflg) + subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & + nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, & + lw_optical_props_clrsky, lw_optical_props_clouds, lw_optical_props_aerosol, & + nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & + fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & doLWrad, & ! Logical flag for longwave radiation call doLWclrsky, & ! Compute clear-sky fluxes for clear-sky heating-rate? - use_LW_jacobian ! Compute Jacobian of LW to update radiative fluxes between radiation calls? + use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? + doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -57,10 +58,11 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p type(ty_source_func_lw),intent(in) :: & sources ! RRTMGP DDT: longwave source functions type(ty_optical_props_1scl),intent(inout) :: & + lw_optical_props_aerosol, &! RRTMGP DDT: longwave aerosol radiative properties lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties - type(ty_optical_props_1scl),intent(in) :: & - lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties - lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + type(ty_optical_props_2str),intent(inout) :: & + lw_optical_props_clouds ! RRTMGP DDT: longwave cloud radiative properties + ! Outputs real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) @@ -106,6 +108,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p ! ! Add aerosol optics to gas optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) + !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%finalize()) ! Call RTE solver if (doLWclrsky) then @@ -128,31 +131,61 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, nCol, nLev, p ! ! All-sky fluxes ! - ! Add cloud optics to clear-sky optics - call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) - ! Call RTE solver - if (use_LW_jacobian) then - ! Compute LW Jacobians - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature - flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) - flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + ! Include LW cloud-scattering? + if (doGP_lwscat) then + ! Add clear-sky optics to cloud-optics (2-stream) + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%increment(lw_optical_props_clouds)) + !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%finalize()) + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clouds, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + ! No scattering in LW clouds. else - call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & - lw_optical_props_clrsky, & ! IN - optical-properties - top_at_1, & ! IN - veritcal ordering flag - sources, & ! IN - source function - sfc_emiss_byband, & ! IN - surface emissivity in each LW band - flux_allsky, & ! OUT - Flxues - n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature - end if - + ! Add cloud optics to clear-sky optics (scalar) + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) + !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%finalize()) + + if (use_LW_jacobian) then + ! Compute LW Jacobians + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature + flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) + flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + else + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) ! IN - Number of angles in Gaussian quadrature + end if + endif + ! Store fluxes fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 857ab834c..7adcc2c74 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -32,6 +32,14 @@ type = logical intent = in optional = F +[doGP_lwscat] + standard_name = flag_to_include_longwave_scattering_in_cloud_optics + long_name = logical flag to control the addition of LW scattering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in + optional = F [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -122,8 +130,8 @@ long_name = Fortran DDT containing RRTMGP optical properties units = DDT dimensions = () - type = ty_optical_props_1scl - intent = in + type = ty_optical_props_2str + intent = inout optional = F [lw_optical_props_aerosol] standard_name = longwave_optical_properties_for_aerosols @@ -131,7 +139,7 @@ units = DDT dimensions = () type = ty_optical_props_1scl - intent = in + intent = inout optional = F [sources] standard_name = longwave_source_function diff --git a/physics/rrtmgp_sampling.F90 b/physics/rrtmgp_sampling.F90 index 29a9064a2..3974da359 100644 --- a/physics/rrtmgp_sampling.F90 +++ b/physics/rrtmgp_sampling.F90 @@ -36,9 +36,10 @@ module rrtmgp_sampling ! McICA-sampled cloud optical properties ! ! ------------------------------------------------------------------------------------------------- - function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) + function draw_samples(cloud_mask,do_twostream,clouds,clouds_sampled) result(error_msg) ! Inputs logical, dimension(:,:,:), intent(in ) :: cloud_mask ! Dimensions ncol,nlay,ngpt + logical, intent(in ) :: do_twostream ! Do two-stream? class(ty_optical_props_arry), intent(in ) :: clouds ! Defined by band ! Outputs @@ -66,8 +67,10 @@ function draw_samples(cloud_mask,clouds,clouds_sampled) result(error_msg) type is (ty_optical_props_2str) select type(clouds_sampled) type is (ty_optical_props_2str) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) - call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + if (do_twostream) then + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%ssa,clouds_sampled%ssa) + call apply_cloud_mask(ncol,nlay,nbnd,ngpt,clouds_sampled%get_band_lims_gpoint(),cloud_mask,clouds%g, clouds_sampled%g ) + endif class default error_msg = "draw_samples: by-band and sampled cloud properties need to be the same variable type" end select diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 505fe7853..fec067d9e 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -1,8 +1,8 @@ module rrtmgp_sw_cloud_optics use machine, only: kind_phys use mo_rte_kind, only: wl - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_cloud_optics, only: ty_cloud_optics + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_aux, only: check_error_msg @@ -20,15 +20,15 @@ module rrtmgp_sw_cloud_optics real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s contains - ! ######################################################################################### + ! ###################################################################################### ! SUBROUTINE sw_cloud_optics_init - ! ######################################################################################### + ! ###################################################################################### !! \section arg_table_rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & - nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props,& - errmsg, errflg) + subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & + doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, & + mpirank, mpiroot, sw_cloud_props, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -53,7 +53,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ integer, intent(out) :: & errflg ! CCPP error code - ! Variables that will be passed to cloud_optics%load() + ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation radliq_upr, & ! Liquid particle size upper bound for LUT interpolation @@ -276,7 +276,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, doGP_ c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & - 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) end subroutine rrtmgp_sw_cloud_optics_init diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index ba4097e96..e74ceb4e5 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -181,7 +181,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_sw_cloud_sampling_run_draw_samples', & - draw_samples(cldfracMCICA, & + draw_samples(cldfracMCICA, .true., & sw_optical_props_cloudsByBand, & sw_optical_props_clouds)) @@ -239,7 +239,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd ! Sampling. Map band optical depth to each g-point using McICA ! call check_error_msg('rrtmgp_sw_precip_sampling_run_draw_samples', & - draw_samples(precipfracSAMP, & + draw_samples(precipfracSAMP, .true., & sw_optical_props_precipByBand, & sw_optical_props_precip)) From 5964c9811e5452699717ae008487e21772f08083 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 16 Nov 2020 15:11:40 -0700 Subject: [PATCH 116/274] Bugfix in cires_ugwp.{F90,meta}: pass missing constants to GWDPS_V0 --- physics/cires_ugwp.F90 | 8 ++++---- physics/cires_ugwp.meta | 9 +++++++++ physics/ugwp_driver_v0.F | 5 ++--- 3 files changed, 15 insertions(+), 7 deletions(-) diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index f24ae39ae..21b331041 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -155,7 +155,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & dudt_mtb,dudt_ogw, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, & - rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & + con_omega, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & ldiag3d, lssav, flag_for_gwd_generic_tend, errmsg, errflg) @@ -192,7 +192,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr real(kind=kind_phys), intent(inout), dimension(im, levs):: dudt, dvdt, dtdt - real(kind=kind_phys), intent(in) :: con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt + real(kind=kind_phys), intent(in) :: con_g, con_pi, con_cp, con_rd, con_rv, con_fvirt, con_omega real(kind=kind_phys), intent(in), dimension(im) :: rain @@ -245,8 +245,8 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr ugrs, vgrs, tgrs, qgrs(:,:,1), kpbl, prsi,del,prsl, prslk, phii, phil, & dtp, kdt, sgh30, hprime, oc, oa4, clx, theta, sigma, gamma, elvmax, & dusfcg, dvsfcg, xlat_d, sinlat, coslat, area, cdmbgwd(1:2), & - me, master, rdxzb, zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & - dudt_mtb, dudt_ogw, dudt_tms) + me, master, rdxzb, con_g, con_omega, zmtb, zogw, tau_mtb, tau_ogw, & + tau_tofd, dudt_mtb, dudt_ogw, dudt_tms) else ! calling old GFS gravity wave drag as is diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index ca1e573ba..133cd5b1d 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -806,6 +806,15 @@ kind = kind_phys intent = in optional = F +[con_omega] + standard_name = angular_velocity_of_earth + long_name = angular velocity of earth + units = s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [rain] standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total rain at this time step diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 3e3411fa8..c47079992 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1,4 +1,4 @@ -!!23456 +! module sso_coorde ! ! specific to COORDE-2019 project OGW switches/sensitivity @@ -289,8 +289,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, & PRSI,DEL,PRSL,PRSLK,PHII, PHIL,DTP,KDT, & sgh30, HPRIME,OC,OA4,CLX4,THETA,vSIGMA,vGAMMA,ELVMAXD, & DUSFC, DVSFC, xlatd, sinlat, coslat, sparea, - & cdmbgwd, me, master, rdxzb, - & con_g, con_omega, + & cdmbgwd, me, master, rdxzb, con_g, con_omega, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & dudt_mtb, dudt_ogw, dudt_tms) !---------------------------------------- From 92eb240ca610c8dec846e5d4c6774c2ce0e60ddd Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 16 Nov 2020 17:33:50 -0700 Subject: [PATCH 117/274] Added finalize calls to rrtmgp_lw_rte --- physics/rrtmgp_lw_rte.F90 | 6 +++--- physics/rte-rrtmgp | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index ccbd80629..bc7bdd5bd 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -108,7 +108,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, ! ! Add aerosol optics to gas optics call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) - !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%finalize()) + call lw_optical_props_aerosol%finalize() ! Call RTE solver if (doLWclrsky) then @@ -136,7 +136,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, if (doGP_lwscat) then ! Add clear-sky optics to cloud-optics (2-stream) call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%increment(lw_optical_props_clouds)) - !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clrsky%finalize()) + call lw_optical_props_clrsky%finalize() if (use_LW_jacobian) then ! Compute LW Jacobians @@ -162,7 +162,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, else ! Add cloud optics to clear-sky optics (scalar) call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) - !call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%finalize()) + call lw_optical_props_clouds%finalize() if (use_LW_jacobian) then ! Compute LW Jacobians diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..38822b3cc 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 38822b3cc686517ab87a039e5dedd57ebbe527d2 From e0643105f0c540ff268ccd4b317b9a9c31c3893a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 17 Nov 2020 11:08:59 -0700 Subject: [PATCH 118/274] Bug fix in LW Jacobian application --- physics/GFS_suite_interstitial.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 551f0e600..38ea1800a 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -245,10 +245,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (use_GP_jacobian) then ! Compute adjustment to the surface flux using Jacobian. if(linit_mod) then - dT(:) = (skt(:) - sktp1r(:)) + dT(:) = (sktp1r(:) - skt(:)) adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) else - adjsfculw(:) = 0. + adjsfculw(:) = fluxlwUP(:,1) linit_mod = .true. endif From 13ea6a534485be5ee9fcc89e6b17c90d01584428 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 10:45:09 -0700 Subject: [PATCH 119/274] Housekeeping --- physics/rrtmgp_lw_rte.F90 | 15 ++++----------- physics/rrtmgp_lw_rte.meta | 27 --------------------------- 2 files changed, 4 insertions(+), 38 deletions(-) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index bc7bdd5bd..cf85aa7f2 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -29,10 +29,10 @@ end subroutine rrtmgp_lw_rte_init !! \htmlinclude rrtmgp_lw_rte_run.html !! subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & - nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, sfc_emiss_byband, sources, & - lw_optical_props_clrsky, lw_optical_props_clouds, lw_optical_props_aerosol, & - nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & - fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac, errmsg, errflg) + nLev, p_lev, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & + lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac,& + errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -44,13 +44,8 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels nGauss_angles ! Number of angles used in Gaussian quadrature - real(kind_phys), dimension(ncol,nLev), intent(in) :: & - p_lay, & ! Pressure @ model layer-centers (hPa) - t_lay ! Temperature (K) real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & p_lev ! Pressure @ model layer-interfaces (hPa) - real(kind_phys), dimension(ncol), intent(in) :: & - skt ! Surface(skin) temperature (K) type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: longwave spectral information real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & @@ -79,8 +74,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) ! Local variables - integer :: & - iCol, iBand, iLay type(ty_fluxes_byband) :: & flux_allsky, flux_clrsky real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 7adcc2c74..443792edf 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -64,15 +64,6 @@ type = integer intent = in optional = F -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure layer - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure level @@ -82,24 +73,6 @@ kind = kind_phys intent = in optional = F -[t_lay] - standard_name = air_temperature_at_layer_for_RRTMGP - long_name = air temperature layer - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[skt] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band long_name = surface emissivity in each RRTMGP LW band From 567b003bce2171da350c883c3b31dca43c261998 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 12:21:50 -0700 Subject: [PATCH 120/274] Add guard against out-of-range effective radii used by LUTs in GP cloud-optics. --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 11 ++++++++++- physics/GFS_rrtmgp_thompsonmp_pre.meta | 2 +- physics/rrtmgp_lw_cloud_optics.F90 | 13 +++++++++---- physics/rrtmgp_sw_cloud_optics.F90 | 13 +++++++++---- 4 files changed, 29 insertions(+), 10 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 8b63090c0..a4dbac22c 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -14,6 +14,7 @@ module GFS_rrtmgp_thompsonmp_pre make_IceNumber, & make_DropletNumber, & make_RainNumber + use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr implicit none ! Parameters specific to THOMPSON MP scheme. @@ -183,10 +184,18 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) enddo - ! Scale Thompson's effective radii from meter to micron and update global effective radii. + ! Scale Thompson's effective radii from meter to micron effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 + + ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from + ! 2.5 - 21.5 microns for liquid clouds, + ! 10 - 180 microns for ice-clouds + effrin_cldliq = max(radliq_lwr, effrin_cldliq, radliq_upr) + effrin_cldice = max(radice_lwr, effrin_cldice, radice_upr) + + ! Update global effective radii arrays. cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index b00e27fd8..e3baf1f6f 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_thompsonmp_pre type = scheme - dependencies = rrtmgp_aux.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90 + dependencies = rrtmgp_aux.F90, module_mp_thompson_make_number_concentrations.F90, module_mp_thompson.F90, rrtmgp_lw_cloud_optics.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index a7aeecffe..1086cee7c 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -17,6 +17,11 @@ module rrtmgp_lw_cloud_optics absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr ! Ice particle size lower bound for LUT interpolation contains @@ -55,11 +60,11 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr, & ! Ice particle size lower bound for LUT interpolation + !radice_lwr, & ! Ice particle size upper bound for LUT interpolation + !radice_upr, & ! Ice particle size lower bound for LUT interpolation radice_fac ! Factor for calculating LUT interpolation indices for ice real(kind_phys), dimension(:,:), allocatable :: & lut_extliq, & ! LUT shortwave liquid extinction coefficient diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index fec067d9e..92f007a99 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -18,6 +18,11 @@ module rrtmgp_sw_cloud_optics a0s = 0.0, & ! a1s = 1.5 ! real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr ! Ice particle size lower bound for LUT interpolation contains ! ###################################################################################### @@ -55,11 +60,11 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! Local variables that will be passed to cloud_optics%load() real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr, & ! Ice particle size lower bound for LUT interpolation + !radice_lwr, & ! Ice particle size upper bound for LUT interpolation + !radice_upr, & ! Ice particle size lower bound for LUT interpolation radice_fac ! Factor for calculating LUT interpolation indices for ice real(kind_phys), dimension(:,:), allocatable :: & lut_extliq, & ! LUT shortwave liquid extinction coefficient From 26bd34afdc36c4468d2f1d7ed2f501862ad2c1f9 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 12:43:18 -0700 Subject: [PATCH 121/274] Bug in previous commit --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index a4dbac22c..710c75ef8 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -192,9 +192,11 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from ! 2.5 - 21.5 microns for liquid clouds, ! 10 - 180 microns for ice-clouds - effrin_cldliq = max(radliq_lwr, effrin_cldliq, radliq_upr) - effrin_cldice = max(radice_lwr, effrin_cldice, radice_upr) - + where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr + where(effrin_cldliq .gt. radliq_upr) effrin_cldliq = radliq_upr + where(effrin_cldice .lt. radice_lwr) effrin_cldice = radice_lwr + where(effrin_cldice .gt. radice_upr) effrin_cldice = radice_upr + ! Update global effective radii arrays. cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) From f81a1943629cb6158dd8f514e4ab330ed5ecf578 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 18 Nov 2020 14:12:53 -0700 Subject: [PATCH 122/274] Added logic to pnly guard effective radii when using GP cloud-optics. --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 16 ++++++++++------ physics/GFS_rrtmgp_thompsonmp_pre.meta | 18 +++++++++++++++++- 2 files changed, 27 insertions(+), 7 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 710c75ef8..bd109ddf4 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -39,7 +39,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do i_cldice_nc, i_twa, effr_in, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, & effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, cld_frac_mg, con_g, & con_rd, uni_cld, lmfshal, lmfdeep2, ltaerosol, do_mynnedmf, imfdeepcnv, & - imfdeepcnv_gf, & + imfdeepcnv_gf, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, errmsg, errflg) @@ -68,7 +68,9 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do lmfshal, & ! Flag for mass-flux shallow convection scheme used by Xu-Randall lmfdeep2, & ! Flag for some scale-aware mass-flux convection scheme active ltaerosol, & ! Flag for aerosol option - do_mynnedmf ! Flag to activate MYNN-EDMF + do_mynnedmf, & ! Flag to activate MYNN-EDMF + doGP_cldoptics_LUT,& ! Flag to do GP cloud-optics (LUTs) + doGP_cldoptics_PADE ! (PADE approximation) real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant con_rd ! Physical constant: gas-constant for dry air @@ -192,10 +194,12 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from ! 2.5 - 21.5 microns for liquid clouds, ! 10 - 180 microns for ice-clouds - where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr - where(effrin_cldliq .gt. radliq_upr) effrin_cldliq = radliq_upr - where(effrin_cldice .lt. radice_lwr) effrin_cldice = radice_lwr - where(effrin_cldice .gt. radice_upr) effrin_cldice = radice_upr + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then + where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr + where(effrin_cldliq .gt. radliq_upr) effrin_cldliq = radliq_upr + where(effrin_cldice .lt. radice_lwr) effrin_cldice = radice_lwr + where(effrin_cldice .gt. radice_upr) effrin_cldice = radice_upr + endif ! Update global effective radii arrays. cld_reliq(1:nCol,1:nLev) = effrin_cldliq(1:nCol,1:nLev) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index e3baf1f6f..2368a7337 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -226,7 +226,23 @@ dimensions = () type = integer intent = in - optional = F + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation From af316340e3337e45cde702929388d3b005c75c31 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 18 Nov 2020 14:36:40 -0700 Subject: [PATCH 123/274] Change horizontal_dimension to horizontal_loop_extent in several new/modified schemes --- physics/tracer_sanitizer.meta | 2 +- physics/unified_ugwp.meta | 164 ++++++++++++++++----------------- physics/unified_ugwp_post.F90 | 8 +- physics/unified_ugwp_post.meta | 66 ++++++------- 4 files changed, 112 insertions(+), 128 deletions(-) diff --git a/physics/tracer_sanitizer.meta b/physics/tracer_sanitizer.meta index 0378911ed..e41d5d03d 100644 --- a/physics/tracer_sanitizer.meta +++ b/physics/tracer_sanitizer.meta @@ -12,7 +12,7 @@ standard_name = tracer_concentration_updated_by_physics long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 49f9365fd..675a68edd 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -383,7 +383,7 @@ standard_name = orography long_name = orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -392,7 +392,7 @@ standard_name = orography_unfiltered long_name = unfiltered orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -401,7 +401,7 @@ standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -418,7 +418,7 @@ standard_name = convexity_of_subgrid_orography long_name = convexity of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -427,7 +427,7 @@ standard_name = angle_from_east_of_maximum_subgrid_orographic_variations long_name = angle with_respect to east of maximum subgrid orographic variations units = degree - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -436,7 +436,7 @@ standard_name = slope_of_subgrid_orography long_name = slope of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -445,7 +445,7 @@ standard_name = anisotropy_of_subgrid_orography long_name = anisotropy of subgrid orography units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -454,7 +454,7 @@ standard_name = maximum_subgrid_orography long_name = maximum of subgrid orography units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -463,7 +463,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -472,7 +472,7 @@ standard_name = asymmetry_of_subgrid_orography long_name = asymmetry of subgrid orography units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -481,7 +481,7 @@ standard_name = standard_deviation_of_subgrid_orography_small_scale long_name = standard deviation of subgrid orography small scale units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -490,7 +490,7 @@ standard_name = convexity_of_subgrid_orography_small_scale long_name = convexity of subgrid orography small scale units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -499,7 +499,7 @@ standard_name = asymmetry_of_subgrid_orography_small_scale long_name = asymmetry of subgrid orography small scale units = none - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -508,7 +508,7 @@ standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height small scale units = frac - dimensions = (horizontal_dimension,4) + dimensions = (horizontal_loop_extent,4) type = real kind = kind_phys intent = in @@ -517,7 +517,7 @@ standard_name = cell_size long_name = size of the grid cell units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -526,7 +526,7 @@ standard_name = integrated_x_momentum_flux_from_large_scale_gwd long_name = integrated x momentum flux from large scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -535,7 +535,7 @@ standard_name = integrated_y_momentum_flux_from_large_scale_gwd long_name = integrated y momentum flux from large scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -544,7 +544,7 @@ standard_name = integrated_x_momentum_flux_from_blocking_drag long_name = integrated x momentum flux from blocking drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -553,7 +553,7 @@ standard_name = integrated_y_momentum_flux_from_blocking_drag long_name = integrated y momentum flux from blocking drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -562,7 +562,7 @@ standard_name = integrated_x_momentum_flux_from_small_scale_gwd long_name = integrated x momentum flux from small scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -571,7 +571,7 @@ standard_name = integrated_y_momentum_flux_from_small_scale_gwd long_name = integrated y momentum flux from small scale gwd units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -580,7 +580,7 @@ standard_name = integrated_x_momentum_flux_from_form_drag long_name = integrated x momentum flux from form drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -589,7 +589,7 @@ standard_name = integrated_y_momentum_flux_from_form_drag long_name = integrated y momentum flux from form drag units = Pa s - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -598,7 +598,7 @@ standard_name = x_momentum_tendency_from_large_scale_gwd long_name = x momentum tendency from large scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -607,7 +607,7 @@ standard_name = y_momentum_tendency_from_large_scale_gwd long_name = y momentum tendency from large scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -616,7 +616,7 @@ standard_name = x_momentum_tendency_from_blocking_drag long_name = x momentum tendency from blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -625,7 +625,7 @@ standard_name = y_momentum_tendency_from_blocking_drag long_name = y momentum tendency from blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -634,7 +634,7 @@ standard_name = x_momentum_tendency_from_small_scale_gwd long_name = x momentum tendency from small scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -643,7 +643,7 @@ standard_name = y_momentum_tendency_from_small_scale_gwd long_name = y momentum tendency from small scale gwd units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -652,7 +652,7 @@ standard_name = x_momentum_tendency_from_form_drag long_name = x momentum tendency from form drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -661,7 +661,7 @@ standard_name = y_momentum_tendency_from_form_drag long_name = y momentum tendency from form drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -670,7 +670,7 @@ standard_name = bulk_richardson_number_at_lowest_model_level long_name = bulk Richardson number at the surface units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -679,7 +679,7 @@ standard_name = atmosphere_boundary_layer_thickness long_name = PBL thickness units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -688,7 +688,7 @@ standard_name = sea_land_ice_mask_real long_name = landmask: sea/land/ice=0/1/2 units = flag - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -728,7 +728,7 @@ standard_name = latitude long_name = grid latitude units = radian - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -737,7 +737,7 @@ standard_name = latitude_in_degree long_name = latitude in degree north units = degree_north - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -746,7 +746,7 @@ standard_name = sine_of_latitude long_name = sine of the grid latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -755,7 +755,7 @@ standard_name = cosine_of_latitude long_name = cosine of the grid latitude units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -764,7 +764,7 @@ standard_name = cell_area long_name = area of the grid cell units = m2 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -773,7 +773,7 @@ standard_name = x_wind long_name = zonal wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -782,7 +782,7 @@ standard_name = y_wind long_name = meridional wind units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -791,7 +791,7 @@ standard_name = air_temperature long_name = model layer mean temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -800,7 +800,7 @@ standard_name = water_vapor_specific_humidity long_name = mid-layer specific humidity of water vapor units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -809,7 +809,7 @@ standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces units = Pa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -818,7 +818,7 @@ standard_name = air_pressure long_name = mean layer pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -827,7 +827,7 @@ standard_name = dimensionless_exner_function_at_model_layers long_name = dimensionless Exner function at model layer centers units = none - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -836,7 +836,7 @@ standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -845,7 +845,7 @@ standard_name = geopotential long_name = geopotential at model layer centers units = m2 s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -854,7 +854,7 @@ standard_name = air_pressure_difference_between_midlayers long_name = air pressure difference between midlayers units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -863,7 +863,7 @@ standard_name = vertical_index_at_top_of_atmosphere_boundary_layer long_name = vertical index at top atmospheric boundary layer units = index - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = integer intent = in optional = F @@ -871,7 +871,7 @@ standard_name = instantaneous_x_stress_due_to_gravity_wave_drag long_name = zonal surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -880,7 +880,7 @@ standard_name = instantaneous_y_stress_due_to_gravity_wave_drag long_name = meridional surface stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -891,7 +891,7 @@ standard_name = tendency_of_x_wind_due_to_ugwp long_name = zonal wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -900,7 +900,7 @@ standard_name = tendency_of_y_wind_due_to_ugwp long_name = meridional wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -909,7 +909,7 @@ standard_name = tendency_of_air_temperature_due_to_ugwp long_name = air temperature tendency due to UGWP units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -918,7 +918,7 @@ standard_name = eddy_mixing_due_to_ugwp long_name = eddy mixing due to UGWP units = m2 s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -927,7 +927,7 @@ standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag long_name = momentum flux or stress due to TOFD units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -936,7 +936,7 @@ standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag long_name = momentum flux or stress due to mountain blocking drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -945,7 +945,7 @@ standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag long_name = momentum flux or stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -954,7 +954,7 @@ standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave long_name = momentum flux or stress due to nonstationary gravity waves units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -963,7 +963,7 @@ standard_name = height_of_mountain_blocking long_name = height of mountain blocking drag units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -972,7 +972,7 @@ standard_name = height_of_low_level_wave_breaking long_name = height of low level wave breaking units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -981,7 +981,7 @@ standard_name = height_of_launch_level_of_orographic_gravity_wave long_name = height of launch level of orographic gravity wave units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -990,7 +990,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -999,7 +999,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1008,7 +1008,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = out @@ -1017,7 +1017,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag long_name = time integral of change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1026,7 +1026,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1035,7 +1035,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1044,7 +1044,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1053,7 +1053,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1062,7 +1062,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1071,7 +1071,7 @@ standard_name = level_of_dividing_streamline long_name = level of the dividing streamline units = none - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out @@ -1152,7 +1152,7 @@ standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep long_name = total rain at this time step units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -1169,7 +1169,7 @@ standard_name = turbulent_kinetic_energy long_name = turbulent kinetic energy units = J - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1178,7 +1178,7 @@ standard_name = tendency_of_turbulent_kinetic_energy_due_to_model_physics long_name = turbulent kinetic energy tendency due to model physics units = J s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -1203,7 +1203,7 @@ standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in x wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1212,7 +1212,7 @@ standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag long_name = cumulative change in y wind due to orographic gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1221,7 +1221,7 @@ standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag long_name = cumulative change in temperature due to orographic gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1230,7 +1230,7 @@ standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in x wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1239,7 +1239,7 @@ standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag long_name = cumulative change in y wind due to convective gravity wave drag units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -1248,7 +1248,7 @@ standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag long_name = cumulative change in temperature due to convective gravity wave drag units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/unified_ugwp_post.F90 b/physics/unified_ugwp_post.F90 index 39de4b475..3af459d76 100644 --- a/physics/unified_ugwp_post.F90 +++ b/physics/unified_ugwp_post.F90 @@ -6,8 +6,7 @@ module unified_ugwp_post !>\defgroup unified_ugwp_post unified_UGWP Scheme Post !! @{ -!> \section arg_table_unified_ugwp_post_init Argument Table -!! + subroutine unified_ugwp_post_init () end subroutine unified_ugwp_post_init @@ -16,9 +15,6 @@ end subroutine unified_ugwp_post_init !> \section arg_table_unified_ugwp_post_run Argument Table !! \htmlinclude unified_ugwp_post_run.html !! - - - subroutine unified_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & gw_dtdt, gw_dudt, gw_dvdt, tau_tofd, tau_mtb, tau_ogw, & tau_ngw, zmtb, zlwb, zogw, dudt_mtb, dudt_ogw, dudt_tms, & @@ -74,8 +70,6 @@ subroutine unified_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & end subroutine unified_ugwp_post_run -!> \section arg_table_unified_ugwp_post_finalize Argument Table -!! subroutine unified_ugwp_post_finalize () end subroutine unified_ugwp_post_finalize diff --git a/physics/unified_ugwp_post.meta b/physics/unified_ugwp_post.meta index 501e91b8f..85a6bff8e 100644 --- a/physics/unified_ugwp_post.meta +++ b/physics/unified_ugwp_post.meta @@ -3,11 +3,6 @@ type = scheme dependencies = machine.F -######################################################################## -[ccpp-arg-table] - name = unified_ugwp_post_init - type = scheme - ######################################################################## [ccpp-arg-table] name = unified_ugwp_post_run @@ -49,7 +44,7 @@ standard_name = tendency_of_air_temperature_due_to_ugwp long_name = air temperature tendency due to UGWP units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -58,7 +53,7 @@ standard_name = tendency_of_x_wind_due_to_ugwp long_name = zonal wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -67,7 +62,7 @@ standard_name = tendency_of_y_wind_due_to_ugwp long_name = meridional wind tendency due to UGWP units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -76,7 +71,7 @@ standard_name = instantaneous_momentum_flux_due_to_turbulent_orographic_form_drag long_name = momentum flux or stress due to TOFD units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -85,7 +80,7 @@ standard_name = instantaneous_momentum_flux_due_to_mountain_blocking_drag long_name = momentum flux or stress due to mountain blocking drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -94,7 +89,7 @@ standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag long_name = momentum flux or stress due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -103,7 +98,7 @@ standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave long_name = momentum flux or stress due to nonstationary gravity waves units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -112,7 +107,7 @@ standard_name = height_of_mountain_blocking long_name = height of mountain blocking drag units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -121,7 +116,7 @@ standard_name = height_of_low_level_wave_breaking long_name = height of low level wave breaking units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -130,7 +125,7 @@ standard_name = height_of_launch_level_of_orographic_gravity_wave long_name = height of launch level of orographic gravity wave units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in @@ -139,7 +134,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_mountain_blocking_drag long_name = instantaneous change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -148,7 +143,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -157,7 +152,7 @@ standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -166,7 +161,7 @@ standard_name = time_integral_of_height_of_mountain_blocking long_name = time integral of height of mountain blocking drag units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -175,7 +170,7 @@ standard_name = time_integral_of_height_of_low_level_wave_breaking long_name = time integral of height of drag due to low level wave breaking units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -184,7 +179,7 @@ standard_name = time_integral_of_height_of_launch_level_of_orographic_gravity_wave long_name = time integral of height of launch level of orographic gravity wave units = m - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -193,7 +188,7 @@ standard_name = time_integral_of_momentum_flux_due_to_turbulent_orographic_form_drag long_name = time integral of momentum flux due to TOFD units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -202,7 +197,7 @@ standard_name = time_integral_of_momentum_flux_due_to_mountain_blocking_drag long_name = time integral of momentum flux due to mountain blocking drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -211,7 +206,7 @@ standard_name = time_integral_of_momentum_flux_due_to_orographic_gravity_wave_drag long_name = time integral of momentum flux due to orographic gravity wave drag units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -220,7 +215,7 @@ standard_name = time_integral_of_momentum_flux_due_to_nonstationary_gravity_wave long_name = time integral of momentum flux due to nonstationary gravity waves units = Pa - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -229,7 +224,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag long_name = time integral of change in x wind due to mountain blocking drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -238,7 +233,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag long_name = time integral of change in x wind due to orographic gw drag units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -247,7 +242,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag long_name = time integral of change in x wind due to TOFD units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -256,7 +251,7 @@ standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in x wind due to NGW units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -265,7 +260,7 @@ standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave long_name = time integral of change in y wind due to NGW units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -274,7 +269,7 @@ standard_name = tendency_of_air_temperature_due_to_model_physics long_name = air temperature tendency due to model physics units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -283,7 +278,7 @@ standard_name = tendency_of_x_wind_due_to_model_physics long_name = zonal wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -292,7 +287,7 @@ standard_name = tendency_of_y_wind_due_to_model_physics long_name = meridional wind tendency due to model physics units = m s-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -314,8 +309,3 @@ type = integer intent = out optional = F - -######################################################################## -[ccpp-arg-table] - name = unified_ugwp_post_finalize - type = scheme From 551be294e2487d44731f38cf22814934a4d8967a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Nov 2020 11:29:26 -0700 Subject: [PATCH 124/274] Bugfix in physics/cires_ugwp_module_v1.F90: remove unnecessary and ill-defined variable knob_ugwp_tlimb --- physics/cires_ugwp_module_v1.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/cires_ugwp_module_v1.F90 b/physics/cires_ugwp_module_v1.F90 index 9b245ed11..fd41d8175 100644 --- a/physics/cires_ugwp_module_v1.F90 +++ b/physics/cires_ugwp_module_v1.F90 @@ -59,7 +59,6 @@ module cires_ugwp_module_v1 real :: knob_ugwp_taumin = 0.25e-3 real :: knob_ugwp_tauamp = 7.75e-3 ! range from 30.e-3 to 3.e-3 ( space-borne values) real :: knob_ugwp_lhmet = 200.e3 ! 200 km - real :: knob_ugwp_tlimb = .true. ! real :: kxw = pi2/200.e3 ! single horizontal wavenumber of ugwp schemes ! @@ -102,7 +101,7 @@ module cires_ugwp_module_v1 knob_ugwp_ndx4lh, knob_ugwp_version, knob_ugwp_palaunch, knob_ugwp_nslope, knob_ugwp_lzmax, & knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & knob_ugwp_qbolev, knob_ugwp_qbosin, knob_ugwp_qbotav, knob_ugwp_qboamp, knob_ugwp_qbotau, & - knob_ugwp_qbolat, knob_ugwp_qbowid, knob_ugwp_tlimb, knob_ugwp_orosolv + knob_ugwp_qbolat, knob_ugwp_qbowid, knob_ugwp_orosolv !&cires_ugwp_nml ! knob_ugwp_solver=2 From 83654f1ec5999737292a9bc2a8fe6386d0555e64 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Nov 2020 08:42:57 -0700 Subject: [PATCH 125/274] Bugfixes in RUC LSM for land-ice implementation --- physics/module_sf_ruclsm.F90 | 13 ++++++++++--- physics/sfc_drv_ruc.F90 | 12 +++++++----- physics/sfc_drv_ruc.meta | 4 ++-- 3 files changed, 19 insertions(+), 10 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index f7ce8cfbe..a0e74ce7a 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -506,7 +506,14 @@ SUBROUTINE LSMRUC( & soilice(k)=0. soiliqw(k)=0. enddo - endif ! init=.true., iter=1 + else ! .not. init==true. + DO J=jts,jte + DO i=its,ite + SFCRUNOFF(i,j) = 0. + UDRUNOFF(i,j) = 0. + ENDDO + ENDDO + endif ! init==.true. !----------------------------------------------------------------- @@ -6518,7 +6525,7 @@ SUBROUTINE VILKA(TN,D1,D2,PP,QS,TS,TT,NSTEP,ii,j,iland,isoil) REAL :: F1,T1,T2,RN INTEGER :: I,I1 - + I=(TN-1.7315E2)/.05+1 T1=173.1+FLOAT(I)*.05 F1=T1+D1*TT(I)-D2 @@ -6529,7 +6536,7 @@ SUBROUTINE VILKA(TN,D1,D2,PP,QS,TS,TT,NSTEP,ii,j,iland,isoil) T1=173.1+FLOAT(I)*.05 F1=T1+D1*TT(I)-D2 RN=F1/(.05+D1*(TT(I+1)-TT(I))) - I=I-INT(RN) + I=I-INT(RN) IF(I.GT.5000.OR.I.LT.1) GOTO 1 IF(I1.NE.I) GOTO 10 TS=T1-.05*RN diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 0d41c3e4a..88e9facf5 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -777,14 +777,14 @@ subroutine lsm_ruc_run & ! inputs write (0,*)'MODIS landuse is not available' endif - if (land(i)) then ! at least some land in the grid cell - if(rdlai2d) then xlai(i,j) = laixy(i) else xlai(i,j) = 0. endif + if (land(i)) then ! at least some land in the grid cell + !> - 4. history (state) variables (h): !!\n \a cmc - canopy moisture content (\f$mm\f$) !!\n \a soilt = tskin - ground/canopy/snowpack effective skin temperature (\f$K\f$) @@ -825,13 +825,13 @@ subroutine lsm_ruc_run & ! inputs cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! clu_q2m_iter - tsnav_lnd(i,j) = 0.5*(soilt_lnd(i,j) + soilt1_lnd(i,j)) - 273.15 ! sanity check for snow temperature tsnow if (tsnow_lnd(i) > 0. .and. tsnow_lnd(i) < 273.15) then soilt1_lnd(i,j) = tsnow_lnd(i) else soilt1_lnd(i,j) = tsurf_lnd(i) endif + tsnav_lnd(i,j) = 0.5*(soilt_lnd(i,j) + soilt1_lnd(i,j)) - 273.15 do k = 1, lsoil_ruc smsoil (i,k,j) = smois(i,k) slsoil (i,k,j) = sh2o(i,k) @@ -1113,13 +1113,15 @@ subroutine lsm_ruc_run & ! inputs qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i)) qcg_ice(i,j) = sfcqc_ice(i) sfcems_ice(i,j) = semis_ice(i) + + cmc(i,j) = canopy(i) ! [mm] soilt_ice(i,j) = tsurf_ice(i) ! clu_q2m_iter - tsnav_ice(i,j) = 0.5*(soilt_ice(i,j) + soilt1_ice(i,j)) - 273.15 if (tsnow_ice(i) > 0. .and. tsnow_ice(i) < 273.15) then soilt1_ice(i,j) = tsnow_ice(i) else soilt1_ice(i,j) = tsurf_ice(i) endif + tsnav_ice(i,j) = 0.5*(soilt_ice(i,j) + soilt1_ice(i,j)) - 273.15 do k = 1, lsoil_ruc stsice (i,k,j) = tsice(i,k) smsoil (i,k,j) = 1. @@ -1132,7 +1134,7 @@ subroutine lsm_ruc_run & ! inputs chs_ice (i,j) = ch_ice(i) * wind(i) ! compute conductance flhc_ice(i,j) = chs_ice(i,j) * rho(i) * con_cp ! * (1. + 0.84*q2(i,1,j)) - flqc_ice(i,j) = chs_ice(i,j) * rho(i) * wet(i,j) + flqc_ice(i,j) = chs_ice(i,j) * rho(i) * wet_ice(i,j) ! for output cmm_ice(i) = cm_ice (i) * wind(i) chh_ice(i) = chs_ice(i,j) * rho(i) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 49ee875d6..77c90ef29 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -1267,8 +1267,8 @@ intent = in optional = F [ch_ice] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air - long_name = surface exchange coeff heat & moisture + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_ice + long_name = surface exchange coeff heat & moisture over ice units = none dimensions = (horizontal_dimension) type = real From dc007b0040c9c128d8355817f97f6a948dce6c06 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Nov 2020 08:43:47 -0700 Subject: [PATCH 126/274] Update MYNN surface layer scheme to work with RUC ICE --- physics/module_MYNNSFC_wrapper.F90 | 23 ++++++++++++++++------- physics/module_MYNNSFC_wrapper.meta | 25 +++++++++++++++++++++---- physics/module_sf_mynn.F90 | 8 ++++---- 3 files changed, 41 insertions(+), 15 deletions(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 7cc64bbcf..717024e41 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -30,7 +30,7 @@ end subroutine mynnsfc_wrapper_finalize SUBROUTINE mynnsfc_wrapper_run( & & im,levs, & & itimestep,iter, & - & flag_init,flag_restart,lsm, & + & flag_init,flag_restart,lsm,lsm_ruc,& & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & !intent(in) & redrag,sfc_z0_type, & !intent(in) @@ -54,7 +54,8 @@ SUBROUTINE mynnsfc_wrapper_run( & & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) & hflx_ocn, hflx_lnd, hflx_ice, & & qflx_ocn, qflx_lnd, qflx_ice, & - & QSFC, qsfc_ruc, USTM, ZOL, MOL, & + & QSFC, qsfc_lnd_ruc, qsfc_ice_ruc, & + & USTM, ZOL, MOL, & & RMOL, WSPD, ch, HFLX, QFLX, LH, & & FLHC, FLQC, & & U10, V10, TH2, T2, Q2, & @@ -122,7 +123,7 @@ SUBROUTINE mynnsfc_wrapper_run( & !MYNN-1D REAL :: delt INTEGER :: im, levs - INTEGER :: iter, k, i, itimestep, lsm + INTEGER :: iter, k, i, itimestep, lsm, lsm_ruc LOGICAL :: flag_init,flag_restart,lprnt INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & & IMS,IME,JMS,JME,KMS,KME, & @@ -160,11 +161,12 @@ SUBROUTINE mynnsfc_wrapper_run( & & qsfc_ocn, qsfc_lnd, qsfc_ice !MYNN-2D - real(kind=kind_phys), dimension(im), intent(in) :: & - & dx, pblh, slmsk, ps + real(kind=kind_phys), dimension(:), intent(in) :: & + & dx, pblh, slmsk, ps, & + & qsfc_lnd_ruc, qsfc_ice_ruc real(kind=kind_phys), dimension(im), intent(inout) :: & - & ustm, hflx, qflx, wspd, qsfc, qsfc_ruc, & + & ustm, hflx, qflx, wspd, qsfc, & & FLHC, FLQC, U10, V10, TH2, T2, Q2, & & CHS2, CQS2, rmol, zol, mol, ch, & & lh, wstar @@ -172,7 +174,7 @@ SUBROUTINE mynnsfc_wrapper_run( & real, dimension(im) :: & & hfx, znt, psim, psih, & & chs, ck, cd, mavail, xland, GZ1OZ0, & - & cpm, qgh, qfx + & cpm, qgh, qfx, qsfc_ruc ! Initialize CCPP error handling variables errmsg = '' @@ -216,6 +218,13 @@ SUBROUTINE mynnsfc_wrapper_run( & where (wet) znt_ocn=znt_ocn*0.01 where (icy) znt_ice=znt_ice*0.01 + ! qsfc ruc + qsfc_ruc = 0.0 + if (lsm==lsm_ruc) then + where (dry) qsfc_ruc = qsfc_lnd_ruc + where (icy) qsfc_ruc = qsfc_ice_ruc + end if + ! if (lprnt) then ! write(0,*)"CALLING SFCLAY_mynn; input:" ! write(0,*)"T:",t3d(1,1),t3d(1,2),t3d(1,3) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 59df18419..87bdf3806 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -63,6 +63,14 @@ type = integer intent = in optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [sigmaf] standard_name = bounded_vegetation_area_fraction long_name = areal fractional cover of green vegetation bounded on the bottom @@ -713,14 +721,23 @@ kind = kind_phys intent = inout optional = F -[qsfc_ruc] - standard_name = water_vapor_mixing_ratio_at_surface - long_name = water vapor mixing ratio at surface +[qsfc_lnd_ruc] + standard_name = water_vapor_mixing_ratio_at_surface_over_land + long_name = water vapor mixing ratio at surface over land units = kg kg-1 dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = inout + intent = in + optional = F +[qsfc_ice_ruc] + standard_name = water_vapor_mixing_ratio_at_surface_over_ice + long_name = water vapor mixing ratio at surface over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in optional = F [ustm] standard_name = surface_friction_velocity_drag diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index ebbc3dcf9..76fa24866 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -149,7 +149,7 @@ SUBROUTINE SFCLAY_mynn( & CP,G,ROVCP,R,XLV, & !in SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, & !in ISFFLX,isftcflx,lsm,iz0tlnd,psi_opt, & !in - & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & !intent(in) & redrag,sfc_z0_type, & !intent(in) itimestep,iter, & !in @@ -351,7 +351,8 @@ SUBROUTINE SFCLAY_mynn( & REAL, DIMENSION( ims:ime ), INTENT(IN) :: & & tskin_ocn, tskin_lnd, tskin_ice, & & tsurf_ocn, tsurf_lnd, tsurf_ice, & - & snowh_ocn, snowh_lnd, snowh_ice + & snowh_ocn, snowh_lnd, snowh_ice, & + & qsfc_ruc REAL, DIMENSION( ims:ime), INTENT(INOUT) :: & & ZNT_ocn, ZNT_lnd, ZNT_ice, & @@ -366,8 +367,7 @@ SUBROUTINE SFCLAY_mynn( & & fh2_ocn, fh2_lnd, fh2_ice, & & HFLX_ocn, HFLX_lnd, HFLX_ice, & & QFLX_ocn, QFLX_lnd, QFLX_ice, & - & qsfc_ocn, qsfc_lnd, qsfc_ice, & - & qsfc_ruc + & qsfc_ocn, qsfc_lnd, qsfc_ice !ADDITIONAL OUTPUT !JOE-begin From cfc437e6ad5d37400ac01fe022e54b3323a15b02 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 24 Nov 2020 11:31:34 -0700 Subject: [PATCH 127/274] Some changes tot est in UFS. --- physics/GFS_rrtmgp_lw_post.F90 | 10 +++--- physics/GFS_rrtmgp_lw_post.meta | 12 ++++---- physics/GFS_rrtmgp_pre.F90 | 46 +++++++++++++++++++++++----- physics/GFS_rrtmgp_pre.meta | 8 +++++ physics/rrtmgp_lw_cloud_optics.F90 | 10 +++--- physics/rrtmgp_lw_cloud_sampling.F90 | 8 +++-- physics/rrtmgp_lw_gas_optics.F90 | 10 +++--- physics/rrtmgp_lw_gas_optics.meta | 2 +- 8 files changed, 75 insertions(+), 31 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 537ce8879..e6f6a59a5 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -65,12 +65,12 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(out) :: & + real(kind_phys), dimension(nCol), intent(inout) :: & sfcdlw, & ! Total sky sfc downward lw flux (W/m2) tsflw ! surface air temp during lw calculation (K) - type(sfcflw_type), dimension(nCol), intent(out) :: & + type(sfcflw_type), dimension(nCol), intent(inout) :: & sfcflw ! LW radiation fluxes at sfc - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrlw ! LW all-sky heating rate type(topflw_type), dimension(nCol), intent(out) :: & topflw ! lw_fluxes_top_atmosphere @@ -80,13 +80,13 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag errflg ! Outputs (optional) - type(proflw_type), dimension(nCol, nLev+1), optional, intent(out) :: & + type(proflw_type), dimension(nCol, nLev+1), optional, intent(inout) :: & flxprf_lw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrlwc ! Longwave clear-sky heating-rate (K/sec) ! Local variables diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 2218bc55e..a87b6adcb 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -196,7 +196,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcflw] standard_name = lw_fluxes_sfc @@ -204,7 +204,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = sfcflw_type - intent = out + intent = inout optional = F [tsflw] standard_name = surface_midlayer_air_temperature_in_longwave_radiation @@ -213,7 +213,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [htrlw] standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step @@ -222,7 +222,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [topflw] standard_name = lw_fluxes_top_atmosphere @@ -238,7 +238,7 @@ units = W m-2 dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = proflw_type - intent = out + intent = inout optional = T [htrlwc] standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step @@ -247,7 +247,7 @@ dimensions = (horizontal_loop_extent,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys - intent = out + intent = inout optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index f4542dffb..35e1eb67c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -145,7 +145,7 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, con_eps,& - con_epsm1, con_fvirt, con_epsqs, & + con_epsm1, con_fvirt, con_epsqs, lw_gas_props, & raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,& gas_concentrations, errmsg, errflg) @@ -181,6 +181,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, prsi ! Pressure at model-interfaces (Pa) real(kind_phys), dimension(nCol,nLev,nTracers) :: & qgrs ! Tracer concentrations (kg/kg) + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: ! Outputs character(len=*), intent(out) :: & @@ -198,7 +200,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, q_lay, & ! Water-vapor mixing ratio (kg/kg) tv_lay, & ! Virtual temperature at model-layers relhum, & ! Relative-humidity at model-layers - qs_lay ! Saturation vapor pressure at model-layers + qs_lay ! Saturation vapor pressure at model-layers real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface @@ -212,7 +214,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, logical :: top_at_1 real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, tem1, tem2 - real(kind_phys), dimension(nCol,nLev) :: o3_lay + real(kind_phys), dimension(nCol,nLev) :: o3_lay, tem2da, tem2db real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr ! Initialize CCPP error handling variables @@ -250,14 +252,44 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Temperature at layer-center t_lay(1:NCOL,:) = tgrs(1:NCOL,:) - ! Temperature at layer-interfaces + ! Temperature at layer-interfaces if (top_at_1) then + tem2da(1:nCol,2:iSFC) = log(p_lay(1:nCol,2:iSFC)) + tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1) ) + tem2db(iCol,1) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,1)) ) + tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) ) + enddo + ! t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) - t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + do iLay = 2, iSFC + do iCol = 1, nCol + t_lev(iCol,iLay) = t_lay(iCol,iLay) + (t_lay(iCol,iLay-1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) + enddo + enddo + !t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) else + tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) + tem2db(1:nCol,2:iTOA) = log(p_lev(1:nCol,2:iTOA)) + do iCol = 1, nCol + tem2da(iCol,1) = log(p_lay(iCol,1)) + tem2db(iCol,1) = log(p_lev(iCol,1)) + tem2db(iCol,iTOA) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,iTOA)) ) + enddo + ! t_lev(1:NCOL,1) = tsfc(1:NCOL) - t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + do iLay = 1, iTOA-1 + do iCol = 1, nCol + t_lev(iCol,iLay+1) = t_lay(iCol,iLay) + (t_lay(iCol,iLay+1) - t_lay(iCol,iLay))& + * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & + / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) + enddo + enddo + !t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif @@ -321,7 +353,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### tsfg(1:NCOL) = tsfc(1:NCOL) - tsfa(1:NCOL) = tsfc(1:NCOL) + tsfa(1:NCOL) = t_lay(1:NCOL,iSFC)!tsfc(1:NCOL) end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 904c0e4e7..136898bb3 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -247,6 +247,14 @@ 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 + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 1086cee7c..023df62ec 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -347,14 +347,14 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - lw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys lw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys ! Precipitation optics [nCol,nLev,nBands] call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - lw_optical_props_precipByBand%ssa(:,:,:) = 0._kind_phys + lw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys lw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. @@ -393,9 +393,9 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & cld_frac, icliq_lw, icice_lw, tau_cld, tau_precip) - endif - lw_optical_props_cloudsByBand%tau = tau_cld - lw_optical_props_precipByBand%tau = tau_precip + lw_optical_props_cloudsByBand%tau = tau_cld + lw_optical_props_precipByBand%tau = tau_precip + endif endif ! All-sky LW optical depth ~10microns (DJS asks: Same as SW, move to cloud-diagnostics?) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 7120e125b..902a4e20f 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -12,7 +12,7 @@ module rrtmgp_lw_cloud_sampling contains ! ######################################################################################### - ! SUBROUTINE mcica_init + ! SUBROUTINE rrtmgp_lw_cloud_sampling_init() ! ######################################################################################### !! \section arg_table_rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_init.html @@ -97,8 +97,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 - real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D + real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA,precipfracSAMP ! Initialize CCPP error handling variables @@ -114,6 +114,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_clouds%alloc_2str(nCol, nLev, lw_gas_props)) + lw_optical_props_clouds%tau(:,:,:) = 0._kind_phys + lw_optical_props_clouds%ssa(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed @@ -182,6 +184,8 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] call check_error_msg('rrtmgp_lw_cloud_sampling_run',& lw_optical_props_precip%alloc_2str(nCol, nLev, lw_gas_props)) + lw_optical_props_precip%tau(:,:,:) = 0._kind_phys + lw_optical_props_precip%ssa(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). if(isubc_lw == 1) then ! advance prescribed permutation seed diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 787db6bb4..813699ae0 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -282,7 +282,7 @@ end subroutine rrtmgp_lw_gas_optics_init !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_lev, t_lay,& - t_lev, skt, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) + t_lev, tsfg, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -299,7 +299,7 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ p_lev, & ! Pressure @ model layer-interfaces (hPa) t_lev ! Temperature @ model levels real(kind_phys), dimension(ncol), intent(in) :: & - skt ! Surface(skin) temperature (K) + tsfg ! Surface ground temperature (K) type(ty_gas_concs),intent(in) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) @@ -328,11 +328,11 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ p_lay, & ! IN - Pressure @ layer-centers (Pa) p_lev, & ! IN - Pressure @ layer-interfaces (Pa) t_lay, & ! IN - Temperature @ layer-centers (K) - skt, & ! IN - Skin-temperature (K) + tsfg, & ! IN - Skin-temperature (K) gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties - sources, & ! OUT - RRTMGP DDT: source functions - tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) + sources))!, & ! OUT - RRTMGP DDT: source functions + !tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) end subroutine rrtmgp_lw_gas_optics_run diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 92d475d24..3eab78be2 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -165,7 +165,7 @@ kind = kind_phys intent = in optional = F -[skt] +[tsfg] standard_name = surface_ground_temperature_for_radiation long_name = surface ground temperature for radiation units = K From 6d08e55946d8566243a42b95f4506e74c3b96821 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 24 Nov 2020 14:28:03 -0700 Subject: [PATCH 128/274] Updated rte-rrtmgp --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From d12329a9ada515766ccb81771e8ba299ea3a8464 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 25 Nov 2020 13:30:39 -0700 Subject: [PATCH 129/274] Update CODEOWNERS for gsl/develop branch --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 0d5230f89..b6c597371 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl @JulieSchramm +* @DomHeinzeller # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From bc4fcb0dc1a5d00c2f4a2cc31435709547572d3a Mon Sep 17 00:00:00 2001 From: "Shan.Sun" Date: Mon, 30 Nov 2020 20:48:54 +0000 Subject: [PATCH 130/274] Merging these two routines from github.com/SMoorthi-emc/ccpp-physics/tree/SM_Oct102020, to fix a crash from running GFDL MP with frac_Grid=T as well as restart reproducibility. Co-authored-with: Shrinivas Moorthi --- physics/GFS_surface_composites.F90 | 157 +++++++++++++++++----------- physics/GFS_surface_composites.meta | 37 +++++-- 2 files changed, 121 insertions(+), 73 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index cc61662d2..6cbf35f03 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -24,15 +24,15 @@ end subroutine GFS_surface_composites_pre_finalize !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! - subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx, cplwav2atm, & - landfrac, lakefrac, lakedepth, oceanfrac, frland, & - dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorli, zorl_wat, & - zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & - tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & - weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat,& - tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & - gflx_ice, tgice, islmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & - qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & + subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx, cplwav2atm, & + landfrac, lakefrac, lakedepth, oceanfrac, frland, & + dry, icy, lake, ocean, wet, hice, cice, zorl, zorlo, zorll, zorli, zorl_wat, & + zorl_lnd, zorl_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & + weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & + tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & + gflx_ice, tgice, islmsk, islmsk_cice, slmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & + qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & min_lakeice, min_seaice, errmsg, errflg) implicit none @@ -42,9 +42,8 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx logical, intent(in ) :: frac_grid, cplflx, cplwav2atm logical, dimension(im), intent(inout) :: flag_cice logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet - real(kind=kind_phys), intent(in ) :: cimin real(kind=kind_phys), dimension(im), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac - real(kind=kind_phys), dimension(im), intent(inout) :: cice + real(kind=kind_phys), dimension(im), intent(inout) :: cice, hice real(kind=kind_phys), dimension(im), intent( out) :: frland real(kind=kind_phys), dimension(im), intent(in ) :: zorl, snowd, tprcp, uustar, weasd, qss, hflx @@ -55,11 +54,13 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx qss_wat, qss_lnd, qss_ice, hflx_wat, hflx_lnd, hflx_ice, ep1d_ice, gflx_ice real(kind=kind_phys), dimension(im), intent( out) :: tice real(kind=kind_phys), intent(in ) :: tgice - integer, dimension(im), intent(inout) :: islmsk + integer, dimension(im), intent(inout) :: islmsk, islmsk_cice real(kind=kind_phys), dimension(im), intent(in ) :: semis_rad - real(kind=kind_phys), dimension(im), intent(inout) :: semis_wat, semis_lnd, semis_ice + real(kind=kind_phys), dimension(im), intent(inout) :: semis_wat, semis_lnd, semis_ice, slmsk real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice + real(kind=kind_phys), parameter :: timin = 173.0_kind_phys ! minimum temperature allowed for snow/ice + ! CCPP error handling character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -76,37 +77,49 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx frland(i) = landfrac(i) if (frland(i) > zero) dry(i) = .true. if (frland(i) < one) then - if (flag_cice(i)) then + if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. - if (cice(i) < one) wet(i) = .true. ! some open ocean/lake water exists + tisfc(i) = max(timin, min(tisfc(i), tgice)) + if (cplflx) then + islmsk_cice(i) = 4 + flag_cice(i) = .true. + else + islmsk_cice(i) = 2 + endif + islmsk(i) = 2 else cice(i) = zero + hice(i) = zero flag_cice(i) = .false. -! islmsk_cice(i) = 0 -! islmsk(i) = 0 - wet(i) = .true. ! some open ocean/lake water exists + islmsk_cice(i) = 0 + islmsk(i) = 0 + endif + if (cice(i) < one) then + wet(i) = .true. ! some open ocean + if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice) endif else if (cice(i) >= min_lakeice) then icy(i) = .true. - if (cice(i) < one) wet(i) = .true. ! some open ocean/lake water exists islmsk(i) = 2 + tisfc(i) = max(timin, min(tisfc(i), tgice)) else cice(i) = zero -! islmsk(i) = 0 - wet(i) = .true. ! some open ocean/lake water exists + hice(i) = zero + islmsk(i) = 0 endif - endif - if (wet(i) .and. .not. cplflx) then - if (oceanfrac(i) > zero) then - tsfco(i) = max(tsfco(i), tisfc(i), tgice) - elseif (icy(i)) then - tsfco(i) = max(tisfc(i), tgice) + islmsk_cice(i) = islmsk(i) + if (cice(i) < one) then + wet(i) = .true. ! some open lake + if (icy(i)) tsfco(i) = max(tisfc(i), tgice) endif endif - else + else ! all land cice(i) = zero + hice(i) = zero + islmsk_cice(i) = 1 + islmsk(i) = 1 endif enddo @@ -118,27 +131,39 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx dry(i) = .true. frland(i) = one cice(i) = zero + hice(i) = zero else frland(i) = zero - if (flag_cice(i)) then - if (cice(i) > min_seaice) then - icy(i) = .true. + if (oceanfrac(i) > zero) then + if (cice(i) >= min_seaice) then + icy(i) = .true. + tisfc(i) = max(timin, min(tisfc(i), tgice)) else cice(i) = zero + hice(i) = zero flag_cice(i) = .false. islmsk(i) = 0 + islmsk_cice(i) = 0 + endif + if (cice(i) < one) then + wet(i) = .true. ! some open ocean + if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice) endif else - if (cice(i) > min_lakeice) then + if (cice(i) >= min_lakeice) then icy(i) = .true. + tisfc(i) = max(timin, min(tisfc(i), tgice)) else cice(i) = zero + hice(i) = zero + flag_cice(i) = .false. islmsk(i) = 0 endif - endif - if (cice(i) < one) then - wet(i) = .true. ! some open ocean/lake water exists - if (.not. cplflx .and. icy(i)) tsfco(i) = max(tisfc(i), tgice) + islmsk_cice(i) = islmsk(i) + if (cice(i) < one) then + wet(i) = .true. ! some open lake + if (icy(i)) tsfco(i) = max(tisfc(i), tgice) + endif endif endif enddo @@ -170,7 +195,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx ! snowd_wat(i) = snowd(i) weasd_wat(i) = zero snowd_wat(i) = zero - semis_wat(i) = 0.984d0 + semis_wat(i) = 0.984_kind_phys qss_wat(i) = qss(i) hflx_wat(i) = hflx(i) endif @@ -198,6 +223,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx qss_ice(i) = qss(i) hflx_ice(i) = hflx(i) endif + if (nint(slmsk(i)) /= 1) slmsk(i) = islmsk(i) enddo ! to prepare to separate lake from ocean under water category @@ -364,7 +390,7 @@ subroutine GFS_surface_composites_post_run ( ! Local variables integer :: i, k - real(kind=kind_phys) :: txl, txi, txo, tem + real(kind=kind_phys) :: txl, txi, txo, wfrac ! Initialize CCPP error handling variables errmsg = '' @@ -377,9 +403,10 @@ subroutine GFS_surface_composites_post_run ( do i=1, im ! Three-way composites (fields from sfc_diff) - txl = landfrac(i) - txi = cice(i)*(one - txl) ! txi = ice fraction wrt whole cell - txo = max(zero, one - txl - txi) + txl = landfrac(i) ! land fraction + wfrac = one - txl ! ocean fraction + txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell + txo = max(zero, wfrac-txi) ! txo = open water fraction zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_wat(i) cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_wat(i) @@ -404,11 +431,10 @@ subroutine GFS_surface_composites_post_run ( !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_wat(i) if (.not. flag_cice(i) .and. islmsk(i) == 2) then - tem = one - txl - evap(i) = txl*evap_lnd(i) + tem*evap_ice(i) - hflx(i) = txl*hflx_lnd(i) + tem*hflx_ice(i) - qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) - gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + evap(i) = txl*evap_lnd(i) + wfrac*evap_ice(i) + hflx(i) = txl*hflx_lnd(i) + wfrac*hflx_ice(i) + qss(i) = txl*qss_lnd(i) + wfrac*qss_ice(i) + gflx(i) = txl*gflx_lnd(i) + wfrac*gflx_ice(i) else evap(i) = txl*evap_lnd(i) + txi*evap_ice(i) + txo*evap_wat(i) hflx(i) = txl*hflx_lnd(i) + txi*hflx_ice(i) + txo*hflx_wat(i) @@ -451,14 +477,18 @@ subroutine GFS_surface_composites_post_run ( ! tisfc(i) = tsfc_ice(i) ! over ice when uncoupled ! endif - if (.not. flag_cice(i)) then - if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array - tisfc(i) = tice(i) - else ! this would be over open ocean or land (no ice fraction) - hice(i) = zero - cice(i) = zero - tisfc(i) = tsfc(i) - endif +! if (.not. flag_cice(i)) then +! if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array +! tisfc(i) = tice(i) +! else ! this would be over open ocean or land (no ice fraction) +! hice(i) = zero +! cice(i) = zero +! tisfc(i) = tsfc(i) +! endif +! endif + if (.not. icy(i)) then + hice(i) = zero + cice(i) = zero endif enddo @@ -478,6 +508,9 @@ subroutine GFS_surface_composites_post_run ( fh2(i) = fh2_lnd(i) !tsurf(i) = tsurf_lnd(i) tsfcl(i) = tsfc_lnd(i) ! over land + tsfc(i) = tsfcl(i) + tsfco(i) = tsfc(i) + tisfc(i) = tsfc(i) cmm(i) = cmm_lnd(i) chh(i) = chh_lnd(i) gflx(i) = gflx_lnd(i) @@ -488,11 +521,8 @@ subroutine GFS_surface_composites_post_run ( evap(i) = evap_lnd(i) hflx(i) = hflx_lnd(i) qss(i) = qss_lnd(i) - tsfc(i) = tsfc_lnd(i) hice(i) = zero cice(i) = zero - tisfc(i) = tsfc(i) - tsfco(i) = tsfc(i) elseif (islmsk(i) == 0) then zorl(i) = zorl_wat(i) cd(i) = cd_wat(i) @@ -506,7 +536,9 @@ subroutine GFS_surface_composites_post_run ( fh2(i) = fh2_wat(i) !tsurf(i) = tsurf_wat(i) tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) + tsfc(i) = tsfco(i) tsfcl(i) = tsfc(i) + tisfc(i) = tsfc(i) cmm(i) = cmm_wat(i) chh(i) = chh_wat(i) gflx(i) = gflx_wat(i) @@ -517,10 +549,8 @@ subroutine GFS_surface_composites_post_run ( evap(i) = evap_wat(i) hflx(i) = hflx_wat(i) qss(i) = qss_wat(i) - tsfc(i) = tsfc_wat(i) hice(i) = zero cice(i) = zero - tisfc(i) = tsfc(i) else ! islmsk(i) == 2 zorl(i) = zorl_ice(i) cd(i) = cd_ice(i) @@ -544,12 +574,13 @@ subroutine GFS_surface_composites_post_run ( evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) + tisfc(i) = tice(i) if (.not. flag_cice(i)) then - tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) +! tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) zorl(i) = cice(i) * zorl_ice(i) + (one - cice(i)) * zorl_wat(i) - tsfc(i) = tsfc_ice(i) + tsfc(i) = tsfc_ice(i) ! over lake (and ocean when uncoupled) elseif (wet(i)) then - if (cice(i) > min_seaice) then ! this was already done for lake ice in sfc_sice + if (cice(i) >= min_seaice) then ! this was already done for lake ice in sfc_sice txi = cice(i) txo = one - txi evap(i) = txi * evap_ice(i) + txo * evap_wat(i) @@ -576,7 +607,7 @@ subroutine GFS_surface_composites_post_run ( endif tsfcl(i) = tsfc(i) do k=1,kice ! store tiice in stc to reduce output in the nonfrac grid case - stc(i,k)=tiice(i,k) + stc(i,k) = tiice(i,k) end do endif diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 71765b9a2..21b308357 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -140,23 +140,23 @@ type = logical intent = inout optional = F -[cice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout optional = F -[cimin] - standard_name = minimum_sea_ice_concentration - long_name = minimum sea ice concentration +[cice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water units = frac - dimensions = () + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout optional = F [zorl] standard_name = surface_roughness_length @@ -506,7 +506,24 @@ units = flag dimensions = (horizontal_loop_extent) type = integer - intent = in + intent = inout + optional = F +[islmsk_cice] + standard_name = sea_land_ice_mask_cice + long_name = sea/land/ice mask cice (=0/1/2) + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = inout + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout optional = F [semis_rad] standard_name = surface_longwave_emissivity From 63742d4837f566b786b9c6015fad9da5668e8313 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 30 Nov 2020 15:09:25 -0700 Subject: [PATCH 131/274] Remove lsm_ruc_sfc_sice_interstitial from source code and documentation --- physics/docs/pdftxt/GSD_adv_suite.txt | 2 - physics/lsm_ruc_sfc_sice_interstitial.meta | 204 --------------------- 2 files changed, 206 deletions(-) delete mode 100644 physics/lsm_ruc_sfc_sice_interstitial.meta diff --git a/physics/docs/pdftxt/GSD_adv_suite.txt b/physics/docs/pdftxt/GSD_adv_suite.txt index 39c5ebd20..4243d83e8 100644 --- a/physics/docs/pdftxt/GSD_adv_suite.txt +++ b/physics/docs/pdftxt/GSD_adv_suite.txt @@ -77,9 +77,7 @@ The GSD_v1 physics suite uses the parameterizations in the following order: sfc_nst sfc_nst_post lsm_ruc - lsm_ruc_sfc_sice_pre sfc_sice - lsm_ruc_sfc_sice_post GFS_surface_loop_control_part2 diff --git a/physics/lsm_ruc_sfc_sice_interstitial.meta b/physics/lsm_ruc_sfc_sice_interstitial.meta deleted file mode 100644 index d7a5736a5..000000000 --- a/physics/lsm_ruc_sfc_sice_interstitial.meta +++ /dev/null @@ -1,204 +0,0 @@ -[ccpp-table-properties] - name = lsm_ruc_sfc_sice_pre - type = scheme - dependencies = machine.F - -######################################################################## -[ccpp-arg-table] - name = lsm_ruc_sfc_sice_pre_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[lsoil_ruc] - standard_name = soil_vertical_dimension_for_land_surface_model - long_name = number of soil layers internal to land surface model - units = count - dimensions = () - type = integer - intent = in - optional = F -[lsoil] - standard_name = soil_vertical_dimension - long_name = soil vertical layer dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[kice] - standard_name = ice_vertical_dimension - long_name = vertical loop extent for ice levels, start at 1 - units = count - dimensions = () - type = integer - intent = in - optional = F -[land] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in - optional = F -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = inout - optional = F -[stc] - standard_name = soil_temperature - long_name = soil temperature - units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[tslb] - standard_name = soil_temperature_for_land_surface_model - long_name = soil temperature for land surface model - units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - intent = in - optional = F -[tiice] - standard_name = internal_ice_temperature - long_name = sea ice internal temperature - units = K - dimensions = (horizontal_loop_extent,ice_vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F - -######################################################################## -[ccpp-table-properties] - name = lsm_ruc_sfc_sice_post - type = scheme - dependencies = machine.F - -######################################################################## -[ccpp-arg-table] - name = lsm_ruc_sfc_sice_post_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[lsoil_ruc] - standard_name = soil_vertical_dimension_for_land_surface_model - long_name = number of soil layers internal to land surface model - units = count - dimensions = () - type = integer - intent = in - optional = F -[lsoil] - standard_name = soil_vertical_dimension - long_name = soil vertical layer dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[kice] - standard_name = ice_vertical_dimension - long_name = vertical loop extent for ice levels, start at 1 - units = count - dimensions = () - type = integer - intent = in - optional = F -[land] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in - optional = F -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = inout - optional = F -[stc] - standard_name = soil_temperature - long_name = soil temperature - units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[tslb] - standard_name = soil_temperature_for_land_surface_model - long_name = soil temperature for land surface model - units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) - type = real - kind = kind_phys - intent = inout - optional = F -[tiice] - standard_name = internal_ice_temperature - long_name = sea ice internal temperature - units = K - dimensions = (horizontal_loop_extent,ice_vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F From 11fc839279223cee7813c7ea6f478f809e67724b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 30 Nov 2020 17:09:28 -0700 Subject: [PATCH 132/274] Remove sfc_sice from physics/docs/pdftxt/GSD_adv_suite.txt --- physics/docs/pdftxt/GSD_adv_suite.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/physics/docs/pdftxt/GSD_adv_suite.txt b/physics/docs/pdftxt/GSD_adv_suite.txt index 4243d83e8..1f2dbe7fa 100644 --- a/physics/docs/pdftxt/GSD_adv_suite.txt +++ b/physics/docs/pdftxt/GSD_adv_suite.txt @@ -77,7 +77,6 @@ The GSD_v1 physics suite uses the parameterizations in the following order: sfc_nst sfc_nst_post lsm_ruc - sfc_sice GFS_surface_loop_control_part2 From 610c6e30512c7a5ecdbf34c6657f60c619491538 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 2 Dec 2020 10:53:54 -0700 Subject: [PATCH 133/274] Some cleanup --- physics/GFS_rrtmgp_pre.F90 | 6 ++---- physics/rrtmgp_lw_gas_optics.F90 | 4 ++-- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 35e1eb67c..25f65567a 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -269,8 +269,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, * (tem2db(iCol,iLay) - tem2da(iCol,iLay)) & / (tem2da(iCol,iLay-1) - tem2da(iCol,iLay)) enddo - enddo - !t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + enddo t_lev(1:NCOL,iSFC+1) = tsfc(1:NCOL) else tem2da(1:nCol,2:iTOA) = log(p_lay(1:nCol,2:iTOA)) @@ -288,8 +287,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, * (tem2db(iCol,iLay+1) - tem2da(iCol,iLay)) & / (tem2da(iCol,iLay+1) - tem2da(iCol,iLay)) enddo - enddo - !t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + enddo t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 813699ae0..f8a01b982 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -331,8 +331,8 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ tsfg, & ! IN - Skin-temperature (K) gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties - sources))!, & ! OUT - RRTMGP DDT: source functions - !tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) + sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) end subroutine rrtmgp_lw_gas_optics_run From 8a8056efa8b7360d74386951803430ebd6e20236 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 2 Dec 2020 18:14:13 +0000 Subject: [PATCH 134/274] add mp perts to GFS_stochastics --- physics/GFS_stochastics.F90 | 57 ++++++++++++++++++++++- physics/GFS_stochastics.meta | 90 ++++++++++++++++++++++++++++++++++++ 2 files changed, 145 insertions(+), 2 deletions(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 9b4533cf9..863d7c6cc 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -30,8 +30,10 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, do_skeb, do_ca,ca_global,ca1,si,vfact_ca, & zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,& sppt_wts_inv, skebu_wts_inv, skebv_wts_inv, & - shum_wts_inv, diss_est, & - ugrs, vgrs, tgrs, qgrs, gu0, gv0, gt0, gq0, dtdtr, & + shum_wts_inv, diss_est, ugrs, vgrs, tgrs, & + qgrs, qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, & + gu0, gv0, gt0, gq0, & + qg0_cw, qg0_rw, qg0_sw, qg0_iw, qg0_gl, dtdtr, & rain, rainc, tprcp, totprcp, cnvprcp, & totprcpb, cnvprcpb, cplflx, & rain_cpl, snow_cpl, drain_cpl, dsnow_cpl, & @@ -68,10 +70,20 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, real(kind_phys), dimension(1:im,1:km), intent(in) :: vgrs real(kind_phys), dimension(1:im,1:km), intent(in) :: tgrs real(kind_phys), dimension(1:im,1:km), intent(in) :: qgrs + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_cw + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_rw + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_sw + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_iw + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_gl real(kind_phys), dimension(1:im,1:km), intent(inout) :: gu0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gv0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gt0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gq0 + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_cw + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_rw + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_sw + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_iw + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_gl ! dtdtr only allocated if do_sppt == .true. real(kind_phys), dimension(:,:), intent(in) :: dtdtr real(kind_phys), dimension(1:im), intent(in) :: rain @@ -142,6 +154,47 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, gq0(i,k) = qnew gt0(i,k) = tgrs(i,k) + tpert + dtdtr(i,k) endif + if (present(gq0_cw) .AND. present(qgrs_cw)) then + qpert = gq0_cw(i,k) - qgrs_cw(i,k) * sppt_wts(i,k) + qnew = qgrs_cw(i,k,l+1)+qpert + gq0_cw(i,k) = qnew + if (qnew < 0.0) then + gq0_cw(i,k) = 0.0 + endif + endif + if (present(gq0_rw) .AND. present(qgrs_rw)) then + qpert = gq0_rw(i,k) - qgrs_rw(i,k) * sppt_wts(i,k) + qnew = qgrs_rw(i,k,l+1)+qpert + gq0_rw(i,k) = qnew + if (qnew < 0.0) then + gq0_rw(i,k) = 0.0 + endif + endif + if (present(gq0_sw) .AND. present(qgrs_sw)) then + qpert = gq0_sw(i,k) - qgrs_sw(i,k) * sppt_wts(i,k) + qnew = qgrs_sw(i,k,l+1)+qpert + gq0_sw(i,k) = qnew + if (qnew < 0.0) then + gq0_sw(i,k) = 0.0 + endif + endif + if (present(gq0_iw) .AND. present(qgrs_iw)) then + qpert = gq0_iw(i,k) - qgrs_iw(i,k) * sppt_wts(i,k) + qnew = qgrs_iw(i,k,l+1)+qpert + gq0_iw(i,k) = qnew + if (qnew < 0.0) then + gq0_iw(i,k) = 0.0 + endif + endif + enddo + if (present(gq0_gl) .AND. present(qgrs_gl)) then + qpert = gq0_gl(i,k) - qgrs_gl(i,k) * sppt_wts(i,k) + qnew = qgrs_gl(i,k,l+1)+qpert + gq0_gl(i,k) = qnew + if (qnew < 0.0) then + gq0_gl(i,k) = 0.0 + endif + endif enddo enddo diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index 43c7b2d42..e0c2da2d1 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -232,6 +232,51 @@ kind = kind_phys intent = in optional = F +[qgrs_cw] + standard_name = cloud_condensed_water_mixing_ratio + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[ggrs_rw] + standard_name = rain_water_mixing_ratio + long_name = moist mixing ratio of rain + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[ggrs_iw] + standard_name = ice_water_mixing_ratio + long_name = moist mixing ratio of cloud ice + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[ggrs_sw] + standard_name = snow_water_mixing_ratio + long_name = moist mixing ratio of snow + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[qgrs_gl] + standard_name = graupel_mixing_ratio + long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T [gu0] standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics @@ -268,6 +313,51 @@ kind = kind_phys intent = inout optional = F +[gq0_cw] + standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics + long_name = cloud condensed water mixing ratio updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_rw] + standard_name = rain_water_mixing_ratio_updated_by_physics + long_name = moist mixing ratio of rain updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_iw] + standard_name = ice_water_mixing_ratio_updated_by_physics + long_name = moist mixing ratio of cloud ice updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_sw] + standard_name = snow_water_mixing_ratio_updated_by_physics + long_name = moist mixing ratio of snow updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_gl] + standard_name = graupel_mixing_ratio_updated_by_physics + long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T [dtdtr] standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step From 3226ffb715ea226d0a1f396b38318796193913dc Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 2 Dec 2020 18:51:43 +0000 Subject: [PATCH 135/274] add CN perts to GFS_stochastics --- physics/GFS_stochastics.F90 | 58 +++++++++++++++++++-- physics/GFS_stochastics.meta | 98 ++++++++++++++++++++++++++++++++++-- 2 files changed, 149 insertions(+), 7 deletions(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 863d7c6cc..949b4f9ec 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -32,8 +32,10 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, sppt_wts_inv, skebu_wts_inv, skebv_wts_inv, & shum_wts_inv, diss_est, ugrs, vgrs, tgrs, & qgrs, qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, & - gu0, gv0, gt0, gq0, & - qg0_cw, qg0_rw, qg0_sw, qg0_iw, qg0_gl, dtdtr, & + qgrs_ni, qgrs_nr, qgrs_nc, qgrs_nwfa, qgrs_nifa, & + gu0, gv0, gt0, gq0, dtdtr, & + gq0_cw, gq0_rw, gq0_sw, gq0_iw, gq0_gl, & + gq0_ni, gq0_nr, gq0_nc, gq0_nwfa, gq0_nifa, & rain, rainc, tprcp, totprcp, cnvprcp, & totprcpb, cnvprcpb, cplflx, & rain_cpl, snow_cpl, drain_cpl, dsnow_cpl, & @@ -75,6 +77,11 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_sw real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_iw real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_gl + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_ni + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nr + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nc + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nwfa + real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nifa real(kind_phys), dimension(1:im,1:km), intent(inout) :: gu0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gv0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gt0 @@ -84,6 +91,11 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_sw real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_iw real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_gl + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_ni + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nr + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nc + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nwfa + real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nifa ! dtdtr only allocated if do_sppt == .true. real(kind_phys), dimension(:,:), intent(in) :: dtdtr real(kind_phys), dimension(1:im), intent(in) :: rain @@ -186,7 +198,6 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, gq0_iw(i,k) = 0.0 endif endif - enddo if (present(gq0_gl) .AND. present(qgrs_gl)) then qpert = gq0_gl(i,k) - qgrs_gl(i,k) * sppt_wts(i,k) qnew = qgrs_gl(i,k,l+1)+qpert @@ -195,6 +206,47 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, gq0_gl(i,k) = 0.0 endif endif + if (present(gq0_ni) .AND. present(qgrs_ni)) then + qpert = gq0_ni(i,k) - qgrs_ni(i,k) * sppt_wts(i,k) + qnew = qgrs_ni(i,k,l+1)+qpert + gq0_ni(i,k) = qnew + if (qnew < 0.0) then + gq0_ni(i,k) = 0.0 + endif + endif + if (present(gq0_nr) .AND. present(qgrs_nr)) then + qpert = gq0_nr(i,k) - qgrs_nr(i,k) * sppt_wts(i,k) + qnew = qgrs_nr(i,k,l+1)+qpert + gq0_nr(i,k) = qnew + if (qnew < 0.0) then + gq0_nr(i,k) = 0.0 + endif + endif + if (present(gq0_nnc .AND. present(qgrs_nc)) then + qpert = gq0_nc(i,k) - qgrs_nc(i,k) * sppt_wts(i,k) + qnew = qgrs_nc(i,k,l+1)+qpert + gq0_nc(i,k) = qnew + if (qnew < 0.0) then + gq0_nc(i,k) = 0.0 + endif + endif + if (present(gq0_nwfa) .AND. present(qgrs_nwfa)) then + qpert = gq0_nwfa(i,k) - qgrs_nwfa(i,k) * sppt_wts(i,k) + qnew = qgrs_nwfa(i,k,l+1)+qpert + gq0_nwfa(i,k) = qnew + if (qnew < 0.0) then + gq0_nwfa(i,k) = 0.0 + endif + endif + enddo + if (present(gq0_nifa) .AND. present(qgrs_nifa)) then + qpert = gq0_nifa(i,k) - qgrs_nifa(i,k) * sppt_wts(i,k) + qnew = qgrs_nifa(i,k,l+1)+qpert + gq0_nifa(i,k) = qnew + if (qnew < 0.0) then + gq0_nifa(i,k) = 0.0 + endif + endif enddo enddo diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index e0c2da2d1..08f9f004e 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -248,7 +248,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = T [ggrs_iw] standard_name = ice_water_mixing_ratio @@ -257,7 +257,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = T [ggrs_sw] standard_name = snow_water_mixing_ratio @@ -266,7 +266,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = inout + intent = in optional = T [qgrs_gl] standard_name = graupel_mixing_ratio @@ -275,7 +275,52 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = inout + intent = in + optional = T +[qgrs_ni] + standard_name = ice_number_concentration + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[gqrs_nr] + standard_name = rain_number_concentration + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[gqrs_nc] + standard_name = cloud_droplet_number_concentration + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[qgrs_nwfa] + standard_name = water_friendly_aerosol_number_concentration + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[qgrs_nifa] + standard_name = ice_friendly_aerosol_number_concentration + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in optional = T [gu0] standard_name = x_wind_updated_by_physics @@ -358,6 +403,51 @@ kind = kind_phys intent = inout optional = T +[gq0_ni] + standard_name = ice_number_concentration_updated_by_physics + long_name = ice number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_nr] + standard_name = rain_number_concentration_updated_by_physics + long_name = rain number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_nc] + standard_name = cloud_droplet_number_concentration_updated_by_physics + long_name = cloud droplet number concentration + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_nwfa] + standard_name = water_friendly_aerosol_number_concentration_updated_by_physics + long_name = number concentration of water-friendly aerosols + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[gq0_nifa] + standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics + long_name = number concentration of ice-friendly aerosols + units = kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T [dtdtr] standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step From c346d074426f9eb12762df7c0b5a8164554eb57a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 09:22:11 -0700 Subject: [PATCH 136/274] Fixed bug in argument intent for GP SW routines. --- physics/GFS_rrtmgp_sw_post.F90 | 14 +++++++------- physics/GFS_rrtmgp_sw_post.meta | 32 ++++++++++++++++---------------- physics/GFS_rrtmgp_sw_pre.F90 | 20 +++++++++----------- physics/GFS_rrtmgp_sw_pre.meta | 21 +++++++++++++++------ physics/rrtmgp_lw_pre.F90 | 9 +++++---- physics/rrtmgp_lw_pre.meta | 15 ++++++++++++--- 6 files changed, 64 insertions(+), 47 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 3a9871a5c..f89c2e7e7 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -77,7 +77,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky cldtausw ! approx .55mu band layer cloud optical depth ! Inputs (optional) - type(cmpfsw_type), dimension(nCol), intent(in), optional :: & + type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux at (W/m2) ! uvbf0 - clear sky downward uv-b flux at (W/m2) @@ -89,7 +89,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(out) :: & + real(kind_phys), dimension(nCol), intent(inout) :: & nirbmdi, & ! sfc nir beam sw downward flux (W/m2) nirdfdi, & ! sfc nir diff sw downward flux (W/m2) visbmdi, & ! sfc uv+vis beam sw downward flux (W/m2) @@ -100,11 +100,11 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky visdfui, & ! sfc uv+vis diff sw upward flux (W/m2) sfcnsw, & ! total sky sfc netsw flx into ground sfcdsw ! - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrsw ! SW all-sky heating rate - type(sfcfsw_type), dimension(nCol), intent(out) :: & + type(sfcfsw_type), dimension(nCol), intent(inout) :: & sfcfsw ! sw radiation fluxes at sfc - type(topfsw_type), dimension(nCol), intent(out) :: & + type(topfsw_type), dimension(nCol), intent(inout) :: & topfsw ! sw_fluxes_top_atmosphere character(len=*), intent(out) :: & errmsg @@ -112,13 +112,13 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky errflg ! Outputs (optional) - type(profsw_type), dimension(nCol, nLev), intent(out), optional :: & + type(profsw_type), dimension(nCol, nLev), intent(inout), optional :: & flxprf_sw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) ! dnfxc - total sky dnward flux (W/m2) ! upfx0 - clear sky upward flux (W/m2) ! dnfx0 - clear sky dnward flux (W/m2) - real(kind_phys),dimension(nCol, nLev),intent(out),optional :: & + real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrswc ! Clear-sky heating rate (K/s) ! Local variables diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 77f7b15a6..2dc412118 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -266,7 +266,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirdfdi] standard_name = surface_downwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step @@ -275,7 +275,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visbmdi] standard_name = surface_downwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -284,7 +284,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visdfdi] standard_name = surface_downwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -293,7 +293,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirbmui] standard_name = surface_upwelling_direct_near_infrared_shortwave_flux_on_radiation_time_step @@ -302,7 +302,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [nirdfui] standard_name = surface_upwelling_diffuse_near_infrared_shortwave_flux_on_radiation_time_step @@ -311,7 +311,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visbmui] standard_name = surface_upwelling_direct_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -320,7 +320,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [visdfui] standard_name = surface_upwelling_diffuse_ultraviolet_and_visible_shortwave_flux_on_radiation_time_step @@ -329,7 +329,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcnsw] standard_name = surface_net_downwelling_shortwave_flux_on_radiation_time_step @@ -338,7 +338,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcdsw] standard_name = surface_downwelling_shortwave_flux_on_radiation_time_step @@ -347,7 +347,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [htrsw] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step @@ -356,7 +356,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfcfsw] standard_name = sw_fluxes_sfc @@ -364,7 +364,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = sfcfsw_type - intent = out + intent = inout optional = F [topfsw] standard_name = sw_fluxes_top_atmosphere @@ -372,7 +372,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = topfsw_type - intent = out + intent = inout optional = F [htrswc] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step @@ -381,7 +381,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = T [flxprf_sw] standard_name = RRTMGP_sw_fluxes @@ -389,7 +389,7 @@ units = W m-2 dimensions = (horizontal_loop_extent,adjusted_vertical_level_dimension_plus_one) type = profsw_type - intent = out + intent = inout optional = T [scmpsw] standard_name = components_of_surface_downward_shortwave_fluxes @@ -397,7 +397,7 @@ units = W m-2 dimensions = (horizontal_loop_extent) type = cmpfsw_type - intent = in + intent = inout optional = T [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 179c622f5..1268ed26f 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -27,12 +27,11 @@ end subroutine GFS_rrtmgp_sw_pre_init !! \htmlinclude GFS_rrtmgp_sw_pre.html !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & - lndp_prt_list, doSWrad, solhr, & - lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay, & - relhum, p_lev, sw_gas_props, & - nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) + lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & + tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, & + sfc_wts, p_lay, tv_lay, relhum, p_lev, sw_gas_props, nday, idxday, coszen, coszdg, & + sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, & + errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -58,7 +57,8 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ sncovr, & ! Surface snow area fraction (frac) snoalb, & ! Maximum snow albedo (frac) zorl, & ! Surface roughness length (cm) - tsfc, & ! Surface skin temperature (K) + tsfg, & ! Surface ground temperature for radiation (K) + tsfa, & ! Lowest model layer air temperature for radiation (K) hprime, & ! Standard deviation of subgrid orography (m) alvsf, & ! Mean vis albedo with strong cosz dependency (frac) alnsf, & ! Mean nir albedo with strong cosz dependency (frac) @@ -84,7 +84,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ nday ! Number of daylit points integer, dimension(ncol), intent(out) :: & idxday ! Indices for daylit points - real(kind_phys), dimension(ncol), intent(out) :: & + real(kind_phys), dimension(ncol), intent(inout) :: & coszen, & ! Cosine of SZA coszdg, & ! Cosine of SZA, daytime sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo @@ -132,7 +132,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ ! #################################################################################### alb1d(:) = 0. lndp_alb = -999. - call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfc, tsfc, hprime, alvsf, & + call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, hprime, alvsf, & alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, lndp_alb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. @@ -148,8 +148,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ else nday = 0 idxday = 0 - coszen(1:nCol) = 0. - coszdg(1:nCol) = 0. sfc_alb_nir_dir(:,1:nCol) = 0. sfc_alb_nir_dif(:,1:nCol) = 0. sfc_alb_uvvis_dir(:,1:nCol) = 0. diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index b24ab5710..202f1667a 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -154,15 +154,24 @@ kind = kind_phys intent = in optional = F -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [hprime] standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography @@ -356,7 +365,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [coszdg] standard_name = daytime_mean_cosz_over_rad_call_period @@ -365,7 +374,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [sfc_alb_dif] standard_name = surface_diffused_shortwave_albedo @@ -374,7 +383,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index caee7308e..358e49bee 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -24,8 +24,8 @@ end subroutine rrtmgp_lw_pre_init !> \section arg_table_rrtmgp_lw_pre_run !! \htmlinclude rrtmgp_lw_pre_run.html !! - subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, tsfc, & - hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) + subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & + tsfg, tsfa, hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -39,7 +39,8 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc zorl, & ! Surface roughness length (cm) snowd, & ! water equivalent snow depth (mm) sncovr, & ! Surface snow are fraction (1) - tsfc, & ! Surface skin temperature (K) + tsfg, & ! Surface ground temperature for radiation (K) + tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: spectral information for LW calculation @@ -66,7 +67,7 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfc, tsfc, hprime, nCol, semis) + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, nCol, semis) ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 8084ecf90..1f329dd8d 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -77,15 +77,24 @@ kind = kind_phys intent = in optional = F -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [hprime] standard_name = standard_deviation_of_subgrid_orography long_name = standard deviation of subgrid orography From 95e8fd9f218374d869f3481a7964431155c0f008 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 11:22:11 -0700 Subject: [PATCH 137/274] Moved use of LW jacobian for adjustment into dcyc2.f --- physics/GFS_suite_interstitial.F90 | 31 ++----------------- physics/GFS_suite_interstitial.meta | 46 +---------------------------- physics/dcyc2.f | 43 +++++++++++++++++---------- physics/dcyc2.meta | 26 ++++++++++++++++ physics/rrtmgp_lw_rte.F90 | 10 +++---- physics/rrtmgp_lw_rte.meta | 4 +-- 6 files changed, 64 insertions(+), 96 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 38ea1800a..c5d203457 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,7 +163,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_GP_jacobian, skt, sktp1r, fluxlwUP, fluxlwUP_jac, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) implicit none @@ -184,17 +184,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw - - ! RRTMGP - logical, intent(in ) :: & - use_GP_jacobian ! Use RRTMGP LW Jacobian of upwelling to adjust the surface flux? - real(kind=kind_phys), intent(in ), dimension(im) :: & - skt ! Skin temperature - real(kind=kind_phys), intent(inout), dimension(im) :: & - sktp1r ! Skin temperature at previous timestep - real(kind=kind_phys), intent(in ), dimension(im,levs+1), optional :: & - fluxlwUP, & ! Upwelling LW flux (W/m2) - fluxlwUP_jac ! Jacobian of upwelling LW flux (W/m2/K) ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -211,7 +200,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer :: i, k real(kind=kind_phys) :: tem1, tem2, tem, hocp logical, dimension(im) :: invrsn - real(kind=kind_phys), dimension(im) :: tx1, tx2, dT + real(kind=kind_phys), dimension(im) :: tx1, tx2 real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys real(kind=kind_phys), parameter :: qmin = 1.0e-10_kind_phys, epsln=1.0e-10_kind_phys @@ -241,20 +230,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed ! --- ... and provided as inputs in this routine. - - if (use_GP_jacobian) then - ! Compute adjustment to the surface flux using Jacobian. - if(linit_mod) then - dT(:) = (sktp1r(:) - skt(:)) - adjsfculw(:) = fluxlwUP(:,1) + fluxlwUP_jac(:,1) * dT(:) - else - adjsfculw(:) = fluxlwUP(:,1) - linit_mod = .true. - endif - - ! Store surface temperature for next iteration - sktp1r(:) = skt(:) - else + if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -292,7 +268,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif - endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index b27884f9a..dba0567ce 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -785,51 +785,7 @@ type = real kind = kind_phys intent = in - optional = F -[use_GP_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical - intent = in - optional = F -[skt] - standard_name = air_temperature_at_lowest_model_layer - long_name = air temperature at lowest model layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sktp1r] - standard_name = surface_skin_temperature_at_previous_time_step - long_name = surface skin temperature at previous time step - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fluxlwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = T + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 22eece516..3e4f3b615 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -179,6 +179,7 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, & + & use_LW_jacobian, fluxlwUP, fluxlwUP_jac, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: & dtdt,dtdtc, & @@ -210,6 +211,7 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet + logical, intent(in) :: use_LW_jacobian real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr @@ -227,6 +229,9 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc + real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & + & fluxlwUP, & + & fluxlwUP_jac ! --- input/output: real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & @@ -303,21 +308,29 @@ subroutine dcyc2t3_run & !! - compute \a sfc upward LW flux from current \a sfc temperature. ! note: sfc emiss effect is not appied here, and will be dealt in other place - if (dry(i)) then - tem2 = tsfc_lnd(i) * tsfc_lnd(i) - adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) - endif - if (icy(i)) then - tem2 = tsfc_ice(i) * tsfc_ice(i) - adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ice(i)) * adjsfcdlw(i) - endif - if (wet(i)) then - tem2 = tsfc_wat(i) * tsfc_wat(i) - adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_wat(i)) * adjsfcdlw(i) - endif + if (use_LW_Jacobian) then + ! Change in surface air-temperature since last radiation call. + tem1 = tsflw(i) - tf(i) + adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + else + if (dry(i)) then + tem2 = tsfc_lnd(i) * tsfc_lnd(i) + adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) + endif + if (icy(i)) then + tem2 = tsfc_ice(i) * tsfc_ice(i) + adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_ice(i)) * adjsfcdlw(i) + endif + if (wet(i)) then + tem2 = tsfc_wat(i) * tsfc_wat(i) + adjsfculw_wat(i) = sfcemis_wat(i) * con_sbc * tem2 * tem2 + & + (one - sfcemis_wat(i)) * adjsfcdlw(i) + endif + endif ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) ! &,' sfcemis=',sfcemis(i,:),' adjsfculw=',adjsfculw(i,:) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 6fbc7f8b6..c36f63bd6 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -506,6 +506,32 @@ kind = kind_phys intent = out optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fluxlwUP] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward + long_name = RRTMGP Jacobian upward longwave flux profile + units = W m-2 K-1 + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index cf85aa7f2..f2dfb0694 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -63,15 +63,13 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) - fluxlwDOWN_clrsky ! All-sky flux (W/m2) + fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) + fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) + fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error flag - ! Outputs (optional) - real(kind_phys), dimension(ncol,nLev+1), intent(out), optional :: & - fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) - fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) + errflg ! CCPP error flag ! Local variables type(ty_fluxes_byband) :: & diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 443792edf..1d5300f5c 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -166,7 +166,7 @@ type = real kind = kind_phys intent = out - optional = T + optional = F [fluxlwDOWN_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward long_name = RRTMGP Jacobian downward of longwave flux profile @@ -175,7 +175,7 @@ type = real kind = kind_phys intent = out - optional = T + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From d0174a32df95e5ad15037c4feead7c93bd6d34a4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 14:24:39 -0700 Subject: [PATCH 138/274] Use tsfc from lsm for dt in GP lw sfc flux adjustment. --- physics/dcyc2.f | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 3e4f3b615..ada372aa6 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -309,11 +309,19 @@ subroutine dcyc2t3_run & ! note: sfc emiss effect is not appied here, and will be dealt in other place if (use_LW_Jacobian) then - ! Change in surface air-temperature since last radiation call. - tem1 = tsflw(i) - tf(i) - adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 - adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 - adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * tem1 + ! F_adj = F_o + (dF/dT) * dT + if (dry(i)) then + adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tsfc_lnd(i)) + endif + if (icy(i)) then + adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tsfc_ice(i)) + endif + if (wet(i)) then + adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tsfc_wat(i)) + endif else if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) From 17ea62b6d8aaa8af8c1df8d216673bdcc94fe93f Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 15:16:45 -0700 Subject: [PATCH 139/274] Compute GP LW adjustement in dcyc2, pass through GFS_suite_interstitial --- physics/GFS_suite_interstitial.F90 | 7 +++++-- physics/GFS_suite_interstitial.meta | 8 ++++++++ physics/dcyc2.f | 20 +++++--------------- physics/dcyc2.meta | 9 +++++++++ 4 files changed, 27 insertions(+), 17 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index c5d203457..89508ea17 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,7 +163,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) implicit none @@ -184,6 +184,9 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + + ! RRTMGP inputs + logical, intent(in ) :: use_LW_jacobian ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -230,7 +233,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed ! --- ... and provided as inputs in this routine. - + if (.not. use_LW_jacobian) if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index dba0567ce..c3bdbc611 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -637,6 +637,14 @@ kind = kind_phys intent = in optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [dlwsfc] standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep long_name = cumulative surface downwelling LW flux multiplied by timestep diff --git a/physics/dcyc2.f b/physics/dcyc2.f index ada372aa6..6061de509 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -184,7 +184,7 @@ subroutine dcyc2t3_run & ! --- input/output: & dtdt,dtdtc, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -244,7 +244,7 @@ subroutine dcyc2t3_run & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat + & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat, adjsfculw character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -309,19 +309,9 @@ subroutine dcyc2t3_run & ! note: sfc emiss effect is not appied here, and will be dealt in other place if (use_LW_Jacobian) then - ! F_adj = F_o + (dF/dT) * dT - if (dry(i)) then - adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tsfc_lnd(i)) - endif - if (icy(i)) then - adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tsfc_ice(i)) - endif - if (wet(i)) then - adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tsfc_wat(i)) - endif + ! F_adj = F_o + (dF/dT) * dT + adjsfculw(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsflw(i) - tf(i)) else if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index c36f63bd6..fd748edfd 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -389,6 +389,15 @@ kind = kind_phys intent = out optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) From 95d271e9937b6407135f343c6a4b019fcc4973b0 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 4 Dec 2020 15:18:57 -0700 Subject: [PATCH 140/274] Omission from previous commit --- physics/GFS_suite_interstitial.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 89508ea17..1086e444b 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -233,7 +233,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed ! --- ... and provided as inputs in this routine. - if (.not. use_LW_jacobian) + if (.not. use_LW_jacobian) then if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -271,6 +271,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif + endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf From 9354fd2fd4290bbd326a1e54bb12abd1f7d6ea22 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 4 Dec 2020 16:46:16 -0700 Subject: [PATCH 141/274] add output of the new kinematic surface fluxes modified by GFS_surface_generic to the gmtb_scm_spec_sfc_flux scheme (fixes specified surface flux cases for SCM) --- physics/gmtb_scm_sfc_flux_spec.F90 | 24 ++++++++++++--- physics/gmtb_scm_sfc_flux_spec.meta | 48 +++++++++++++++++++++++++++++ 2 files changed, 67 insertions(+), 5 deletions(-) diff --git a/physics/gmtb_scm_sfc_flux_spec.F90 b/physics/gmtb_scm_sfc_flux_spec.F90 index d77e42000..22730f9f2 100644 --- a/physics/gmtb_scm_sfc_flux_spec.F90 +++ b/physics/gmtb_scm_sfc_flux_spec.F90 @@ -15,7 +15,18 @@ module gmtb_scm_sfc_flux_spec CONTAINS !******************************************************************************************* - subroutine gmtb_scm_sfc_flux_spec_init() + subroutine gmtb_scm_sfc_flux_spec_init(lheatstrg, errmsg, errflg) + + logical, intent(in) :: lheatstrg + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + if (lheatstrg) then + errmsg = 'Using specified surface fluxes is not compatible with canopy heat storage (lheatstrg) being true. Stopping.' + errflg = 1 + return + end if end subroutine gmtb_scm_sfc_flux_spec_init subroutine gmtb_scm_sfc_flux_spec_finalize() @@ -38,16 +49,17 @@ end subroutine gmtb_scm_sfc_flux_spec_finalize !! -# Calculate the surface drag coefficient for heat and moisture. !! -# Calculate the u and v wind at 10m. subroutine gmtb_scm_sfc_flux_spec_run (u1, v1, z1, t1, q1, p1, roughness_length, spec_sh_flux, spec_lh_flux, & - exner_inverse, T_surf, cp, grav, hvap, rd, fvirt, vonKarman, sh_flux, lh_flux, u_star, sfc_stress, cm, ch, & + exner_inverse, T_surf, cp, grav, hvap, rd, fvirt, vonKarman, sh_flux, lh_flux, sh_flux_chs, lh_flux_chs, u_star, sfc_stress, cm, ch, & fm, fh, rb, u10m, v10m, wind1, qss, t2m, q2m, errmsg, errflg) use machine, only: kind_phys - + real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman real(kind=kind_phys), intent(out) :: sh_flux(:), lh_flux(:), u_star(:), sfc_stress(:), & - cm(:), ch(:), fm(:), fh(:), rb(:), u10m(:), v10m(:), wind1(:), qss(:), t2m(:), q2m(:) + cm(:), ch(:), fm(:), fh(:), rb(:), u10m(:), v10m(:), wind1(:), qss(:), t2m(:), q2m(:), & + sh_flux_chs(:), lh_flux_chs(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -60,12 +72,14 @@ subroutine gmtb_scm_sfc_flux_spec_run (u1, v1, z1, t1, q1, p1, roughness_length, ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + ! !--- set control properties (including namelist read) !calculate u_star from wind profiles (need roughness length, and wind and height at lowest model level) do i=1, size(z1) sh_flux(i) = spec_sh_flux(i) lh_flux(i) = spec_lh_flux(i) + sh_flux_chs(i) = sh_flux(i) + lh_flux_chs(i) = lh_flux(i) roughness_length_m = 0.01*roughness_length(i) diff --git a/physics/gmtb_scm_sfc_flux_spec.meta b/physics/gmtb_scm_sfc_flux_spec.meta index 71ddff22a..1e004b7f9 100644 --- a/physics/gmtb_scm_sfc_flux_spec.meta +++ b/physics/gmtb_scm_sfc_flux_spec.meta @@ -4,6 +4,36 @@ dependencies = machine.F ######################################################################## +[ccpp-arg-table] + name = gmtb_scm_sfc_flux_spec_init + type = scheme +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +################################# [ccpp-arg-table] name = gmtb_scm_sfc_flux_spec_run type = scheme @@ -178,6 +208,24 @@ kind = kind_phys intent = out optional = F +[sh_flux_chs] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[lh_flux_chs] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [u_star] standard_name = surface_friction_velocity long_name = boundary layer parameter From a6372010f345caa343e0d484d70dfd6b6c91b1c5 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 10:37:59 -0700 Subject: [PATCH 142/274] Save temperatures from LSM at radiaiton time-steps for LW adjustment. --- physics/GFS_suite_interstitial.F90 | 9 +----- physics/GFS_suite_interstitial.meta | 10 +------ physics/dcyc2.f | 35 ++++++++++++++++++----- physics/dcyc2.meta | 44 +++++++++++++++++++++++------ 4 files changed, 65 insertions(+), 33 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 1086e444b..b7ea2f792 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,7 +163,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) implicit none @@ -184,9 +184,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw - - ! RRTMGP inputs - logical, intent(in ) :: use_LW_jacobian ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -231,9 +228,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... sfc lw fluxes used by atmospheric model are saved for output -! --- ... when using RRTMGP w/ use_GP_jacobian, these adjustment factors are pre-computed -! --- ... and provided as inputs in this routine. - if (.not. use_LW_jacobian) then if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -271,7 +265,6 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif - endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index c3bdbc611..0c055d17c 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -636,15 +636,7 @@ type = real kind = kind_phys intent = in - optional = F -[use_LW_jacobian] - standard_name = flag_to_calc_RRTMGP_LW_jacobian - long_name = logical flag to control RRTMGP LW calculation - units = flag - dimensions = () - type = logical - intent = in - optional = F + optional = F [dlwsfc] standard_name = cumulative_surface_downwelling_longwave_flux_multiplied_by_timestep long_name = cumulative surface downwelling LW flux multiplied by timestep diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 6061de509..fe39a187f 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -179,12 +179,13 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, & - & use_LW_jacobian, fluxlwUP, fluxlwUP_jac, & + & use_LW_jacobian, doLWrad, fluxlwUP, fluxlwUP_jac, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: + & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt, & & dtdt,dtdtc, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -211,7 +212,7 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet - logical, intent(in) :: use_LW_jacobian + logical, intent(in) :: use_LW_jacobian, doLWrad real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr @@ -229,6 +230,9 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc + + real(kind=kind_phys), dimension(im), intent(inout) :: & + & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & & fluxlwUP, & & fluxlwUP_jac @@ -244,7 +248,7 @@ subroutine dcyc2t3_run & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat, adjsfculw + & adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -309,9 +313,26 @@ subroutine dcyc2t3_run & ! note: sfc emiss effect is not appied here, and will be dealt in other place if (use_LW_Jacobian) then - ! F_adj = F_o + (dF/dT) * dT - adjsfculw(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsflw(i) - tf(i)) + ! Update temperature for LW flux adjustment at radiation calls. + if (doLWrad) then + tsfc_lnd_radt(i) = tsfc_lnd(i) + tsfc_wat_radt(i) = tsfc_wat(i) + tsfc_ice_radt(i) = tsfc_ice(i) + endif + + ! F_adj = F_o + (dF/dT) * dT + if (dry(i)) then + adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsfc_lnd_radt(i) - tsfc_lnd(i)) + endif + if (icy(i)) then + adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsfc_ice_radt(i) - tsfc_ice(i)) + endif + if (wet(i)) then + adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * + & (tsfc_wat_radt(i) - tsfc_wat(i)) + endif else if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index fd748edfd..8ccf5d9d1 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -106,6 +106,33 @@ kind = kind_phys intent = in optional = F +[tsfc_lnd_radt] + standard_name = surface_skin_temperature_over_land_interstitial_at_radiation_timestep + long_name = surface skin temperature over land at first call to radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_wat_radt] + standard_name = surface_skin_temperature_over_ocean_interstitial_at_radiation_timestep + long_name = surface skin temperature over ocean at first call to radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfc_ice_radt] + standard_name = surface_skin_temperature_over_ice_interstitial_at_radiation_timestep + long_name = surface skin temperature over ice at first call to radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [tf] standard_name = air_temperature_at_lowest_model_layer long_name = air temperature at lowest model layer @@ -389,15 +416,6 @@ kind = kind_phys intent = out optional = F -[adjsfculw] - standard_name = surface_upwelling_longwave_flux - long_name = surface upwelling longwave flux at current time - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial long_name = surface upwelling longwave flux at current time over land (temporary use as interstitial) @@ -523,6 +541,14 @@ type = logical intent = in optional = F +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F [fluxlwUP] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile From dc13504c6347eac639ba74f7612c091918df0bbb Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 21:06:38 +0000 Subject: [PATCH 143/274] Some reorganization. --- physics/GFS_suite_interstitial.F90 | 75 ++++++++++++++++----------- physics/dcyc2.f | 83 ++++++++++++++++++------------ 2 files changed, 96 insertions(+), 62 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index b7ea2f792..c8f962886 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -150,9 +150,17 @@ module GFS_suite_interstitial_2 contains subroutine GFS_suite_interstitial_2_init () + open(97,file='dump97.txt',status='unknown') + open(98,file='dump98.txt',status='unknown') + open(99,file='dump99.txt',status='unknown') + open(100,file='dump100.txt',status='unknown') end subroutine GFS_suite_interstitial_2_init subroutine GFS_suite_interstitial_2_finalize() + close(97) + close(98) + close(99) + close(100) end subroutine GFS_suite_interstitial_2_finalize #if 0 !> \section arg_table_GFS_suite_interstitial_2_run Argument Table @@ -228,43 +236,52 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl ! --- ... sfc lw fluxes used by atmospheric model are saved for output - if (frac_grid) then - do i=1,im + if (frac_grid) then + do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell if (flag_cice(i)) then - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + ulwsfc_cice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) else - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + adjsfculw_ice(i) * tem & - + adjsfculw_wat(i) * (one - frland(i) - tem) + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * tem & + + adjsfculw_wat(i) * (one - frland(i) - tem) endif - enddo - else - do i=1,im + enddo + else + do i=1,im if (dry(i)) then ! all land - adjsfculw(i) = adjsfculw_lnd(i) + adjsfculw(i) = adjsfculw_lnd(i) elseif (icy(i)) then ! ice (and water) - tem = one - cice(i) - if (flag_cice(i)) then - if (wet(i) .and. adjsfculw_wat(i) /= huge) then - adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = ulwsfc_cice(i) - endif - else - if (wet(i) .and. adjsfculw_wat(i) /= huge) then - adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem - else - adjsfculw(i) = adjsfculw_ice(i) - endif - endif + tem = one - cice(i) + if (flag_cice(i)) then + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = ulwsfc_cice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = ulwsfc_cice(i) + endif + else + if (wet(i) .and. adjsfculw_wat(i) /= huge) then + adjsfculw(i) = adjsfculw_ice(i)*cice(i) + adjsfculw_wat(i)*tem + else + adjsfculw(i) = adjsfculw_ice(i) + endif + endif else ! all water - adjsfculw(i) = adjsfculw_wat(i) + adjsfculw(i) = adjsfculw_wat(i) endif - enddo - endif + enddo + endif + + write(97,*) "#####" + write(97,*) adjsfculw + write(98,*) "#####" + write(98,*) adjsfculw_lnd + write(99,*) "#####" + write(99,*) adjsfculw_wat + write(100,*) "#####" + write(100,*) adjsfculw_ice do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/dcyc2.f b/physics/dcyc2.f index fe39a187f..d5ad9759f 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -17,9 +17,17 @@ module dcyc2t3 contains subroutine dcyc2t3_init() + open(93,file='dumpLND.txt',status='unknown') + open(94,file='dumpWAT.txt',status='unknown') + open(95,file='dumpICE.txt',status='unknown') + open(96,file='dumpFLUX.txt',status='unknown') end subroutine dcyc2t3_init subroutine dcyc2t3_finalize() + close(93) + close(94) + close(95) + close(96) end subroutine dcyc2t3_finalize ! ===================================================================== ! @@ -232,10 +240,10 @@ subroutine dcyc2t3_run & &, swhc, hlwc real(kind=kind_phys), dimension(im), intent(inout) :: & - & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt + & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & - & fluxlwUP, & - & fluxlwUP_jac + & fluxlwUP, & + & fluxlwUP_jac ! --- input/output: real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & @@ -300,40 +308,49 @@ subroutine dcyc2t3_run & enddo endif ! - do i = 1, im + ! Update temperature for LW flux adjustment at radiation calls. + if (doLWrad) then + tsfc_lnd_radt(1:im) = tsfc_lnd(1:im) + tsfc_wat_radt(1:im) = tsfc_wat(1:im) + tsfc_ice_radt(1:im) = tsfc_ice(1:im) + endif + + write(93,*) "#######",doLWrad + write(93,*) tsfc_lnd + write(93,*) "-" + write(93,*) tsfc_lnd_radt + write(94,*) "#######" + write(94,*) tsfc_wat - tsfc_wat_radt + write(95,*) "#######" + write(95,*) tsfc_ice - tsfc_ice_radt + write(96,*) "#######" + write(96,*) fluxlwUP(:,1) + write(96,*) "-" + write(96,*) fluxlwUP_jac(:,1) + + do i = 1, im !> - LW time-step adjustment: + if (use_LW_Jacobian) then + ! F_adj = F_o + (dF/dT) * dT + if (dry(i)) then + adjsfculw_lnd(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * + & (tsfc_lnd_radt(i) - tsfc_lnd(i)) + endif + if (icy(i)) then + adjsfculw_ice(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * + & (tsfc_ice_radt(i) - tsfc_ice(i)) + endif + if (wet(i)) then + adjsfculw_wat(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * + & (tsfc_wat_radt(i) - tsfc_wat(i)) + endif + else !! - adjust \a sfc downward LW flux to account for t changes in the lowest model layer. !! compute 4th power of the ratio of \c tf in the lowest model layer over the mean value \c tsflw. - tem1 = tf(i) / tsflw(i) - tem2 = tem1 * tem1 - adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 - -!! - compute \a sfc upward LW flux from current \a sfc temperature. -! note: sfc emiss effect is not appied here, and will be dealt in other place - - if (use_LW_Jacobian) then - ! Update temperature for LW flux adjustment at radiation calls. - if (doLWrad) then - tsfc_lnd_radt(i) = tsfc_lnd(i) - tsfc_wat_radt(i) = tsfc_wat(i) - tsfc_ice_radt(i) = tsfc_ice(i) - endif - - ! F_adj = F_o + (dF/dT) * dT - if (dry(i)) then - adjsfculw_lnd(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsfc_lnd_radt(i) - tsfc_lnd(i)) - endif - if (icy(i)) then - adjsfculw_ice(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsfc_ice_radt(i) - tsfc_ice(i)) - endif - if (wet(i)) then - adjsfculw_wat(i) = fluxlwUP(im,1) + fluxlwUP_jac(im,1) * - & (tsfc_wat_radt(i) - tsfc_wat(i)) - endif - else + tem1 = tf(i) / tsflw(i) + tem2 = tem1 * tem1 + adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 From 64abfa90afc9e1a8896bfa66583cac5592315d62 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 14:30:17 -0700 Subject: [PATCH 144/274] Intent(out) -> intent(inout) --- physics/rrtmgp_lw_rte.F90 | 2 +- physics/rrtmgp_lw_rte.meta | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index f2dfb0694..1c86db5f1 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -59,7 +59,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, lw_optical_props_clouds ! RRTMGP DDT: longwave cloud radiative properties ! Outputs - real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & + real(kind_phys), dimension(ncol,nLev+1), intent(inout) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 1d5300f5c..d249c77d6 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -129,7 +129,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_allsky] standard_name = RRTMGP_lw_flux_profile_downward_allsky @@ -138,7 +138,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwUP_clrsky] standard_name = RRTMGP_lw_flux_profile_upward_clrsky @@ -147,7 +147,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_clrsky] standard_name = RRTMGP_lw_flux_profile_downward_clrsky @@ -156,7 +156,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwUP_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward @@ -165,7 +165,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [fluxlwDOWN_jac] standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward @@ -174,7 +174,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message From 9a48b33b91ebcd33bd818c81c8d3b6b1a4d3e1e9 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 15:53:07 -0700 Subject: [PATCH 145/274] Use combined land/sea/ice surface temperature for LW adjustment of surface flux. --- physics/dcyc2.f | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index d5ad9759f..62b9f554b 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -311,10 +311,14 @@ subroutine dcyc2t3_run & ! Update temperature for LW flux adjustment at radiation calls. if (doLWrad) then - tsfc_lnd_radt(1:im) = tsfc_lnd(1:im) - tsfc_wat_radt(1:im) = tsfc_wat(1:im) - tsfc_ice_radt(1:im) = tsfc_ice(1:im) + do i = 1, im + tsfc_lnd_radt(i) = minval([tsfc_lnd(i),tsfc_wat(i), + & tsfc_ice(i)]) + enddo + !tsfc_wat_radt(1:im) = tsfc_wat(1:im) + !tsfc_ice_radt(1:im) = tsfc_ice(1:im) endif + write(93,*) "#######",doLWrad write(93,*) tsfc_lnd @@ -339,11 +343,11 @@ subroutine dcyc2t3_run & endif if (icy(i)) then adjsfculw_ice(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_ice_radt(i) - tsfc_ice(i)) + & (tsfc_lnd_radt(i) - tsfc_ice(i)) endif if (wet(i)) then adjsfculw_wat(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_wat_radt(i) - tsfc_wat(i)) + & (tsfc_lnd_radt(i) - tsfc_wat(i)) endif else !! - adjust \a sfc downward LW flux to account for t changes in the lowest model layer. From ae1430921506c942509a3ebba9cd0785a3de316a Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 7 Dec 2020 16:24:32 -0700 Subject: [PATCH 146/274] Added print statements for diag. --- physics/GFS_suite_interstitial.F90 | 20 ++++--------------- physics/dcyc2.f | 31 +++++++----------------------- 2 files changed, 11 insertions(+), 40 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index c8f962886..898f6d454 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -150,17 +150,9 @@ module GFS_suite_interstitial_2 contains subroutine GFS_suite_interstitial_2_init () - open(97,file='dump97.txt',status='unknown') - open(98,file='dump98.txt',status='unknown') - open(99,file='dump99.txt',status='unknown') - open(100,file='dump100.txt',status='unknown') end subroutine GFS_suite_interstitial_2_init subroutine GFS_suite_interstitial_2_finalize() - close(97) - close(98) - close(99) - close(100) end subroutine GFS_suite_interstitial_2_finalize #if 0 !> \section arg_table_GFS_suite_interstitial_2_run Argument Table @@ -274,14 +266,10 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl enddo endif - write(97,*) "#####" - write(97,*) adjsfculw - write(98,*) "#####" - write(98,*) adjsfculw_lnd - write(99,*) "#####" - write(99,*) adjsfculw_wat - write(100,*) "#####" - write(100,*) adjsfculw_ice + print*, 'adjsfculw: ',adjsfculw + print*, 'adjsfculw_lnd: ',adjsfculw_lnd + print*, 'adjsfculw_wat: ',adjsfculw_wat + print*, 'adjsfculw_ice: ',adjsfculw_ice do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 62b9f554b..6e1197113 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -17,17 +17,9 @@ module dcyc2t3 contains subroutine dcyc2t3_init() - open(93,file='dumpLND.txt',status='unknown') - open(94,file='dumpWAT.txt',status='unknown') - open(95,file='dumpICE.txt',status='unknown') - open(96,file='dumpFLUX.txt',status='unknown') end subroutine dcyc2t3_init subroutine dcyc2t3_finalize() - close(93) - close(94) - close(95) - close(96) end subroutine dcyc2t3_finalize ! ===================================================================== ! @@ -315,23 +307,14 @@ subroutine dcyc2t3_run & tsfc_lnd_radt(i) = minval([tsfc_lnd(i),tsfc_wat(i), & tsfc_ice(i)]) enddo - !tsfc_wat_radt(1:im) = tsfc_wat(1:im) - !tsfc_ice_radt(1:im) = tsfc_ice(1:im) endif - - - write(93,*) "#######",doLWrad - write(93,*) tsfc_lnd - write(93,*) "-" - write(93,*) tsfc_lnd_radt - write(94,*) "#######" - write(94,*) tsfc_wat - tsfc_wat_radt - write(95,*) "#######" - write(95,*) tsfc_ice - tsfc_ice_radt - write(96,*) "#######" - write(96,*) fluxlwUP(:,1) - write(96,*) "-" - write(96,*) fluxlwUP_jac(:,1) + + print*, 'tsfc_lnd_radt: ',tsfc_lnd + print*, 'tsfc_lnd: ',tsfc_lnd_radt + print*, 'tsfc_wat: ',tsfc_wat + print*, 'tsfc_ice: ',tsfc_ice + print*, 'fluxlwUP(:,1): ',fluxlwUP(:,1) + print*, 'fluxlwUP_jac(:,1): ',fluxlwUP_jac(:,1) do i = 1, im !> - LW time-step adjustment: From ac42e80f60d89ebca802a159abda6ee7c1f6f954 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 8 Dec 2020 18:49:28 +0000 Subject: [PATCH 147/274] additions for MP perturbations --- physics/GFS_stochastics.F90 | 178 +++++++++++++---------------------- physics/GFS_stochastics.meta | 168 +++++++++++++-------------------- 2 files changed, 130 insertions(+), 216 deletions(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 949b4f9ec..b125f881d 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -26,19 +26,18 @@ end subroutine GFS_stochastics_finalize !! -# defines random seed indices for radiation (in a reproducible way) !! -# interpolates coefficients for prognostic ozone calculation !! -# performs surface data cycling via the GFS gcycle routine - subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, & - do_skeb, do_ca,ca_global,ca1,si,vfact_ca, & + subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, & + do_shum ,do_skeb, do_ca,ca_global,ca1,si,vfact_ca, & zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,& sppt_wts_inv, skebu_wts_inv, skebv_wts_inv, & - shum_wts_inv, diss_est, ugrs, vgrs, tgrs, & - qgrs, qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, & - qgrs_ni, qgrs_nr, qgrs_nc, qgrs_nwfa, qgrs_nifa, & - gu0, gv0, gt0, gq0, dtdtr, & + shum_wts_inv, diss_est, ugrs, vgrs, tgrs, qgrs_wv, & + qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, & + gu0, gv0, gt0, gq0_wv, dtdtr, & gq0_cw, gq0_rw, gq0_sw, gq0_iw, gq0_gl, & - gq0_ni, gq0_nr, gq0_nc, gq0_nwfa, gq0_nifa, & rain, rainc, tprcp, totprcp, cnvprcp, & totprcpb, cnvprcpb, cplflx, & rain_cpl, snow_cpl, drain_cpl, dsnow_cpl, & + ntcw,ntrw,ntsw,ntiw,ntgl, & errmsg, errflg) use machine, only: kind_phys @@ -49,6 +48,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, integer, intent(in) :: km integer, intent(in) :: kdt logical, intent(in) :: do_sppt + logical, intent(in) :: do_pertmp logical, intent(in) :: do_ca logical, intent(in) :: ca_global logical, intent(in) :: use_zmtnblck @@ -71,31 +71,26 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, real(kind_phys), dimension(1:im,1:km), intent(in) :: ugrs real(kind_phys), dimension(1:im,1:km), intent(in) :: vgrs real(kind_phys), dimension(1:im,1:km), intent(in) :: tgrs - real(kind_phys), dimension(1:im,1:km), intent(in) :: qgrs - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_cw - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_rw - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_sw - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_iw - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_gl - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_ni - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nr - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nc - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nwfa - real(kind_phys), dimension(1:im,1:km), intent(in),optional :: qgrs_nifa + real(kind_phys), dimension(1:im,1:km), intent(in) :: qgrs_wv + real(kind_phys), dimension(:,:), intent(in) :: qgrs_cw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_rw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_sw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_iw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_gl real(kind_phys), dimension(1:im,1:km), intent(inout) :: gu0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gv0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gt0 - real(kind_phys), dimension(1:im,1:km), intent(inout) :: gq0 - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_cw - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_rw - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_sw - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_iw - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_gl - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_ni - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nr - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nc - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nwfa - real(kind_phys), dimension(1:im,1:km), intent(inout),optional :: gq0_nifa + real(kind_phys), dimension(1:im,1:km), intent(inout) :: gq0_wv + real(kind_phys), dimension(:,:), intent(inout) :: gq0_cw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_rw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_sw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_iw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_gl + integer, intent(in) :: ntcw + integer, intent(in) :: ntrw + integer, intent(in) :: ntsw + integer, intent(in) :: ntiw + integer, intent(in) :: ntgl ! dtdtr only allocated if do_sppt == .true. real(kind_phys), dimension(:,:), intent(in) :: dtdtr real(kind_phys), dimension(1:im), intent(in) :: rain @@ -155,96 +150,57 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, upert = (gu0(i,k) - ugrs(i,k)) * sppt_wts(i,k) vpert = (gv0(i,k) - vgrs(i,k)) * sppt_wts(i,k) tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * sppt_wts(i,k) - qpert = (gq0(i,k) - qgrs(i,k)) * sppt_wts(i,k) + qpert = (gq0_wv(i,k) - qgrs_wv(i,k)) * sppt_wts(i,k) gu0(i,k) = ugrs(i,k)+upert gv0(i,k) = vgrs(i,k)+vpert !negative humidity check - qnew = qgrs(i,k)+qpert + qnew = qgrs_wv(i,k)+qpert if (qnew >= 1.0e-10) then - gq0(i,k) = qnew + gq0_wv(i,k) = qnew gt0(i,k) = tgrs(i,k) + tpert + dtdtr(i,k) endif - if (present(gq0_cw) .AND. present(qgrs_cw)) then - qpert = gq0_cw(i,k) - qgrs_cw(i,k) * sppt_wts(i,k) - qnew = qgrs_cw(i,k,l+1)+qpert - gq0_cw(i,k) = qnew - if (qnew < 0.0) then - gq0_cw(i,k) = 0.0 - endif - endif - if (present(gq0_rw) .AND. present(qgrs_rw)) then - qpert = gq0_rw(i,k) - qgrs_rw(i,k) * sppt_wts(i,k) - qnew = qgrs_rw(i,k,l+1)+qpert - gq0_rw(i,k) = qnew - if (qnew < 0.0) then - gq0_rw(i,k) = 0.0 - endif - endif - if (present(gq0_sw) .AND. present(qgrs_sw)) then - qpert = gq0_sw(i,k) - qgrs_sw(i,k) * sppt_wts(i,k) - qnew = qgrs_sw(i,k,l+1)+qpert - gq0_sw(i,k) = qnew - if (qnew < 0.0) then - gq0_sw(i,k) = 0.0 - endif - endif - if (present(gq0_iw) .AND. present(qgrs_iw)) then - qpert = gq0_iw(i,k) - qgrs_iw(i,k) * sppt_wts(i,k) - qnew = qgrs_iw(i,k,l+1)+qpert - gq0_iw(i,k) = qnew - if (qnew < 0.0) then - gq0_iw(i,k) = 0.0 - endif - endif - if (present(gq0_gl) .AND. present(qgrs_gl)) then - qpert = gq0_gl(i,k) - qgrs_gl(i,k) * sppt_wts(i,k) - qnew = qgrs_gl(i,k,l+1)+qpert - gq0_gl(i,k) = qnew - if (qnew < 0.0) then - gq0_gl(i,k) = 0.0 - endif - endif - if (present(gq0_ni) .AND. present(qgrs_ni)) then - qpert = gq0_ni(i,k) - qgrs_ni(i,k) * sppt_wts(i,k) - qnew = qgrs_ni(i,k,l+1)+qpert - gq0_ni(i,k) = qnew - if (qnew < 0.0) then - gq0_ni(i,k) = 0.0 + if (do_pertmp) then + if (ntcw>0) then + qpert = gq0_cw(i,k) - qgrs_cw(i,k) * sppt_wts(i,k) + qnew = qgrs_cw(i,k)+qpert + gq0_cw(i,k) = qnew + if (qnew < 0.0) then + gq0_cw(i,k) = 0.0 + endif endif - endif - if (present(gq0_nr) .AND. present(qgrs_nr)) then - qpert = gq0_nr(i,k) - qgrs_nr(i,k) * sppt_wts(i,k) - qnew = qgrs_nr(i,k,l+1)+qpert - gq0_nr(i,k) = qnew - if (qnew < 0.0) then - gq0_nr(i,k) = 0.0 + if (ntrw>0) then + qpert = gq0_rw(i,k) - qgrs_rw(i,k) * sppt_wts(i,k) + qnew = qgrs_rw(i,k)+qpert + gq0_rw(i,k) = qnew + if (qnew < 0.0) then + gq0_rw(i,k) = 0.0 + endif endif - endif - if (present(gq0_nnc .AND. present(qgrs_nc)) then - qpert = gq0_nc(i,k) - qgrs_nc(i,k) * sppt_wts(i,k) - qnew = qgrs_nc(i,k,l+1)+qpert - gq0_nc(i,k) = qnew - if (qnew < 0.0) then - gq0_nc(i,k) = 0.0 + if (ntsw>0) then + qpert = gq0_sw(i,k) - qgrs_sw(i,k) * sppt_wts(i,k) + qnew = qgrs_sw(i,k)+qpert + gq0_sw(i,k) = qnew + if (qnew < 0.0) then + gq0_sw(i,k) = 0.0 + endif endif - endif - if (present(gq0_nwfa) .AND. present(qgrs_nwfa)) then - qpert = gq0_nwfa(i,k) - qgrs_nwfa(i,k) * sppt_wts(i,k) - qnew = qgrs_nwfa(i,k,l+1)+qpert - gq0_nwfa(i,k) = qnew - if (qnew < 0.0) then - gq0_nwfa(i,k) = 0.0 + if (ntiw>0) then + qpert = gq0_iw(i,k) - qgrs_iw(i,k) * sppt_wts(i,k) + qnew = qgrs_iw(i,k)+qpert + gq0_iw(i,k) = qnew + if (qnew < 0.0) then + gq0_iw(i,k) = 0.0 + endif endif - endif - enddo - if (present(gq0_nifa) .AND. present(qgrs_nifa)) then - qpert = gq0_nifa(i,k) - qgrs_nifa(i,k) * sppt_wts(i,k) - qnew = qgrs_nifa(i,k,l+1)+qpert - gq0_nifa(i,k) = qnew - if (qnew < 0.0) then - gq0_nifa(i,k) = 0.0 + if (ntgl>0) then + qpert = gq0_gl(i,k) - qgrs_gl(i,k) * sppt_wts(i,k) + qnew = qgrs_gl(i,k)+qpert + gq0_gl(i,k) = qnew + if (qnew < 0.0) then + gq0_gl(i,k) = 0.0 + endif endif endif enddo @@ -307,13 +263,13 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, upert = (gu0(i,k) - ugrs(i,k)) * ca(i,k) vpert = (gv0(i,k) - vgrs(i,k)) * ca(i,k) tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * ca(i,k) - qpert = (gq0(i,k) - qgrs(i,k)) * ca(i,k) + qpert = (gq0_wv(i,k) - qgrs_wv(i,k)) * ca(i,k) gu0(i,k) = ugrs(i,k)+upert gv0(i,k) = vgrs(i,k)+vpert !negative humidity check - qnew = qgrs(i,k)+qpert + qnew = qgrs_wv(i,k)+qpert if (qnew >= 1.0e-10) then - gq0(i,k) = qnew + gq0_wv(i,k) = qnew gt0(i,k) = tgrs(i,k) + tpert + dtdtr(i,k) endif enddo @@ -338,7 +294,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, if (do_shum) then do k=1,km - gq0(:,k) = gq0(:,k)*(1.0 + shum_wts(:,k)) + gq0_wv(:,k) = gq0_wv(:,k)*(1.0 + shum_wts(:,k)) shum_wts_inv(:,k) = shum_wts(:,k) end do endif diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index 08f9f004e..aae5868d1 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -31,6 +31,46 @@ type = integer intent = in optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + intent = in + optional = F + type = integer +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F [do_sppt] standard_name = flag_for_stochastic_physics_perturbations long_name = flag for stochastic physics perturbations @@ -39,6 +79,14 @@ type = logical intent = in optional = F +[do_pertmp] + standard_name = flag_for_stochastic_microphysics_perturbations + long_name = flag for stochastic microphysics physics perturbations + units = flag + dimensions = () + type = logical + intent = in + optional = F [use_zmtnblck] standard_name = flag_for_mountain_blocking long_name = flag for mountain blocking @@ -223,7 +271,7 @@ kind = kind_phys intent = in optional = F -[qgrs] +[qgrs_wv] standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity units = kg kg-1 @@ -240,8 +288,8 @@ type = real kind = kind_phys intent = in - optional = T -[ggrs_rw] + optional = F +[qgrs_rw] standard_name = rain_water_mixing_ratio long_name = moist mixing ratio of rain units = kg kg-1 @@ -249,8 +297,8 @@ type = real kind = kind_phys intent = in - optional = T -[ggrs_iw] + optional = F +[qgrs_iw] standard_name = ice_water_mixing_ratio long_name = moist mixing ratio of cloud ice units = kg kg-1 @@ -258,8 +306,8 @@ type = real kind = kind_phys intent = in - optional = T -[ggrs_sw] + optional = F +[qgrs_sw] standard_name = snow_water_mixing_ratio long_name = moist mixing ratio of snow units = kg kg-1 @@ -267,7 +315,7 @@ type = real kind = kind_phys intent = in - optional = T + optional = F [qgrs_gl] standard_name = graupel_mixing_ratio long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) @@ -276,52 +324,7 @@ type = real kind = kind_phys intent = in - optional = T -[qgrs_ni] - standard_name = ice_number_concentration - long_name = ice number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = T -[gqrs_nr] - standard_name = rain_number_concentration - long_name = rain number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = T -[gqrs_nc] - standard_name = cloud_droplet_number_concentration - long_name = cloud droplet number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = T -[qgrs_nwfa] - standard_name = water_friendly_aerosol_number_concentration - long_name = number concentration of water-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = T -[qgrs_nifa] - standard_name = ice_friendly_aerosol_number_concentration - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = T + optional = F [gu0] standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics @@ -349,7 +352,7 @@ kind = kind_phys intent = inout optional = F -[gq0] +[gq0_wv] standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity updated by physics units = kg kg-1 @@ -366,7 +369,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [gq0_rw] standard_name = rain_water_mixing_ratio_updated_by_physics long_name = moist mixing ratio of rain updated by physics @@ -375,7 +378,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [gq0_iw] standard_name = ice_water_mixing_ratio_updated_by_physics long_name = moist mixing ratio of cloud ice updated by physics @@ -384,7 +387,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [gq0_sw] standard_name = snow_water_mixing_ratio_updated_by_physics long_name = moist mixing ratio of snow updated by physics @@ -393,7 +396,7 @@ type = real kind = kind_phys intent = inout - optional = T + optional = F [gq0_gl] standard_name = graupel_mixing_ratio_updated_by_physics long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics @@ -402,52 +405,7 @@ type = real kind = kind_phys intent = inout - optional = T -[gq0_ni] - standard_name = ice_number_concentration_updated_by_physics - long_name = ice number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[gq0_nr] - standard_name = rain_number_concentration_updated_by_physics - long_name = rain number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[gq0_nc] - standard_name = cloud_droplet_number_concentration_updated_by_physics - long_name = cloud droplet number concentration - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[gq0_nwfa] - standard_name = water_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of water-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T -[gq0_nifa] - standard_name = ice_friendly_aerosol_number_concentration_updated_by_physics - long_name = number concentration of ice-friendly aerosols - units = kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T + optional = F [dtdtr] standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step From 250de74fce42c6ecda654f4d47508d9ffa3c5335 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 8 Dec 2020 21:45:23 +0000 Subject: [PATCH 148/274] Cleanup of GP LW flux adjustment using Jacobian of surface upwelling. --- physics/GFS_rrtmgp_lw_post.F90 | 14 +++--- physics/GFS_rrtmgp_lw_post.meta | 9 ++++ physics/GFS_suite_interstitial.F90 | 14 +++--- physics/GFS_suite_interstitial.meta | 10 ++++- physics/dcyc2.f | 59 ++++++------------------ physics/dcyc2.meta | 70 +++++++++-------------------- physics/rrtmgp_lw_rte.F90 | 22 ++++++--- physics/rrtmgp_lw_rte.meta | 17 ++----- 8 files changed, 87 insertions(+), 128 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index e6f6a59a5..e2dbd17fa 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -27,7 +27,7 @@ end subroutine GFS_rrtmgp_lw_post_init subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, & - sfcdlw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) + sfcdlw, sfculw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -65,11 +65,12 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag real(kind=kind_phys), dimension(:,:), intent(inout) :: fluxr ! Outputs (mandatory) - real(kind_phys), dimension(nCol), intent(inout) :: & - sfcdlw, & ! Total sky sfc downward lw flux (W/m2) - tsflw ! surface air temp during lw calculation (K) - type(sfcflw_type), dimension(nCol), intent(inout) :: & - sfcflw ! LW radiation fluxes at sfc + real(kind_phys), dimension(nCol), intent(inout) :: & + sfcdlw, & ! Total sky sfc downward lw flux (W/m2) + sfculw, & ! Total sky sfc upward lw flux (W/m2) + tsflw ! surface air temp during lw calculation (K) + type(sfcflw_type), dimension(nCol), intent(inout) :: & + sfcflw ! LW radiation fluxes at sfc real(kind_phys), dimension(nCol,nLev), intent(inout) :: & htrlw ! LW all-sky heating rate type(topflw_type), dimension(nCol), intent(out) :: & @@ -160,6 +161,7 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag ! Radiation fluxes for other physics processes sfcdlw(:) = sfcflw(:)%dnfxc + sfculw(:) = sfcflw(:)%upfxc ! ####################################################################################### ! Save LW diagnostics diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index a87b6adcb..72a82421e 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -198,6 +198,15 @@ kind = kind_phys intent = inout optional = F +[sfculw] + standard_name = surface_upwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc upward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [sfcflw] standard_name = lw_fluxes_sfc long_name = lw radiation fluxes at sfc diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 898f6d454..62efa00d5 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -163,14 +163,14 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & adjsfculw_ice, adjsfculw_wat, dlwsfc, ulwsfc, psmean, dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp, & - ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, errmsg, errflg) + ctei_rml, ctei_r, kinver, dry, icy, wet, frland, huge, use_LW_jacobian, errmsg, errflg) implicit none ! interface variables integer, intent(in ) :: im, levs, imfshalcnv logical, intent(in ) :: lssav, ldiag3d, lsidea, cplflx, shal_cnv - logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid + logical, intent(in ) :: old_monin, mstrat, do_shoc, frac_grid, use_LW_jacobian real(kind=kind_phys), intent(in ) :: dtf, cp, hvap logical, intent(in ), dimension(im) :: flag_cice @@ -183,7 +183,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl integer, intent(inout), dimension(im) :: kinver real(kind=kind_phys), intent(inout), dimension(im) :: suntim, dlwsfc, ulwsfc, psmean, ctei_rml, ctei_r real(kind=kind_phys), intent(in ), dimension(im) :: adjsfculw_lnd, adjsfculw_ice, adjsfculw_wat - real(kind=kind_phys), intent( out), dimension(im) :: adjsfculw + real(kind=kind_phys), intent(inout), dimension(im) :: adjsfculw ! These arrays are only allocated if ldiag3d is .true. real(kind=kind_phys), intent(inout), dimension(:,:) :: dt3dt_lw, dt3dt_sw, dt3dt_pbl, dt3dt_dcnv, dt3dt_scnv, dt3dt_mp @@ -227,7 +227,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl enddo ! --- ... sfc lw fluxes used by atmospheric model are saved for output - + if (.not. use_LW_jacobian) then if (frac_grid) then do i=1,im tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell @@ -265,11 +265,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif enddo endif - - print*, 'adjsfculw: ',adjsfculw - print*, 'adjsfculw_lnd: ',adjsfculw_lnd - print*, 'adjsfculw_wat: ',adjsfculw_wat - print*, 'adjsfculw_ice: ',adjsfculw_ice + endif do i=1,im dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 0c055d17c..fdf1716f1 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -601,6 +601,14 @@ kind = kind_phys intent = inout optional = F +[use_LW_jacobian] + standard_name = flag_to_calc_RRTMGP_LW_jacobian + long_name = logical flag to control RRTMGP LW calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [adjsfculw] standard_name = surface_upwelling_longwave_flux long_name = surface upwelling longwave flux at current time @@ -608,7 +616,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [adjsfculw_lnd] standard_name = surface_upwelling_longwave_flux_over_land_interstitial diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 6e1197113..389496d07 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -42,7 +42,7 @@ end subroutine dcyc2t3_finalize ! ( solhr,slag,sdec,cdec,sinlat,coslat, ! ! xlon,coszen,tsfc_lnd,tsfc_ice,tsfc_wat, ! ! tf,tsflw,sfcemis_lnd,sfcemis_ice,sfcemis_wat, ! -! sfcdsw,sfcnsw,sfcdlw,swh,swhc,hlw,hlwc, ! +! sfcdsw,sfcnsw,sfcdlw,sfculw,swh,swhc,hlw,hlwc, ! ! sfcnirbmu,sfcnirdfu,sfcvisbmu,sfcvisdfu, ! ! sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, ! ! im, levs, deltim, fhswr, ! @@ -50,7 +50,7 @@ end subroutine dcyc2t3_finalize ! input/output: ! ! dtdt,dtdtc, ! ! outputs: ! -! adjsfcdsw,adjsfcnsw,adjsfcdlw, ! +! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, ! ! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! ! adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, ! ! adjdnnbmd,adjdnndfd,adjdnvbmd,adjdnvdfd) ! @@ -76,6 +76,7 @@ end subroutine dcyc2t3_finalize ! sfcdsw (im) - real, total sky sfc downward sw flux ( w/m**2 ) ! ! sfcnsw (im) - real, total sky sfc net sw into ground (w/m**2) ! ! sfcdlw (im) - real, total sky sfc downward lw flux ( w/m**2 ) ! +! sfculw (im) - real, total sky sfc upward lw flux ( w/m**2 ) ! ! swh(im,levs) - real, total sky sw heating rates ( k/s ) ! ! swhc(im,levs) - real, clear sky sw heating rates ( k/s ) ! ! hlw(im,levs) - real, total sky lw heating rates ( k/s ) ! @@ -179,13 +180,12 @@ subroutine dcyc2t3_run & & sfcnirbmd,sfcnirdfd,sfcvisbmd,sfcvisdfd, & & im, levs, deltim, fhswr, & & dry, icy, wet, & - & use_LW_jacobian, doLWrad, fluxlwUP, fluxlwUP_jac, & + & use_LW_jacobian, sfculw, sfculw_jac, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: - & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt, & & dtdt,dtdtc, & ! --- outputs: - & adjsfcdsw,adjsfcnsw,adjsfcdlw, & + & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & & adjnirbmu,adjnirdfu,adjvisbmu,adjvisdfu, & & adjnirbmd,adjnirdfd,adjvisbmd,adjvisdfd, & @@ -212,13 +212,13 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet - logical, intent(in) :: use_LW_jacobian, doLWrad + logical, intent(in) :: use_LW_jacobian real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr real(kind=kind_phys), dimension(im), intent(in) :: & & sinlat, coslat, xlon, coszen, tf, tsflw, sfcdlw, & - & sfcdsw, sfcnsw + & sfcdsw, sfcnsw, sfculw, sfculw_jac real(kind=kind_phys), dimension(im), intent(in) :: & & tsfc_lnd, tsfc_ice, tsfc_wat, & @@ -231,19 +231,13 @@ subroutine dcyc2t3_run & real(kind=kind_phys), dimension(im,levs), intent(in) :: swh, hlw & &, swhc, hlwc - real(kind=kind_phys), dimension(im), intent(inout) :: & - & tsfc_lnd_radt , tsfc_ice_radt , tsfc_wat_radt - real(kind=kind_phys), dimension(im,levs+1), intent(in) :: & - & fluxlwUP, & - & fluxlwUP_jac - ! --- input/output: real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & &, dtdtc ! --- outputs: real(kind=kind_phys), dimension(im), intent(out) :: & - & adjsfcdsw, adjsfcnsw, adjsfcdlw, xmu, xcosz, & + & adjsfcdsw, adjsfcnsw, adjsfcdlw, adjsfculw, xmu, xcosz, & & adjnirbmu, adjnirdfu, adjvisbmu, adjvisdfu, & & adjnirbmd, adjnirdfd, adjvisbmd, adjvisdfd @@ -256,7 +250,7 @@ subroutine dcyc2t3_run & ! --- locals: integer :: i, k, nstp, nstl, it, istsun(im) real(kind=kind_phys) :: cns, coszn, tem1, tem2, anginc, & - & rstl, solang + & rstl, solang, dT ! !===> ... begin here ! @@ -301,43 +295,18 @@ subroutine dcyc2t3_run & endif ! - ! Update temperature for LW flux adjustment at radiation calls. - if (doLWrad) then - do i = 1, im - tsfc_lnd_radt(i) = minval([tsfc_lnd(i),tsfc_wat(i), - & tsfc_ice(i)]) - enddo - endif - - print*, 'tsfc_lnd_radt: ',tsfc_lnd - print*, 'tsfc_lnd: ',tsfc_lnd_radt - print*, 'tsfc_wat: ',tsfc_wat - print*, 'tsfc_ice: ',tsfc_ice - print*, 'fluxlwUP(:,1): ',fluxlwUP(:,1) - print*, 'fluxlwUP_jac(:,1): ',fluxlwUP_jac(:,1) - do i = 1, im + tem1 = tf(i) / tsflw(i) + tem2 = tem1 * tem1 + adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 !> - LW time-step adjustment: if (use_LW_Jacobian) then ! F_adj = F_o + (dF/dT) * dT - if (dry(i)) then - adjsfculw_lnd(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_lnd_radt(i) - tsfc_lnd(i)) - endif - if (icy(i)) then - adjsfculw_ice(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_lnd_radt(i) - tsfc_ice(i)) - endif - if (wet(i)) then - adjsfculw_wat(i) = fluxlwUP(i,1) + fluxlwUP_jac(i,1) * - & (tsfc_lnd_radt(i) - tsfc_wat(i)) - endif + dT = tf(i) - tsflw(i) + adjsfculw(i) = sfculw(i) + sfculw_jac(i) * dT else !! - adjust \a sfc downward LW flux to account for t changes in the lowest model layer. !! compute 4th power of the ratio of \c tf in the lowest model layer over the mean value \c tsflw. - tem1 = tf(i) / tsflw(i) - tem2 = tem1 * tem1 - adjsfcdlw(i) = sfcdlw(i) * tem2 * tem2 if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index 8ccf5d9d1..efba0a5f5 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -105,33 +105,6 @@ type = real kind = kind_phys intent = in - optional = F -[tsfc_lnd_radt] - standard_name = surface_skin_temperature_over_land_interstitial_at_radiation_timestep - long_name = surface skin temperature over land at first call to radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[tsfc_wat_radt] - standard_name = surface_skin_temperature_over_ocean_interstitial_at_radiation_timestep - long_name = surface skin temperature over ocean at first call to radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[tsfc_ice_radt] - standard_name = surface_skin_temperature_over_ice_interstitial_at_radiation_timestep - long_name = surface skin temperature over ice at first call to radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout optional = F [tf] standard_name = air_temperature_at_lowest_model_layer @@ -205,6 +178,15 @@ kind = kind_phys intent = in optional = F +[sfculw] + standard_name = surface_upwelling_longwave_flux_on_radiation_time_step + long_name = total sky sfc upward lw flux + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [swh] standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate on radiation time step @@ -443,6 +425,15 @@ kind = kind_phys intent = out optional = F +[adjsfculw] + standard_name = surface_upwelling_longwave_flux + long_name = surface upwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [xmu] standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes long_name = zenith angle temporal adjustment factor for shortwave fluxes @@ -541,28 +532,11 @@ type = logical intent = in optional = F -[doLWrad] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[fluxlwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky - long_name = RRTMGP upward longwave all-sky flux profile - units = W m-2 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in - optional = F -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile +[sfculw_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_upward_at_surface + long_name = RRTMGP Jacobian upward longwave flux at surface units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 1c86db5f1..321214a02 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -31,8 +31,7 @@ end subroutine rrtmgp_lw_rte_init subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & nLev, p_lev, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, fluxlwDOWN_jac,& - errmsg, errflg) + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, sfculw_jac, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -59,13 +58,13 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, lw_optical_props_clouds ! RRTMGP DDT: longwave cloud radiative properties ! Outputs + real(kind_phys), dimension(ncol), intent(inout) :: & + sfculw_jac ! Jacobian of upwelling LW surface radiation (W/m2/K) real(kind_phys), dimension(ncol,nLev+1), intent(inout) :: & fluxlwUP_allsky, & ! All-sky flux (W/m2) fluxlwDOWN_allsky, & ! All-sky flux (W/m2) fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) - fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) - fluxlwUP_jac, & ! Jacobian of upward LW flux (W/m2/K) - fluxlwDOWN_jac ! Jacobian of downward LW flux (W/m2/K) + fluxlwDOWN_clrsky ! All-sky flux (W/m2) character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & @@ -76,8 +75,10 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, flux_allsky, flux_clrsky real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + real(kind_phys), dimension(nCol,nLev+1) :: fluxlwUP_jac,fluxlwDOWN_jac logical :: & top_at_1 + integer :: iSFC, iTOA ! Initialize CCPP error handling variables errmsg = '' @@ -87,7 +88,14 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, ! Vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - + if (top_at_1) then + iSFC = nLev+1 + iTOA = 1 + else + iSFC = 1 + iTOA = nLev+1 + endif + ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky @@ -140,6 +148,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + sfculw_jac = fluxlwUP_jac(:,iSFC) else call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & lw_optical_props_clouds, & ! IN - optical-properties @@ -166,6 +175,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, n_gauss_angles = nGauss_angles, & ! IN - Number of angles in Gaussian quadrature flux_up_Jac = fluxlwUP_jac, & ! OUT - surface temperature flux (upward) Jacobian (W/m2/K) flux_dn_Jac = fluxlwDOWN_jac)) ! OUT - surface temperature flux (downward) Jacobian (W/m2/K) + sfculw_jac = fluxlwUP_jac(:,iSFC) else call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & lw_optical_props_clrsky, & ! IN - optical-properties diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index d249c77d6..d295fa511 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -158,20 +158,11 @@ kind = kind_phys intent = inout optional = F -[fluxlwUP_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_upward - long_name = RRTMGP Jacobian upward longwave flux profile +[sfculw_jac] + standard_name = RRTMGP_jacobian_of_lw_flux_upward_at_surface + long_name = RRTMGP Jacobian upward longwave flux at surface units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = inout - optional = F -[fluxlwDOWN_jac] - standard_name = RRTMGP_jacobian_of_lw_flux_profile_downward - long_name = RRTMGP Jacobian downward of longwave flux profile - units = W m-2 K-1 - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout From 196603cb1c87e9d4259a70beb9e0edbd044a39f0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 10 Dec 2020 12:59:50 -0700 Subject: [PATCH 149/274] From @@yangfanglin: add missing tsfc(i) = tsfc_ice(i) to reproduce GFS v16 behavior --- physics/GFS_surface_composites.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 6cbf35f03..92367ef4b 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -571,6 +571,7 @@ subroutine GFS_surface_composites_post_run ( snowd(i) = snowd_ice(i) !tprcp(i) = cice(i)*tprcp_ice(i) + (one-cice(i))*tprcp_wat(i) qss(i) = qss_ice(i) + tsfc(i) = tsfc_ice(i) evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) From 186832a4b33bfc2566c5ff77afaa4bca542c5aeb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 10 Dec 2020 13:00:17 -0700 Subject: [PATCH 150/274] physics/GFS_debug.F90: bugfix, zs now in Model and no longer in Sfcprop --- physics/GFS_debug.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 4680f8de7..b5066637d 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -491,10 +491,10 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, end if ! CCPP/RUC only if (Model%lsm == Model%lsm_ruc) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Model%zs', Model%zs) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sh2o', Sfcprop%sh2o) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%smois', Sfcprop%smois) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%tslb', Sfcprop%tslb) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%zs', Sfcprop%zs) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%clw_surf', Sfcprop%clw_surf) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%qwv_surf', Sfcprop%qwv_surf) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%cndm_surf', Sfcprop%cndm_surf) From 6782e0e006083c210663adc8c73ef21b37bb5bb7 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 14 Dec 2020 15:44:44 +0000 Subject: [PATCH 151/274] add temporary surface perturbation diagnostic --- physics/GFS_surface_generic.F90 | 6 +++++- physics/GFS_surface_generic.meta | 11 ++++++++++- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 72efcea60..e7a81b7c4 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -29,7 +29,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, ca_global,dtdtr,& drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & lndp_var_list, lndp_prt_list, & - z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, & + z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, sfc_wts_inv, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice, & wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg) @@ -68,6 +68,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: xlai1d real(kind=kind_phys), dimension(im), intent(out) :: vegf1d real(kind=kind_phys), intent(out) :: lndp_vgf + real(kind=kind_phys), dimension(im,n_var_lndp), intent(inout) :: sfc_wts_inv logical, intent(in) :: cplflx real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl @@ -108,6 +109,9 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! Turn vegetation fraction pattern into percentile pattern lndp_vgf=-999. + if (lndp_type>0) then + sfc_wts_inv(:,:)=sfc_wts(:,:) + endif if (lndp_type==1) then do k =1,n_var_lndp select case(lndp_var_list(k)) diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 68713ab19..44e4f7f68 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -274,8 +274,17 @@ kind = kind_phys intent = in optional = F +[sfc_wts_inv] + standard_name = weights_for_stochastic_surface_physics_perturbation_flipped + long_name = weights for stochastic surface physics perturbation, flipped + units = none + dimensions = (horizontal_loop_extent,number_of_land_surface_variables_perturbed) + type = real + kind = kind_phys + intent = inout + optional = F [lndp_prt_list] - standard_name =magnitude_of_perturbations_for_landperts + standard_name = magnitude_of_perturbations_for_landperts long_name = magnitude of perturbations for landperts units = variable dimensions = (number_of_land_surface_variables_perturbed) From beeb14e89e12994e74067af84a9cced9474b33ab Mon Sep 17 00:00:00 2001 From: "Joseph.B.Olson" Date: Mon, 14 Dec 2020 22:54:27 +0000 Subject: [PATCH 152/274] Updates to mynn sfc layer: 1) bugfix for init routine, 2) bugfix for using unitialized variable when 100% ice melts or ice develops on a grid with 0% ice, 3) reduced overly liberal range of allowable z/L. --- physics/module_MYNNSFC_wrapper.F90 | 48 ++++++++--- physics/module_MYNNSFC_wrapper.meta | 47 +++++++++- physics/module_sf_mynn.F90 | 127 ++++++++++++++-------------- 3 files changed, 145 insertions(+), 77 deletions(-) diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 7cc64bbcf..e46a17d9a 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -11,10 +11,29 @@ MODULE mynnsfc_wrapper contains - subroutine mynnsfc_wrapper_init() +!! \section arg_table_mynnsfc_wrapper_init Argument Table +!! \htmlinclude mynnsfc_wrapper_init.html - ! initialize tables for psih and psim (stable and unstable) - CALL PSI_INIT(psi_opt) +!! + subroutine mynnsfc_wrapper_init(errmsg, errflg) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! initialize tables for psih and psim (stable and unstable) + CALL PSI_INIT(psi_opt,errmsg,errflg) + + IF (debug_code >= 1) THEN + print*,"CHECK INITIALIZATION OF PSI:" + print*,"psim_stab(0-1):",psim_stab(0),psim_stab(1) + print*,"psih_stab(0-1):",psih_stab(0),psih_stab(1) + print*,"psim_unstab(0-1):",psim_unstab(0),psim_unstab(1) + print*,"psih_unstab(0-1):",psih_unstab(0),psih_unstab(1) + ENDIF end subroutine mynnsfc_wrapper_init @@ -30,7 +49,7 @@ end subroutine mynnsfc_wrapper_finalize SUBROUTINE mynnsfc_wrapper_run( & & im,levs, & & itimestep,iter, & - & flag_init,flag_restart,lsm, & + & flag_init,flag_restart,lsm,lsm_ruc,& & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & !intent(in) & redrag,sfc_z0_type, & !intent(in) @@ -54,7 +73,8 @@ SUBROUTINE mynnsfc_wrapper_run( & & fh2_ocn, fh2_lnd, fh2_ice, & !intent(inout) & hflx_ocn, hflx_lnd, hflx_ice, & & qflx_ocn, qflx_lnd, qflx_ice, & - & QSFC, qsfc_ruc, USTM, ZOL, MOL, & + & QSFC, qsfc_lnd_ruc, qsfc_ice_ruc, & + & USTM, ZOL, MOL, & & RMOL, WSPD, ch, HFLX, QFLX, LH, & & FLHC, FLQC, & & U10, V10, TH2, T2, Q2, & @@ -122,7 +142,7 @@ SUBROUTINE mynnsfc_wrapper_run( & !MYNN-1D REAL :: delt INTEGER :: im, levs - INTEGER :: iter, k, i, itimestep, lsm + INTEGER :: iter, k, i, itimestep, lsm, lsm_ruc LOGICAL :: flag_init,flag_restart,lprnt INTEGER :: IDS,IDE,JDS,JDE,KDS,KDE, & & IMS,IME,JMS,JME,KMS,KME, & @@ -160,11 +180,12 @@ SUBROUTINE mynnsfc_wrapper_run( & & qsfc_ocn, qsfc_lnd, qsfc_ice !MYNN-2D - real(kind=kind_phys), dimension(im), intent(in) :: & - & dx, pblh, slmsk, ps + real(kind=kind_phys), dimension(:), intent(in) :: & + & dx, pblh, slmsk, ps, & + & qsfc_lnd_ruc, qsfc_ice_ruc real(kind=kind_phys), dimension(im), intent(inout) :: & - & ustm, hflx, qflx, wspd, qsfc, qsfc_ruc, & + & ustm, hflx, qflx, wspd, qsfc, & & FLHC, FLQC, U10, V10, TH2, T2, Q2, & & CHS2, CQS2, rmol, zol, mol, ch, & & lh, wstar @@ -172,7 +193,7 @@ SUBROUTINE mynnsfc_wrapper_run( & real, dimension(im) :: & & hfx, znt, psim, psih, & & chs, ck, cd, mavail, xland, GZ1OZ0, & - & cpm, qgh, qfx + & cpm, qgh, qfx, qsfc_ruc ! Initialize CCPP error handling variables errmsg = '' @@ -216,6 +237,13 @@ SUBROUTINE mynnsfc_wrapper_run( & where (wet) znt_ocn=znt_ocn*0.01 where (icy) znt_ice=znt_ice*0.01 + ! qsfc ruc + qsfc_ruc = 0.0 + if (lsm==lsm_ruc) then + where (dry) qsfc_ruc = qsfc_lnd_ruc + where (icy) qsfc_ruc = qsfc_ice_ruc + end if + ! if (lprnt) then ! write(0,*)"CALLING SFCLAY_mynn; input:" ! write(0,*)"T:",t3d(1,1),t3d(1,2),t3d(1,3) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 6a410c297..e3e870ff2 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -3,6 +3,28 @@ type = scheme dependencies = machine.F,module_sf_mynn.F90 +######################################################################## +[ccpp-arg-table] + name = mynnsfc_wrapper_init + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = mynnsfc_wrapper_run @@ -63,6 +85,14 @@ type = integer intent = in optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [sigmaf] standard_name = bounded_vegetation_area_fraction long_name = areal fractional cover of green vegetation bounded on the bottom @@ -713,14 +743,23 @@ kind = kind_phys intent = inout optional = F -[qsfc_ruc] - standard_name = water_vapor_mixing_ratio_at_surface - long_name = water vapor mixing ratio at surface +[qsfc_lnd_ruc] + standard_name = water_vapor_mixing_ratio_at_surface_over_land + long_name = water vapor mixing ratio at surface over land units = kg kg-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in + optional = F +[qsfc_ice_ruc] + standard_name = water_vapor_mixing_ratio_at_surface_over_ice + long_name = water vapor mixing ratio at surface over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in optional = F [ustm] standard_name = surface_friction_velocity_drag diff --git a/physics/module_sf_mynn.F90 b/physics/module_sf_mynn.F90 index ebbc3dcf9..0753fa5ee 100644 --- a/physics/module_sf_mynn.F90 +++ b/physics/module_sf_mynn.F90 @@ -109,7 +109,7 @@ MODULE module_sf_mynn REAL, PARAMETER :: COARE_OPT=3.0 ! 3.0 or 3.5 !For debugging purposes: INTEGER, PARAMETER :: debug_code = 0 !0: no extra ouput - !1: some step-by-step output + !1: check input !2: everything - heavy I/O LOGICAL, PARAMETER :: compute_diag = .false. LOGICAL, PARAMETER :: compute_flux = .false. !shouldn't need compute @@ -122,23 +122,6 @@ MODULE module_sf_mynn CONTAINS !------------------------------------------------------------------- -!>\ingroup module_sf_mynn_mod -!> Fill the PSIM and PSIH tables. The subroutine "psi_init" was leveraged from -!! module_sf_sfclayrev.F, leveraging the work from Pedro Jimenez. -!! This subroutine returns a blended form from Dyer and Hicks (1974) -!! and Grachev et al (2000) for unstable conditions and the form -!! from Cheng and Brutsaert (2005) for stable conditions. - - SUBROUTINE mynn_sf_init_driver(allowed_to_read,psi_opt) - - LOGICAL, INTENT(in) :: allowed_to_read - INTEGER, INTENT(IN) :: psi_opt - - !CALL psi_init - CALL psi_init(psi_opt) - - END SUBROUTINE mynn_sf_init_driver - !------------------------------------------------------------------- !>\ingroup module_sf_mynn_mod !! This subroutine @@ -149,7 +132,7 @@ SUBROUTINE SFCLAY_mynn( & CP,G,ROVCP,R,XLV, & !in SVP1,SVP2,SVP3,SVPT0,EP1,EP2,KARMAN, & !in ISFFLX,isftcflx,lsm,iz0tlnd,psi_opt, & !in - & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) + & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & !intent(in) & redrag,sfc_z0_type, & !intent(in) itimestep,iter, & !in @@ -545,6 +528,7 @@ SUBROUTINE SFCLAY1D_mynn( & REAL, PARAMETER :: XKA=2.4E-5 !molecular diffusivity REAL, PARAMETER :: PRT=1. !prandlt number + REAL, PARAMETER :: snowh_thresh = 50. !mm REAL, INTENT(IN) :: SVP1,SVP2,SVP3,SVPT0,EP1,EP2 REAL, INTENT(IN) :: KARMAN,CP,G,ROVCP,R,XLV !,DX @@ -678,11 +662,11 @@ SUBROUTINE SFCLAY1D_mynn( & IF (debug_code >= 1) THEN write(0,*)"ITIMESTEP=",ITIMESTEP," iter=",iter DO I=its,ite - write(0,*)"=== imortant input to mynnsfclayer, i:", i + write(0,*)"=== important input to mynnsfclayer, i:", i IF (dry(i)) THEN write(0,*)"dry=",dry(i)," pblh=",pblh(i)," tsk=", tskin_lnd(i),& " tsurf=", tsurf_lnd(i)," qsfc=", qsfc_lnd(i)," znt=", znt_lnd(i),& - " ust=", ust_lnd(i)," snowh=", snowh_lnd(i),"psfcpa=",PSFCPA(i), & + " ust=", ust_lnd(i)," snowh=", snowh_lnd(i)," psfcpa=",PSFCPA(i), & " dz=",dz8w1d(i)," qflx=",qflx(i)," hflx=",hflx(i)," hpbl=",pblh(i) ENDIF IF (icy(i)) THEN @@ -860,9 +844,9 @@ SUBROUTINE SFCLAY1D_mynn( & IF (wet(i)) THEN DTHVDZ=(THV1D(I)-THVSK_ocn(I)) !-------------------------------------------------------- - ! Calculate the convective velocity scale (WSTAR) and - ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) - ! and Mahrt and Sun (1995, MWR), respectively + ! Calculate the convective velocity scale (WSTAR) and + ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) + ! and Mahrt and Sun (1995, MWR), respectively !------------------------------------------------------- fluxc = max(hfx(i)/RHO1D(i)/cp & & + ep1*THVSK_ocn(I)*qfx(i)/RHO1D(i),0.) @@ -884,23 +868,23 @@ SUBROUTINE SFCLAY1D_mynn( & rb_ocn(I)=MAX(rb_ocn(I),-2.0) rb_ocn(I)=MIN(rb_ocn(I), 2.0) ELSE - rb_ocn(I)=MAX(rb_ocn(I),-10.0) - rb_ocn(I)=MIN(rb_ocn(I), 10.0) + rb_ocn(I)=MAX(rb_ocn(I),-4.0) + rb_ocn(I)=MIN(rb_ocn(I), 4.0) ENDIF ENDIF ! end water point IF (dry(i)) THEN DTHVDZ=(THV1D(I)-THVSK_lnd(I)) !-------------------------------------------------------- - ! Calculate the convective velocity scale (WSTAR) and - ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) - ! and Mahrt and Sun (1995, MWR), respectively + ! Calculate the convective velocity scale (WSTAR) and + ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) + ! and Mahrt and Sun (1995, MWR), respectively !------------------------------------------------------- fluxc = max(hfx(i)/RHO1D(i)/cp & & + ep1*THVSK_lnd(I)*qfx(i)/RHO1D(i),0.) - !WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**onethird - !increase height scale, assuming that the non-local transoport - !from the mass-flux (plume) mixing exceedsd the PBLH. + ! WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**onethird + ! increase height scale, assuming that the non-local transoport + ! from the mass-flux (plume) mixing exceedsd the PBLH. WSTAR(I) = vconvc*(g/TSK_lnd(i)*MIN(1.5*pblh(i),4000.)*fluxc)**onethird !-------------------------------------------------------- ! Mahrt and Sun low-res correction @@ -924,23 +908,23 @@ SUBROUTINE SFCLAY1D_mynn( & rb_lnd(I)=MAX(rb_lnd(I),-2.0) rb_lnd(I)=MIN(rb_lnd(I), 2.0) ELSE - rb_lnd(I)=MAX(rb_lnd(I),-10.0) - rb_lnd(I)=MIN(rb_lnd(I), 10.0) + rb_lnd(I)=MAX(rb_lnd(I),-4.0) + rb_lnd(I)=MIN(rb_lnd(I), 4.0) ENDIF ENDIF ! end land point IF (icy(i)) THEN DTHVDZ=(THV1D(I)-THVSK_ice(I)) !-------------------------------------------------------- - ! Calculate the convective velocity scale (WSTAR) and - ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) - ! and Mahrt and Sun (1995, MWR), respectively + ! Calculate the convective velocity scale (WSTAR) and + ! subgrid-scale velocity (VSGD) following Beljaars (1995, QJRMS) + ! and Mahrt and Sun (1995, MWR), respectively !------------------------------------------------------- fluxc = max(hfx(i)/RHO1D(i)/cp & & + ep1*THVSK_ice(I)*qfx(i)/RHO1D(i),0.) - !WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**onethird - !increase height scale, assuming that the non-local transport - !from the mass-flux (plume) mixing exceedsd the PBLH. + ! WSTAR(I) = vconvc*(g/TSK(i)*pblh(i)*fluxc)**onethird + ! increase height scale, assuming that the non-local transport + ! from the mass-flux (plume) mixing exceedsd the PBLH. WSTAR(I) = vconvc*(g/TSK_ice(i)*MIN(1.5*pblh(i),4000.)*fluxc)**onethird !-------------------------------------------------------- ! Mahrt and Sun low-res correction @@ -958,16 +942,16 @@ SUBROUTINE SFCLAY1D_mynn( & rb_ice(I)=MAX(rb_ice(I),-2.0) rb_ice(I)=MIN(rb_ice(I), 2.0) ELSE - rb_ice(I)=MAX(rb_ice(I),-10.0) - rb_ice(I)=MIN(rb_ice(I), 10.0) + rb_ice(I)=MAX(rb_ice(I),-4.0) + rb_ice(I)=MIN(rb_ice(I), 4.0) ENDIF - ENDIF ! end ice point + ENDIF ! end ice point !NOW CONDENSE THE POSSIBLE WSPD VALUES BY TAKING THE MAXIMUM WSPD(I) = MAX(WSPD_ice,WSPD_ocn) WSPD(I) = MAX(WSPD_lnd,WSPD(I)) - IF (debug_code >= 1) THEN + IF (debug_code == 2) THEN write(*,*)"===== After rb calc in mynn sfc layer:" write(*,*)"ITIMESTEP=",ITIMESTEP write(*,*)"WSPD=", WSPD(I)," WSTAR=", WSTAR(I)," vsgd=",vsgd @@ -1006,7 +990,7 @@ SUBROUTINE SFCLAY1D_mynn( & if (sfc_z0_type >= 0) then ! Avoid calculation is using wave model ! CALCULATE z0 (znt) !-------------------------------------- - IF (debug_code >= 1) THEN + IF (debug_code == 2) THEN write(*,*)"=============Input to ZNT over water:" write(*,*)"u*:",UST_ocn(i)," wspd=",WSPD(i)," visc=",visc," za=",ZA(I) ENDIF @@ -1046,7 +1030,7 @@ SUBROUTINE SFCLAY1D_mynn( & ZNTstoch_ocn(I) = ZNT_ocn(I) endif - IF (debug_code >= 1) THEN + IF (debug_code > 1) THEN write(*,*)"==========Output ZNT over water:" write(*,*)"ZNT:",ZNTstoch_ocn(i) ENDIF @@ -1060,7 +1044,7 @@ SUBROUTINE SFCLAY1D_mynn( & !-------------------------------------- !CALCULATE z_t and z_q !-------------------------------------- - IF (debug_code >= 1) THEN + IF (debug_code > 1) THEN write(*,*)"=============Input to ZT over water:" write(*,*)"u*:",UST_ocn(i)," restar=",restar," visc=",visc ENDIF @@ -1108,7 +1092,7 @@ SUBROUTINE SFCLAY1D_mynn( & rstoch1D(i),spp_pbl) ENDIF ENDIF - IF (debug_code >= 1) THEN + IF (debug_code > 1) THEN write(*,*)"=============Output ZT & ZQ over water:" write(*,*)"ZT:",ZT_ocn(i)," ZQ:",ZQ_ocn(i) ENDIF @@ -1180,7 +1164,7 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF !end land point - IF (icy(I) .OR. snowh_lnd(i) > 50.) THEN + IF (icy(I)) THEN ! add stochastic perturbaction of ZNT if (spp_pbl==1) then @@ -1248,7 +1232,7 @@ SUBROUTINE SFCLAY1D_mynn( & !Use brute-force method zol(I)=zolrib(rb_ocn(I),ZA(I),ZNTstoch_ocn(I),zt_ocn(I),GZ1OZ0_ocn(I),GZ1OZt_ocn(I),ZOL(I),psi_opt) ZOL(I)=MAX(ZOL(I),0.0) - ZOL(I)=MIN(ZOL(I),50.) + ZOL(I)=MIN(ZOL(I),20.) zolzt = zol(I)*zt_ocn(I)/ZA(I) ! zt/L zolz0 = zol(I)*ZNTstoch_ocn(I)/ZA(I) ! z0/L @@ -1363,7 +1347,7 @@ SUBROUTINE SFCLAY1D_mynn( & CALL Li_etal_2010(ZOL(I),rb_lnd(I),ZA(I)/ZNTstoch_lnd(I),zratio_lnd(I)) !ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_lnd(I)*UST_lnd(I),0.0001)) ZOL(I)=MAX(ZOL(I),0.0) - ZOL(I)=MIN(ZOL(I),50.) + ZOL(I)=MIN(ZOL(I),20.) IF (debug_code >= 1) THEN IF (ZNTstoch_lnd(i) < 1E-8 .OR. Zt_lnd(i) < 1E-10) THEN @@ -1381,7 +1365,7 @@ SUBROUTINE SFCLAY1D_mynn( & !Use brute-force method zol(I)=zolrib(rb_lnd(I),ZA(I),ZNTstoch_lnd(I),zt_lnd(I),GZ1OZ0_lnd(I),GZ1OZt_lnd(I),ZOL(I),psi_opt) ZOL(I)=MAX(ZOL(I),0.0) - ZOL(I)=MIN(ZOL(I),50.) + ZOL(I)=MIN(ZOL(I),20.) zolzt = zol(I)*zt_lnd(I)/ZA(I) ! zt/L zolz0 = zol(I)*ZNTstoch_lnd(I)/ZA(I) ! z0/L @@ -1494,7 +1478,7 @@ SUBROUTINE SFCLAY1D_mynn( & CALL Li_etal_2010(ZOL(I),rb_ice(I),ZA(I)/ZNTstoch_ice(I),zratio_ice(I)) !ZOL(I)=ZA(I)*KARMAN*G*MOL(I)/(TH1D(I)*MAX(UST_ice(I)*UST_ice(I),0.0001)) ZOL(I)=MAX(ZOL(I),0.0) - ZOL(I)=MIN(ZOL(I),50.) + ZOL(I)=MIN(ZOL(I),20.) IF (debug_code >= 1) THEN IF (ZNTstoch_ice(i) < 1E-8 .OR. Zt_ice(i) < 1E-10) THEN @@ -1512,7 +1496,7 @@ SUBROUTINE SFCLAY1D_mynn( & !Use brute-force method zol(I)=zolrib(rb_ice(I),ZA(I),ZNTstoch_ice(I),zt_ice(I),GZ1OZ0_ice(I),GZ1OZt_ice(I),ZOL(I),psi_opt) ZOL(I)=MAX(ZOL(I),0.0) - ZOL(I)=MIN(ZOL(I),50.) + ZOL(I)=MIN(ZOL(I),20.) zolzt = zol(I)*zt_ice(I)/ZA(I) ! zt/L zolz0 = zol(I)*ZNTstoch_ice(I)/ZA(I) ! z0/L @@ -1634,6 +1618,8 @@ SUBROUTINE SFCLAY1D_mynn( & WSPDI(I)=MAX(SQRT(U1D(I)*U1D(I)+V1D(I)*V1D(I)), wmin) USTM(I)=0.5*USTM(I)+0.5*KARMAN*WSPDI(I)/PSIX_ocn(I) + ! for possible future changes in sea-ice fraction from 0 to >0: + if (.not. icy(i)) ust_ice(i)=ust_ocn(i) ENDIF ! end water points IF (dry(I)) THEN @@ -1666,6 +1652,9 @@ SUBROUTINE SFCLAY1D_mynn( & !Set ustm = ust over ice. USTM(I)=UST_ice(I) + + ! for possible future changes in sea-ice fraction from 1 to <1: + if (.not. wet(i)) ust_ocn(i)=ust_ice(i) ENDIF ! end ice points !---------------------------------------------------- @@ -1888,7 +1877,7 @@ SUBROUTINE SFCLAY1D_mynn( & ENDIF - IF (debug_code >= 1) THEN + IF (debug_code > 1) THEN write(*,*)"QFX=",QFX(I),"FLQC=",FLQC(I) if(icy(i))write(*,*)"ice, MAVAIL:",MAVAIL(I)," u*=",UST_ice(I)," psiq=",PSIQ_ice(i) if(dry(i))write(*,*)"lnd, MAVAIL:",MAVAIL(I)," u*=",UST_lnd(I)," psiq=",PSIQ_lnd(i) @@ -3235,7 +3224,7 @@ REAL function zolri(ri,za,z0,zt,zol1,psi_opt) ! This iterative algorithm was taken from the revised surface layer ! scheme in WRF-ARW, written by Pedro Jimenez and Jimy Dudhia and ! summarized in Jimenez et al. (2012, MWR). This function was adapted - ! to input the thermal roughness length, zt, (as well as z0) and use initial + ! to input the thermal roughness length, zt, (as well as z0) and use initial ! estimate of z/L. IMPLICIT NONE @@ -3403,10 +3392,12 @@ REAL function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt) end function !==================================================================== - SUBROUTINE psi_init(psi_opt) + SUBROUTINE psi_init(psi_opt,errmsg,errflg) - INTEGER :: N,psi_opt - REAL :: zolf + integer :: N,psi_opt + real :: zolf + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg if (psi_opt == 0) then DO N=0,1000 @@ -3434,6 +3425,16 @@ SUBROUTINE psi_init(psi_opt) ENDDO endif + !Simple test to see if initialization worked: + if (psim_stab(1) < 0. .AND. psih_stab(1) < 0. .AND. & + psim_unstab(1) > 0. .AND. psih_unstab(1) > 0.) then + errmsg = 'In MYNN SFC, Psi tables have been initialized' + errflg = 0 + else + errmsg = 'Error in MYNN SFC: Problem initializing psi tables' + errflg = 1 + endif + END SUBROUTINE psi_init ! ================================================================== ! ... integrated similarity functions from MYNN... @@ -3558,7 +3559,7 @@ REAL function psim_stable(zolf,psi_opt) nzol = int(zolf*100.) rzol = zolf*100. - nzol - if(nzol+1 .le. 1000)then + if(nzol+1 .lt. 1000)then psim_stable = psim_stab(nzol) + rzol*(psim_stab(nzol+1)-psim_stab(nzol)) else if (psi_opt == 0) then @@ -3577,7 +3578,7 @@ REAL function psih_stable(zolf,psi_opt) nzol = int(zolf*100.) rzol = zolf*100. - nzol - if(nzol+1 .le. 1000)then + if(nzol+1 .lt. 1000)then psih_stable = psih_stab(nzol) + rzol*(psih_stab(nzol+1)-psih_stab(nzol)) else if (psi_opt == 0) then @@ -3596,7 +3597,7 @@ REAL function psim_unstable(zolf,psi_opt) nzol = int(-zolf*100.) rzol = -zolf*100. - nzol - if(nzol+1 .le. 1000)then + if(nzol+1 .lt. 1000)then psim_unstable = psim_unstab(nzol) + rzol*(psim_unstab(nzol+1)-psim_unstab(nzol)) else if (psi_opt == 0) then @@ -3615,7 +3616,7 @@ REAL function psih_unstable(zolf,psi_opt) nzol = int(-zolf*100.) rzol = -zolf*100. - nzol - if(nzol+1 .le. 1000)then + if(nzol+1 .lt. 1000)then psih_unstable = psih_unstab(nzol) + rzol*(psih_unstab(nzol+1)-psih_unstab(nzol)) else if (psi_opt == 0) then From e63083120496aa9329285aa91129a8689edaf515 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Tue, 15 Dec 2020 16:42:55 +0000 Subject: [PATCH 153/274] Minor bug fixes to unified_ugwp.F90 and drag_suite.F90 --- physics/drag_suite.F90 | 2 +- physics/unified_ugwp.F90 | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index eaa1366a8..2e68ceb12 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -1260,7 +1260,7 @@ subroutine drag_suite_run( & eng1 = 0.5*( (rcs*(u1(i,k)+(dtaux+dtauxb)*deltim))**2 + & (rcs*(v1(i,k)+(dtauy+dtauyb)*deltim))**2 ) ! Modify theta tendency - dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim/prslk(i,k) + dtdt(i,k) = dtdt(i,k) + max((eng0-eng1),0.0)/cp/deltim end if dusfc(i) = dusfc(i) + taud_ls(i,k)*xn(i)*del(i,k) + taud_bl(i,k)*xn(i)*del(i,k) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index fda887f3e..5c0604f86 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -244,7 +244,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, integer, intent(in) :: gwd_opt integer, intent(in), dimension(im) :: kpbl real(kind=kind_phys), intent(in), dimension(im) :: oro, oro_uf, hprime, oc, theta, sigma, gamma - real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss,oa4ss,ol4ss,dx + real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss,dx + real(kind=kind_phys), intent(in), dimension(im,4) :: oa4ss,ol4ss logical, intent(in) :: flag_for_gwd_generic_tend ! elvmax is intent(in) for CIRES UGWP, but intent(inout) for GFS GWDPS real(kind=kind_phys), intent(inout), dimension(im) :: elvmax From ea5e44fcc691c9a5fedcb96f13e0ca85259c7844 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 16 Dec 2020 15:51:33 +0000 Subject: [PATCH 154/274] Updated rte submodule --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 37313e512087fc47f51bf12375e724c80fa3c18c Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 16 Dec 2020 17:26:38 +0000 Subject: [PATCH 155/274] Changes from code review --- physics/GFS_rrtmgp_cloud_overlap_pre.F90 | 4 ++-- physics/GFS_rrtmgp_pre.F90 | 14 ++++++------- physics/GFS_rrtmgp_pre.meta | 26 ++++++++++++------------ physics/GFS_rrtmgp_thompsonmp_pre.F90 | 11 +++++----- physics/GFS_rrtmgp_thompsonmp_pre.meta | 10 ++++----- physics/rrtmgp_lw_cloud_optics.F90 | 2 +- physics/rrtmgp_lw_cloud_optics.meta | 2 +- physics/rrtmgp_sw_cloud_optics.F90 | 2 +- 8 files changed, 35 insertions(+), 36 deletions(-) diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 index 08bc82d05..05b8ee79e 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -78,12 +78,12 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra real(kind_phys), dimension(nCol,nLev) :: deltaZ logical :: top_at_1 - if (.not. (doSWrad .or. doLWrad)) return - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + if (.not. (doSWrad .or. doLWrad)) return + ! What is vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 25f65567a..73828999f 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -189,24 +189,24 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - real(kind_phys), intent(out) :: & + real(kind_phys), intent(inout) :: & raddt ! Radiation time-step - real(kind_phys), dimension(ncol), intent(out) :: & + real(kind_phys), dimension(ncol), intent(inout) :: & tsfg, & ! Ground temperature tsfa ! Skin temperature - real(kind_phys), dimension(nCol,nLev), intent(out) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & p_lay, & ! Pressure at model-layer t_lay, & ! Temperature at model layer q_lay, & ! Water-vapor mixing ratio (kg/kg) tv_lay, & ! Virtual temperature at model-layers relhum, & ! Relative-humidity at model-layers - qs_lay ! Saturation vapor pressure at model-layers - real(kind_phys), dimension(nCol,nLev+1), intent(out) :: & + qs_lay ! Saturation vapor pressure at model-layers + real(kind_phys), dimension(nCol,nLev+1), intent(inout) :: & p_lev, & ! Pressure at model-interface t_lev ! Temperature at model-interface - real(kind_phys), dimension(nCol, nLev, nTracers),intent(out) :: & + real(kind_phys), dimension(nCol, nLev, nTracers),intent(inout) :: & tracer ! Array containing trace gases - type(ty_gas_concs),intent(out) :: & + type(ty_gas_concs),intent(inout) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios ! Local variables diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 136898bb3..d07f9c137 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -262,7 +262,7 @@ dimensions = () type = real kind = kind_phys - intent = out + intent = inout optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa @@ -271,7 +271,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [p_lev] standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa @@ -280,7 +280,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP @@ -289,7 +289,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [t_lev] standard_name = air_temperature_at_interface_for_RRTMGP @@ -298,7 +298,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys - intent = out + intent = inout optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation @@ -307,7 +307,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [tsfa] standard_name = surface_air_temperature_for_radiation @@ -316,7 +316,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = inout optional = F [tv_lay] standard_name = virtual_temperature @@ -325,7 +325,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [relhum] standard_name = relative_humidity @@ -334,7 +334,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [qs_lay] standard_name = saturation_vapor_pressure @@ -343,7 +343,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [q_lay] standard_name = water_vapor_mixing_ratio @@ -352,7 +352,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [tracer] standard_name = chemical_tracers @@ -361,7 +361,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys - intent = out + intent = inout optional = F [gas_concentrations] standard_name = Gas_concentrations_for_RRTMGP_suite @@ -369,7 +369,7 @@ units = DDT dimensions = () type = ty_gas_concs - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index bd109ddf4..ea27f3d2b 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -95,17 +95,16 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do cld_reliq, & ! Cloud liquid effective radius cld_iwp, & ! Cloud ice water path cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain, & ! Cloud rain effective radius + precip_frac, & ! Precipitation fraction effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) effrin_cldice, & ! Effective radius for ice cloud-particles (microns) effrin_cldsnow ! Effective radius for snow cloud-particles (microns) ! Outputs - real(kind_phys), dimension(nCol,nLev),intent(out) :: & - cld_swp, & ! Cloud snow water path - cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path - cld_rerain, & ! Cloud rain effective radius - precip_frac ! Precipitation fraction character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index 2368a7337..90ec59760 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -385,7 +385,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_resnow] standard_name = mean_effective_radius_for_snow_flake @@ -394,7 +394,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rwp] standard_name = cloud_rain_water_path @@ -403,7 +403,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rerain] standard_name = mean_effective_radius_for_rain_drop @@ -412,7 +412,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [precip_frac] standard_name = precipitation_fraction_by_layer @@ -421,7 +421,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 023df62ec..341c19fc2 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -323,7 +323,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw type(ty_optical_props_2str),intent(inout) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) - real(kind_phys), dimension(ncol,nLev), intent(out) :: & + real(kind_phys), dimension(ncol,nLev), intent(inout) :: & cldtaulw ! Approx 10.mu band layer cloud optical depth ! Local variables diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index cf0418eb4..c57e70a33 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -322,7 +322,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [lw_optical_props_cloudsByBand] standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 92f007a99..f08cd7181 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -281,7 +281,7 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, c0r = (/0.980, 0.975, 0.965, 0.960, 0.955, 0.952, 0.950, & 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & - 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) + 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) end subroutine rrtmgp_sw_cloud_optics_init From ea6858b0c75fe662f4a233220acb0c3c79a942a5 Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Wed, 16 Dec 2020 22:24:09 +0000 Subject: [PATCH 156/274] Added Apache license statement in README.md --- README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/README.md b/README.md index c1964c445..9000afccc 100644 --- a/README.md +++ b/README.md @@ -15,4 +15,6 @@ For the use of CCPP with its Single Column Model, see the [Single Column Model U For the use of CCPP with NOAA's Unified Forecast System (UFS), see the [UFS Medium-Range Application User's Guide](https://ufs-mrweather-app.readthedocs.io/en/latest/) and the [UFS Weather Model User's Guide](https://ufs-weather-model.readthedocs.io/en/latest/). +The Apache license will be in effect unless superseded by an existing license in specific files. + Questions can be directed to the [CCPP Help Desk](mailto:gmtb-help@ucar.edu). When using the CCPP with NOAA's UFS, questions can be posted in the [UFS Weather Model](https://forums.ufscommunity.org/forum/ufs-weather-model) section of the [UFS Forum](https://forums.ufscommunity.org/) From e1e8c3f3a1717273d52cdeda41063c4d24b7c7fc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 17 Dec 2020 20:17:27 -0700 Subject: [PATCH 157/274] Move time vary physics from run to timestep_init and remove dependency on GFS DDTs --- physics/GFS_debug.F90 | 6 - physics/GFS_phys_time_vary.fv3.F90 | 655 +++++++------- physics/GFS_phys_time_vary.fv3.meta | 1275 ++++++++++++++++++++++++++- physics/GFS_rad_time_vary.fv3.F90 | 102 +-- physics/GFS_rad_time_vary.fv3.meta | 216 ++++- physics/GFS_rrtmg_setup.F90 | 14 +- physics/GFS_rrtmg_setup.meta | 2 +- physics/GFS_suite_interstitial.F90 | 43 +- physics/GFS_suite_interstitial.meta | 16 + physics/GFS_time_vary_pre.fv3.F90 | 17 +- physics/GFS_time_vary_pre.fv3.meta | 2 +- physics/gcycle.F90 | 411 ++++----- physics/h2o_def.f | 5 + physics/h2o_def.meta | 29 + physics/ozne_def.f | 5 + physics/ozne_def.meta | 29 + 16 files changed, 2110 insertions(+), 717 deletions(-) create mode 100644 physics/h2o_def.meta create mode 100644 physics/ozne_def.meta diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 35b44ca0e..86e175970 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -915,14 +915,10 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup do iomp=0,ompsize-1 if (mpirank==impi .and. omprank==iomp) then ! Print static variables - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%h2o_coeff ', Interstitial%h2o_coeff ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%h2o_pres ', Interstitial%h2o_pres ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ipr ', Interstitial%ipr ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%itc ', Interstitial%itc ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%latidxprnt ', Interstitial%latidxprnt ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levi ', Interstitial%levi ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levh2o ', Interstitial%levh2o ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%levozp ', Interstitial%levozp ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmk ', Interstitial%lmk ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%lmp ', Interstitial%lmp ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nbdlw ', Interstitial%nbdlw ) @@ -934,8 +930,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nspc1 ', Interstitial%nspc1 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ntiwx ', Interstitial%ntiwx ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%nvdiff ', Interstitial%nvdiff ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%oz_coeff ', Interstitial%oz_coeff ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'sum(Interstitial%oz_pres) ', Interstitial%oz_pres ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%phys_hydrostatic ', Interstitial%phys_hydrostatic ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%skip_macro ', Interstitial%skip_macro ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%trans_aero ', Interstitial%trans_aero ) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 3c894b777..4043b9090 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -11,6 +11,10 @@ module GFS_phys_time_vary use omp_lib #endif + use machine, only : kind_phys + + use mersenne_twister, only: random_setseed, random_number + use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin use ozinterp, only : read_o3data, setindxoz, ozinterpol @@ -23,6 +27,8 @@ module GFS_phys_time_vary use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol + use gcycle_mod, only : gcycle + #if 0 !--- variables needed for calculating 'sncovr' use namelist_soilveg, only: salp_data, snupx @@ -32,10 +38,14 @@ module GFS_phys_time_vary private - public GFS_phys_time_vary_init, GFS_phys_time_vary_run, GFS_phys_time_vary_finalize + public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_timestep_finalize, GFS_phys_time_vary_finalize logical :: is_initialized = .false. + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + contains !> \section arg_table_GFS_phys_time_vary_init Argument Table @@ -43,236 +53,389 @@ module GFS_phys_time_vary !! !>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm !! @{ - subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_data_type, GFS_interstitial_type + subroutine GFS_phys_time_vary_init ( & + me, master, ntoz, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & + jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & + nthrds, errmsg, errflg) implicit none ! Interface variables - type(GFS_data_type), intent(inout) :: Data(:) - type(GFS_control_type), intent(inout) :: Model - type(GFS_interstitial_type), intent(inout) :: Interstitial(:) - integer, intent(in) :: nthrds - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny + logical, intent(in) :: h2o_phys, iaerclm + integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) + + integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) + real(kind_phys), intent(in) :: aer_nm(:,:,:) + integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) + integer, intent(inout) :: imap(:), jmap(:) + + integer, intent(in) :: nthrds + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables - integer :: nb, nblks, nt integer :: i, j, ix - logical :: non_uniform_blocks + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (is_initialized) return - nblks = size(Model%blksz) - - ! Non-uniform blocks require special handling: instead - ! of nthrds elements of the Interstitial array, there are - ! nthrds+1 elements. The extra Interstitial(nthrds+1) is - ! allocated for the smaller block length of the last block, - ! while all other elements are allocated to the maximum - ! block length (which is the same for all blocks except - ! the last block). - if (minval(Model%blksz)==maxval(Model%blksz)) then - non_uniform_blocks = .false. - else - non_uniform_blocks = .true. - end if - - ! Consistency check - number of threads passed in via the argument list - ! has to match the size of the Interstitial data type. - if (.not. non_uniform_blocks .and. nthrds/=size(Interstitial)) then - write(errmsg,'(*(a))') 'Logic error: nthrds does not match size of Interstitial variable' - errflg = 1 - return - else if (non_uniform_blocks .and. nthrds+1/=size(Interstitial)) then - write(errmsg,'(*(a))') 'Logic error: nthrds+1 does not match size of Interstitial variable ' // & - '(including extra last element for shorter blocksizes)' - errflg = 1 - return - end if - -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nt,nb) & -!$OMP shared (Model,Data,Interstitial,errmsg,errflg) & -!$OMP shared (levozp,oz_coeff,oz_pres) & -!$OMP shared (levh2o,h2o_coeff,h2o_pres) & -!$OMP shared (ntrcaer,nblks,nthrds,non_uniform_blocks) - -#ifdef OPENMP - nt = omp_get_thread_num()+1 -#else - nt = 1 -#endif +!$OMP parallel num_threads(nthrds) default(none) & +!$OMP shared (me,master,ntoz,h2o_phys,im) & +!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & +!$OMP shared (levozp,oz_coeff,oz_pres,ozpl) & +!$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & +!$OMP shared (iaerclm,ntrcaer,aer_nm,iflip,iccn) & +!$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & +!$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & +!$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & +!$OMP private (ix,i,j) !$OMP sections !$OMP section !> - Call read_o3data() to read ozone data - call read_o3data (Model%ntoz, Model%me, Model%master) + call read_o3data (ntoz, me, master) ! Consistency check that the hardcoded values for levozp and ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data - ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(Data(1)%Tbd%ozpl, dim=2).ne.levozp) then + ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) + if (size(ozpl, dim=2).ne.levozp) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(Data(1)%Tbd%ozpl, dim=2) + levozp, " /= ", size(ozpl, dim=2) errflg = 1 end if - if (size(Data(1)%Tbd%ozpl, dim=3).ne.oz_coeff) then + if (size(ozpl, dim=3).ne.oz_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(Data(1)%Tbd%ozpl, dim=3) + oz_coeff, " /= ", size(ozpl, dim=3) errflg = 1 end if !$OMP section !> - Call read_h2odata() to read stratospheric water vapor data - call read_h2odata (Model%h2o_phys, Model%me, Model%master) + call read_h2odata (h2o_phys, me, master) ! Consistency check that the hardcoded values for levh2o and ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(Data(1)%Tbd%h2opl, dim=2).ne.levh2o) then + if (size(h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(Data(1)%Tbd%h2opl, dim=2) + levh2o, " /= ", size(h2opl, dim=2) errflg = 1 end if - if (size(Data(1)%Tbd%h2opl, dim=3).ne.h2o_coeff) then + if (size(h2opl, dim=3).ne.h2o_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(Data(1)%Tbd%h2opl, dim=3) + h2o_coeff, " /= ", size(h2opl, dim=3) errflg = 1 end if !$OMP section !> - Call read_aerdata() to read aerosol climatology - if (Model%iaerclm) then + if (iaerclm) then ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 - ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def - if (size(Data(1)%Tbd%aer_nm, dim=3).ne.ntrcaerm) then + ! and used to allocate aer_nm matches the value defined in aerclm_def + if (size(aer_nm, dim=3).ne.ntrcaerm) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & - ntrcaerm, " /= ", size(Data(1)%Tbd%aer_nm, dim=3) + ntrcaerm, " /= ", size(aer_nm, dim=3) errflg = 1 else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm - ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) + ! If iaerclm is .true., then ntrcaer == ntrcaerm + ntrcaer = size(aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) + call read_aerdata (me,master,iflip,idate,errmsg,errflg) endif else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%iaerclm is .false., then ntrcaer == 1 - ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) + ! If iaerclm is .false., then ntrcaer == 1 + ntrcaer = size(aer_nm, dim=3) endif !$OMP section !> - Call read_cidata() to read IN and CCN data - if (Model%iccn == 1) then - call read_cidata ( Model%me, Model%master) + if (iccn == 1) then + call read_cidata (me,master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif -!$OMP end sections - - ! Update values of oz_pres in Interstitial data type for all threads - if (Model%ntoz > 0) then - Interstitial(nt)%oz_pres = oz_pres -!$OMP single - if (non_uniform_blocks) then - ! For non-uniform block sizes, set Interstitial(nthrds+1)%oz_pres - Interstitial(nthrds+1)%oz_pres = oz_pres - end if -!$OMP end single nowait - end if - - ! Update values of h2o_pres in Interstitial data type for all threads - if (Model%h2o_phys) then - Interstitial(nt)%h2o_pres = h2o_pres -!$OMP single - if (non_uniform_blocks) then - ! For non-uniform block sizes, set Interstitial(nthrds+1)%oz_pres - Interstitial(nthrds+1)%h2o_pres = h2o_pres - end if -!$OMP end single nowait - end if - +!$OMP barrier +!$OMP section !> - Call setindxoz() to initialize ozone data - if (Model%ntoz > 0) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call setindxoz (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_o3, & - Data(nb)%Grid%jindx2_o3, Data(nb)%Grid%ddy_o3) - enddo -!$OMP end do + if (ntoz > 0) then + call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif +!$OMP section !> - Call setindxh2o() to initialize stratospheric water vapor data - if (Model%h2o_phys) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call setindxh2o (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_h, & - Data(nb)%Grid%jindx2_h, Data(nb)%Grid%ddy_h) - enddo -!$OMP end do + if (h2o_phys) then + call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif +!$OMP section !> - Call setindxaer() to initialize aerosols data - if (Model%iaerclm) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call setindxaer (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_aer, & - Data(nb)%Grid%jindx2_aer, Data(nb)%Grid%ddy_aer, Data(nb)%Grid%xlon_d, & - Data(nb)%Grid%iindx1_aer, Data(nb)%Grid%iindx2_aer, Data(nb)%Grid%ddx_aer, & - Model%me, Model%master) - enddo -!$OMP end do + if (iaerclm) then + call setindxaer (im, xlat_d, jindx1_aer, & + jindx2_aer, ddy_aer, xlon_d, & + iindx1_aer, iindx2_aer, ddx_aer, & + me, master) endif +!$OMP section !> - Call setindxci() to initialize IN and CCN data - if (Model%iccn == 1) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call setindxci (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_ci, & - Data(nb)%Grid%jindx2_ci, Data(nb)%Grid%ddy_ci, Data(nb)%Grid%xlon_d, & - Data(nb)%Grid%iindx1_ci, Data(nb)%Grid%iindx2_ci, Data(nb)%Grid%ddx_ci) - enddo -!$OMP end do + if (iccn == 1) then + call setindxci (im, xlat_d, jindx1_ci, & + jindx2_ci, ddy_ci, xlon_d, & + iindx1_ci, iindx2_ci, ddx_ci) endif -!$OMP end parallel - - !--- initial calculation of maps local ix -> global i and j, store in Tbd +!$OMP section + !--- initial calculation of maps local ix -> global i and j ix = 0 - nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx + do j = 1,ny + do i = 1,nx ix = ix + 1 - if (ix > Model%blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - Data(nb)%Tbd%jmap(ix) = j - Data(nb)%Tbd%imap(ix) = i + jmap(ix) = j + imap(ix) = i enddo enddo +!$OMP end sections + +!$OMP end parallel + +#if 0 + !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) + if (first_time_step) then + if (nint(Data(1)%Sfcprop%sncovr(1)) == -9999) then + !--- compute sncovr from existing variables + !--- code taken directly from read_fix.f + do nb = 1, nblks + do ix = 1, Model%blksz(nb) + Data(nb)%Sfcprop%sncovr(ix) = 0.0 + if (Data(nb)%Sfcprop%slmsk(ix) > 0.001) then + vegtyp = Data(nb)%Sfcprop%vtype(ix) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001*Data(nb)%Sfcprop%weasd(ix)/snupx(vegtyp) + if (0.001*Data(nb)%Sfcprop%weasd(ix) < snupx(vegtyp)) then + Data(nb)%Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + Data(nb)%Sfcprop%sncovr(ix) = 1.0 + endif + endif + enddo + enddo + endif + endif +#endif + is_initialized = .true. end subroutine GFS_phys_time_vary_init !! @} +!> \section arg_table_GFS_phys_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_phys_time_vary_timestep_init.html +!! +!>\section gen_GFS_phys_time_vary_timestep_init GFS_phys_time_vary_timestep_init General Algorithm +!! @{ + subroutine GFS_phys_time_vary_timestep_init ( & + me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & + imfdeepcnv, cal_pre, random_clds, nscyc, ntoz, h2o_phys, iaerclm, iccn, clstp, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & + jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & + imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, kice, & + ialb, isot, ivegsrc, input_nml_file, use_ufo, nst_anl, frac_grid, fhcyc, phour, & + lakefrac, min_seaice, min_lakeice, smc, slc, stc, tiice, tg3, tref, tsfc, tsfco, tisfc, & + hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, zorlo, weasd, & + slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, errmsg, errflg) + + implicit none + + ! Interface variables + integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & + nsswr, imfdeepcnv, iccn, nscyc, ntoz + integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: fhswr, fhour + logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm + real(kind_phys), intent(out) :: clstp + integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) + real(kind_phys), intent(inout) :: aer_nm(:,:,:) + integer, intent(in) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in) :: ddy_ci(:), ddx_ci(:) + real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) + integer, intent(in) :: imap(:), jmap(:) + real(kind_phys), intent(in) :: prsl(:,:) + integer, intent(in) :: seed0 + real(kind_phys), intent(out) :: rann(:,:) + ! For gcycle only + integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, kice + integer, intent(in) :: ialb, isot, ivegsrc + character(len=*), intent(in) :: input_nml_file(:) + logical, intent(in) :: use_ufo, nst_anl, frac_grid + real(kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice, & + xlat_d(:), xlon_d(:) + ! + real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), tiice(:,:), tg3(:), & + tref(:), tsfc(:), tsfco(:), tisfc(:), hice(:), fice(:), & + facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:), & + zorli(:), zorll(:), zorlo(:), weasd(:), slope(:), snoalb(:), & + canopy(:), vfrac(:), vtype(:), stype(:), shdmin(:), shdmax(:), & + snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) + ! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i, j, k, iseed, iskip, ix + real(kind=kind_phys) :: wrk(1) + real(kind=kind_phys) :: rannie(cny) + real(kind=kind_phys) :: rndval(cnx*cny*nrcm) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Check initialization status + if (.not.is_initialized) then + write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_timestep_init called before GFS_phys_time_vary_init" + errflg = 1 + return + end if + + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(kdt,nsswr) == 0) .and. (lsswr)) then + !--- initialize,accumulate,convert + clstp = 1100 + min(fhswr/con_hr,fhour,con_99) + elseif (mod(kdt,nsswr) == 0) then + !--- accumulate,convert + clstp = 0100 + min(fhswr/con_hr,fhour,con_99) + elseif (lsswr) then + !--- initialize,accumulate + clstp = 1100 + else + !--- accumulate + clstp = 0100 + endif + + !--- random number needed for RAS and old SAS and when cal_pre=.true. + ! imfdeepcnv < 0 when ras = .true. + if ( (imfdeepcnv <= 0 .or. cal_pre) .and. random_clds ) then + + iseed = mod(con_100*sqrt(fhour*con_hr),1.0d9) + seed0 + call random_setseed(iseed) + call random_number(wrk) + do i = 1,cnx*nrcm + iseed = iseed + nint(wrk(1)*1000.0) * i + call random_setseed(iseed) + call random_number(rannie) + rndval(1+(i-1)*cny:i*cny) = rannie(1:cny) + enddo + + do k = 1,nrcm + iskip = (k-1)*cnx*cny + do ix=1,im + j = jmap(ix) + i = imap(ix) + rann(ix,k) = rndval(i+isc-1 + (j+jsc-2)*cnx + iskip) + enddo + enddo + + endif ! imfdeepcnv, cal_re, random_clds + +!> - Call ozinterpol() to make ozone interpolation + if (ntoz > 0) then + call ozinterpol (me, im, idate, fhour, & + jindx1_o3, jindx2_o3, & + ozpl, ddy_o3) + endif + +!> - Call h2ointerpol() to make stratospheric water vapor data interpolation + if (h2o_phys) then + call h2ointerpol (me, im, idate, fhour, & + jindx1_h, jindx2_h, & + h2opl, ddy_h) + endif + +!> - Call aerinterpol() to make aerosol interpolation + if (iaerclm) then + call aerinterpol (me, master, im, idate, fhour, & + jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm) + endif + +!> - Call ciinterpol() to make IN and CCN data interpolation + if (iccn == 1) then + call ciinterpol (me, im, idate, fhour, & + jindx1_ci, jindx2_ci, & + ddy_ci, iindx1_ci, & + iindx2_ci, ddx_ci, & + levs, prsl, in_nm, ccn_nm) + endif + +!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs + if (nscyc > 0) then + if (mod(kdt,nscyc) == 1) THEN + call gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & + input_nml_file, lsoil, kice, idate, ialb, isot, ivegsrc, use_ufo, & + nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, frac_grid, & + smc, slc, stc, tiice, tg3, tref, tsfc, tsfco, tisfc, hice, fice, & + facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, zorlo, weasd,& + slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, imap, jmap) + endif + endif + + end subroutine GFS_phys_time_vary_timestep_init +!! @} + +!> \section arg_table_GFS_phys_time_vary_timestep_finalize Argument Table +!! \htmlinclude GFS_phys_time_vary_timestep_finalize.html +!! +!>\section gen_GFS_phys_time_vary_timestep_finalize GFS_phys_time_vary_timestep_finalize General Algorithm +!! @{ + subroutine GFS_phys_time_vary_timestep_finalize (errmsg, errflg) + + implicit none + + ! Interface variables + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine GFS_phys_time_vary_timestep_finalize +!! @} !> \section arg_table_GFS_phys_time_vary_finalize Argument Table !! \htmlinclude GFS_phys_time_vary_finalize.html @@ -316,215 +479,5 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) end subroutine GFS_phys_time_vary_finalize - -!> \section arg_table_GFS_phys_time_vary_run Argument Table -!! \htmlinclude GFS_phys_time_vary_run.html -!! -!>\section gen_GFS_phys_time_vary_run GFS_phys_time_vary_run General Algorithm -!> @{ - subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, errflg) - - use mersenne_twister, only: random_setseed, random_number - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_data_type - - implicit none - - ! Interface variables - type(GFS_data_type), intent(inout) :: Data(:) - type(GFS_control_type), intent(inout) :: Model - integer, intent(in) :: nthrds - logical, intent(in) :: first_time_step - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - - integer :: i, j, k, iseed, iskip, ix, nb, nblks, kdt_rad, vegtyp - real(kind=kind_phys) :: sec_zero, rsnow - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Check initialization status - if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_run called before GFS_phys_time_vary_init" - errflg = 1 - return - end if - - nblks = size(Model%blksz) - - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif - -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nb,iskip,ix,i,j,k) & -!$OMP shared (Model,Data,iseed,wrk,rannie,rndval) & -!$OMP shared (nblks) - - !--- random number needed for RAS and old SAS and when cal_pre=.true. - ! Model%imfdeepcnv < 0 when Model%ras = .true. - if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then -!$OMP single - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 - call random_setseed(iseed) - call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)*1000.0) * i - call random_setseed(iseed) - call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) - enddo -!$OMP end single - - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny -!$OMP do schedule (dynamic,1) - do nb=1,nblks - do ix=1,Model%blksz(nb) - j = Data(nb)%Tbd%jmap(ix) - i = Data(nb)%Tbd%imap(ix) - Data(nb)%Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) - enddo - enddo -!$OMP end do - enddo - endif ! imfdeepcnv, cal_re, random_clds - -!> - Call ozinterpol() to make ozone interpolation - if (Model%ntoz > 0) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_o3, Data(nb)%Grid%jindx2_o3, & - Data(nb)%Tbd%ozpl, Data(nb)%Grid%ddy_o3) - enddo -!$OMP end do - endif - -!> - Call h2ointerpol() to make stratospheric water vapor data interpolation - if (Model%h2o_phys) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_h, Data(nb)%Grid%jindx2_h, & - Data(nb)%Tbd%h2opl, Data(nb)%Grid%ddy_h) - enddo -!$OMP end do - endif - -!> - Call aerinterpol() to make aerosol interpolation - if (Model%iaerclm) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call aerinterpol (Model%me, Model%master, Model%blksz(nb), & - Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_aer, Data(nb)%Grid%jindx2_aer, & - Data(nb)%Grid%ddy_aer,Data(nb)%Grid%iindx1_aer, & - Data(nb)%Grid%iindx2_aer,Data(nb)%Grid%ddx_aer, & - Model%levs,Data(nb)%Statein%prsl, & - Data(nb)%Tbd%aer_nm) - enddo -!$OMP end do - endif - -!> - Call ciinterpol() to make IN and CCN data interpolation - if (Model%iccn == 1) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_ci, Data(nb)%Grid%jindx2_ci, & - Data(nb)%Grid%ddy_ci,Data(nb)%Grid%iindx1_ci, & - Data(nb)%Grid%iindx2_ci,Data(nb)%Grid%ddx_ci, & - Model%levs,Data(nb)%Statein%prsl, & - Data(nb)%Tbd%in_nm, Data(nb)%Tbd%ccn_nm) - enddo -!$OMP end do - endif - -!$OMP end parallel - -!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs - if (Model%nscyc > 0) then - if (mod(Model%kdt,Model%nscyc) == 1) THEN - call gcycle (nblks, nthrds, Model, Data(:)%Grid, Data(:)%Sfcprop, Data(:)%Cldprop) - endif - endif - - !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%rad_zero (Model) - call Data(nb)%Intdiag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - else - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%rad_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - endif - -#if 0 - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - if (first_time_step) then - if (nint(Data(1)%Sfcprop%sncovr(1)) == -9999) then - !--- compute sncovr from existing variables - !--- code taken directly from read_fix.f - do nb = 1, nblks - do ix = 1, Model%blksz(nb) - Data(nb)%Sfcprop%sncovr(ix) = 0.0 - if (Data(nb)%Sfcprop%slmsk(ix) > 0.001) then - vegtyp = Data(nb)%Sfcprop%vtype(ix) - if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Data(nb)%Sfcprop%weasd(ix)/snupx(vegtyp) - if (0.001*Data(nb)%Sfcprop%weasd(ix) < snupx(vegtyp)) then - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - else - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - endif - endif - enddo - enddo - endif - endif -#endif - - end subroutine GFS_phys_time_vary_run -!> @} - end module GFS_phys_time_vary !> @} diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 72a7ce207..e78a13e4b 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -7,28 +7,304 @@ [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = Fortran DDT containing FV3-GFS data - units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type - intent = inout + +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag dimensions = () - type = GFS_control_type + type = logical + intent = in + optional = F +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none + dimensions = () + type = integer + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = iflip - is not the same as flipv + units = flag + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nx] + standard_name = number_of_points_in_x_direction_for_this_MPI_rank + long_name = number of points in x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[ny] + standard_name = number_of_points_in_y_direction_for_this_MPI_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer intent = inout optional = F -[Interstitial] - standard_name = GFS_interstitial_type_instance_all_threads - long_name = Fortran DDT containing FV3-GFS interstitial data - units = DDT - dimensions = (omp_threads) - type = GFS_interstitial_type +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer intent = inout optional = F [nthrds] @@ -81,24 +357,440 @@ ######################################################################## [ccpp-arg-table] - name = GFS_phys_time_vary_run + name = GFS_phys_time_vary_timestep_init type = scheme -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = Fortran DDT containing FV3-GFS data - units = DDT - dimensions = (ccpp_block_count) - type = GFS_data_type - intent = inout +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[nsswr] + standard_name = number_of_timesteps_between_shortwave_radiation_calls + long_name = number of timesteps between shortwave radiation calls + units = + dimensions = () + type = integer + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[cal_pre] + standard_name = flag_for_precipitation_type_algorithm + long_name = flag controls precip type algorithm + units = flag + dimensions = () + type = logical + intent = in + optional = F +[random_clds] + standard_name = flag_for_random_clouds_for_RAS + long_name = flag for using random clouds with the RAS scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nscyc] + standard_name = number_of_timesteps_between_surface_cycling_calls + long_name = number of timesteps between surface cycling calls + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation + units = flag dimensions = () - type = GFS_control_type + type = logical + intent = in + optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none + dimensions = () + type = integer + intent = in + optional = F +[clstp] + standard_name = convective_cloud_switch + long_name = index used by cnvc90 (for convective clouds) + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys intent = inout optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[in_nm] + standard_name = ice_nucleation_number + long_name = ice nucleation number in MG MP + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ccn_nm] + standard_name = tendency_of_ccn_activated_number + long_name = tendency of ccn activated number + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[seed0] + standard_name = seed_random_numbers_RAS + long_name = random number seed for the RAS scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[rann] + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) + type = real + kind = kind_phys + intent = out + optional = F [nthrds] standard_name = omp_threads long_name = number of OpenMP threads available for physics schemes @@ -107,14 +799,529 @@ type = integer intent = in optional = F -[first_time_step] - standard_name = flag_for_first_time_step - long_name = flag for first time step for time integration loop (cold/warmstart) +[nx] + standard_name = number_of_points_in_x_direction_for_this_MPI_rank + long_name = number of points in x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[ny] + standard_name = number_of_points_in_y_direction_for_this_MPI_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[nsst] + standard_name = flag_for_nsstm_run + long_name = NSSTM flag: off/uncoupled/coupled=0/1/2 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[tile_num] + standard_name = number_of_tile + long_name = tile number + units = none + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[kice] + standard_name = ice_vertical_dimension + long_name = vertical loop extent for ice levels, start at 1 + units = count + dimensions = () + type = integer + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[input_nml_file] + standard_name = namelist_filename_for_internal_file_reads + long_name = namelist filename for internal file reads + units = none + dimensions = (number_of_lines_of_namelist_filename_for_internal_file_reads) + type = character + kind = len=256 + intent = in + optional = F +[use_ufo] + standard_name = flag_for_gcycle_surface_option + long_name = flag for gcycle surface option + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nst_anl] + standard_name = flag_for_nsstm_analysis_in_gcycle + long_name = flag for NSSTM analysis in gcycle/sfcsub + units = flag + dimensions = () + type = logical + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid units = flag dimensions = () type = logical intent = in optional = F +[fhcyc] + standard_name = frequency_for_surface_cycling_calls + long_name = frequency for surface cycling calls + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[phour] + standard_name = forecast_time_at_previous_timestep + long_name = forecast time at the previous timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tiice] + standard_name = internal_ice_temperature + long_name = sea ice internal temperature + units = K + dimensions = (horizontal_dimension,ice_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tref] + standard_name = sea_surface_reference_temperature + long_name = sea surface reference temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + active = (flag_for_nsstm_run > 0) + intent = inout + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[facsf] + standard_name =fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorll] + standard_name = surface_roughness_length_over_land + long_name = surface roughness length over land + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zorlo] + standard_name = surface_roughness_length_over_ocean + long_name = surface roughness length over ocean + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slope] + standard_name = surface_slope_classification_real + long_name = sfc slope type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vfrac] + standard_name = vegetation_area_fraction + long_name = areal fractional cover of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stype] + standard_name = soil_type_classification_real + long_name = soil type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[shdmin] + standard_name = minimum_vegetation_area_fraction + long_name = min fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[shdmax] + standard_name = maximum_vegetation_area_fraction + long_name = max fractional coverage of green vegetation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cv] + standard_name = fraction_of_convective_cloud + long_name = fraction of convective cloud + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cvb] + standard_name = pressure_at_bottom_of_convective_cloud + long_name = convective cloud bottom pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cvt] + standard_name = pressure_at_top_of_convective_cloud + long_name = convective cloud top pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[oro] + standard_name = orography + long_name = orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[oro_uf] + standard_name = orography_unfiltered + long_name = unfiltered orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_timestep_finalize + type = scheme [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rad_time_vary.fv3.F90 b/physics/GFS_rad_time_vary.fv3.F90 index f30bf93f9..a081ddcf1 100644 --- a/physics/GFS_rad_time_vary.fv3.F90 +++ b/physics/GFS_rad_time_vary.fv3.F90 @@ -6,99 +6,87 @@ module GFS_rad_time_vary private - public GFS_rad_time_vary_init, GFS_rad_time_vary_run, GFS_rad_time_vary_finalize + public GFS_rad_time_vary_timestep_init contains - subroutine GFS_rad_time_vary_init - end subroutine GFS_rad_time_vary_init - !>\defgroup mod_GFS_rad_time_vary GFS Radiation Time Update !> @{ -!> \section arg_table_GFS_rad_time_vary_run Argument Table -!! \htmlinclude GFS_rad_time_vary_run.html +!> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_rad_time_vary_timestep_init.html !! - subroutine GFS_rad_time_vary_run (Model, Data, nthrds, errmsg, errflg) + subroutine GFS_rad_time_vary_timestep_init ( & + lslwr, lsswr, isubc_lw, isubc_sw, icsdsw, icsdlw, cnx, cny, isc, jsc, & + imap, jmap, sec, kdt, imp_physics, imp_physics_zhao_carr, ps_2delt, & + ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, errmsg, errflg) use physparam, only: ipsd0, ipsdlim, iaerflg use mersenne_twister, only: random_setseed, random_index, random_stat use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, & - GFS_data_type use radcons, only: qmin, con_100 implicit none - type(GFS_control_type), intent(inout) :: Model - type(GFS_data_type), intent(inout) :: Data(:) - integer, intent(in) :: nthrds + ! Interface variables + integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt + integer, intent(in) :: imp_physics, imp_physics_zhao_carr + logical, intent(in) :: lslwr, lsswr + integer, intent(inout) :: icsdsw(:), icsdlw(:) + integer, intent(in) :: imap(:), jmap(:) + real(kind_phys), intent(in) :: sec + real(kind_phys), intent(inout) :: ps_2delt(:) + real(kind_phys), intent(inout) :: ps_1delt(:) + real(kind_phys), intent(inout) :: t_2delt(:,:) + real(kind_phys), intent(inout) :: t_1delt(:,:) + real(kind_phys), intent(inout) :: qv_2delt(:,:) + real(kind_phys), intent(inout) :: qv_1delt(:,:) + real(kind_phys), intent(in) :: t(:,:), qv(:,:), ps(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - !--- local variables + ! Local variables type (random_stat) :: stat - integer :: ix, nb, j, i, nblks, ipseed - integer :: numrdm(Model%cnx*Model%cny*2) + integer :: ix, j, i, nblks, ipseed + integer :: numrdm(cnx*cny*2) ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (Model%lsswr .or. Model%lslwr) then - - nblks = size(Model%blksz) - - !--- call to GFS_radupdate_run is now in GFS_rrtmg_setup_run + if (lsswr .or. lslwr) then -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nb,ix,i,j) & -!$OMP shared (Model,Data,ipsdlim,ipsd0,ipseed) & -!$OMP shared (numrdm,stat,nblks) + !--- call to GFS_radupdate_timestep_init is now in GFS_rrtmg_setup_timestep_init !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) - if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then -!$OMP single - ipseed = mod(nint(con_100*sqrt(Model%sec)), ipsdlim) + 1 + ipsd0 + if ((isubc_lw==2) .or. (isubc_sw==2)) then + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 call random_setseed (ipseed, stat) call random_index (ipsdlim, numrdm, stat) -!$OMP end single - -!$OMP do schedule (dynamic,1) - do nb=1,nblks - do ix=1,Model%blksz(nb) - j = Data(nb)%Tbd%jmap(ix) - i = Data(nb)%Tbd%imap(ix) - !--- for testing purposes, replace numrdm with '100' - Data(nb)%Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) - Data(nb)%Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) - enddo + + do ix=1,size(jmap) + j = jmap(ix) + i = imap(ix) + !--- for testing purposes, replace numrdm with '100' + icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) + icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) enddo -!$OMP end do + endif ! isubc_lw and isubc_sw - if (Model%imp_physics == 99) then - if (Model%kdt == 1) then -!$OMP do schedule (dynamic,1) - do nb = 1,nblks - Data(nb)%Tbd%phy_f3d(:,:,1) = Data(nb)%Statein%tgrs - Data(nb)%Tbd%phy_f3d(:,:,2) = max(qmin,Data(nb)%Statein%qgrs(:,:,1)) - Data(nb)%Tbd%phy_f3d(:,:,3) = Data(nb)%Statein%tgrs - Data(nb)%Tbd%phy_f3d(:,:,4) = max(qmin,Data(nb)%Statein%qgrs(:,:,1)) - Data(nb)%Tbd%phy_f2d(:,1) = Data(nb)%Statein%prsi(:,1) - Data(nb)%Tbd%phy_f2d(:,2) = Data(nb)%Statein%prsi(:,1) - enddo -!$OMP end do + if (imp_physics == imp_physics_zhao_carr) then + if (kdt == 1) then + t_2delt = t + t_1delt = t + qv_2delt = qv + qv_1delt = qv + ps_2delt = ps + ps_1delt = ps endif endif -!$OMP end parallel - endif - end subroutine GFS_rad_time_vary_run + end subroutine GFS_rad_time_vary_timestep_init !> @} - - subroutine GFS_rad_time_vary_finalize() - end subroutine GFS_rad_time_vary_finalize end module GFS_rad_time_vary diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta index 8ac28be30..4c8f8362c 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -5,32 +5,218 @@ ######################################################################## [ccpp-arg-table] - name = GFS_rad_time_vary_run + name = GFS_rad_time_vary_timestep_init type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[isubc_lw] + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_sw] + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation + units = flag dimensions = () - type = GFS_control_type + type = integer + intent = in + optional = F +[icsdsw] + standard_name = seed_random_numbers_sw + long_name = random seeds for sub-column cloud generators sw + units = none + dimensions = (horizontal_dimension) + type = integer intent = inout optional = F -[Data] - standard_name = GFS_data_type_instance_all_blocks - long_name = Fortran DDT containing FV3-GFS data - units = DDT - dimensions = (ccpp_block_number) - type = GFS_data_type +[icsdlw] + standard_name = seed_random_numbers_lw + long_name = random seeds for sub-column cloud generators lw + units = none + dimensions = (horizontal_dimension) + type = integer intent = inout optional = F -[nthrds] - standard_name = omp_threads - long_name = number of OpenMP threads available for physics schemes +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank units = count dimensions = () type = integer intent = in optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sec] + standard_name = seconds_elapsed_since_model_initialization + long_name = seconds elapsed since model initialization + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ps_2delt] + standard_name = surface_air_pressure_two_timesteps_back + long_name = surface air pressure two timesteps back + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ps_1delt] + standard_name = surface_air_pressure_at_previous_timestep + long_name = surface air pressure at previous timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t_2delt] + standard_name = air_temperature_two_timesteps_back + long_name = air temperature two timesteps back + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t_1delt] + standard_name = water_vapor_specific_humidity_two_timesteps_back + long_name = water vapor specific humidity two timesteps back + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_2delt] + standard_name = air_temperature_at_previous_timestep + long_name = air temperature at previous timestep + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_1delt] + standard_name = water_vapor_specific_humidity_at_previous_timestep + long_name = water vapor specific humidity at previous timestep + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qv] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = air_pressure_at_lowest_model_interface + long_name = air pressure at lowest model interface + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 2c18ab1e0..920b6465e 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -14,7 +14,7 @@ module GFS_rrtmg_setup implicit none - public GFS_rrtmg_setup_init, GFS_rrtmg_setup_run, GFS_rrtmg_setup_finalize + public GFS_rrtmg_setup_init, GFS_rrtmg_setup_timestep_init, GFS_rrtmg_setup_finalize private @@ -320,10 +320,10 @@ subroutine GFS_rrtmg_setup_init ( & end subroutine GFS_rrtmg_setup_init -!> \section arg_table_GFS_rrtmg_setup_run Argument Table -!! \htmlinclude GFS_rrtmg_setup_run.html +!> \section arg_table_GFS_rrtmg_setup_timestep_init Argument Table +!! \htmlinclude GFS_rrtmg_setup_timestep_init.html !! - subroutine GFS_rrtmg_setup_run ( & + subroutine GFS_rrtmg_setup_timestep_init ( & idate, jdate, deltsw, deltim, lsswr, me, & slag, sdec, cdec, solcon, errmsg, errflg) @@ -345,7 +345,7 @@ subroutine GFS_rrtmg_setup_run ( & ! Check initialization state if (.not.is_initialized) then - write(errmsg, fmt='((a))') 'GFS_rrtmg_setup_run called before GFS_rrtmg_setup_init' + write(errmsg, fmt='((a))') 'GFS_rrtmg_setup_timestep_init called before GFS_rrtmg_setup_init' errflg = 1 return end if @@ -357,7 +357,7 @@ subroutine GFS_rrtmg_setup_run ( & call radupdate(idate,jdate,deltsw,deltim,lsswr,me, & slag,sdec,cdec,solcon) - end subroutine GFS_rrtmg_setup_run + end subroutine GFS_rrtmg_setup_timestep_init !> \section arg_table_GFS_rrtmg_setup_finalize Argument Table !! \htmlinclude GFS_rrtmg_setup_finalize.html @@ -523,12 +523,14 @@ subroutine radinit( si, NLAY, imp_physics, me ) !> -# Set up control variables and external module variables in !! module physparam #if 0 + ! DH* WHAT IS THIS? ! GFS_radiation_driver.F90 may in the future initialize air/ground ! temperature differently; however, this is not used at the moment ! and as such we avoid the difficulty of dealing with exchanging ! itsfc between GFS_rrtmg_setup and a yet-to-be-created/-used ! interstitial routine (or GFS_radiation_driver.F90) itsfc = iemsflg / 10 ! sfc air/ground temp control + ! *DH #endif loz1st = (ioznflg == 0) ! first-time clim ozone data read flag month0 = 0 diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index b8d94db6c..cfd6e6e9e 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -255,7 +255,7 @@ ######################################################################## [ccpp-arg-table] - name = GFS_rrtmg_setup_run + name = GFS_rrtmg_setup_timestep_init type = scheme [idate] standard_name = date_and_time_at_model_initialization diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 551f0e600..f9b33ec8c 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -14,23 +14,43 @@ end subroutine GFS_suite_interstitial_rad_reset_finalize !> \section arg_table_GFS_suite_interstitial_rad_reset_run Argument Table !! \htmlinclude GFS_suite_interstitial_rad_reset_run.html !! - subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, Model, errmsg, errflg) + subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, Diag, Model, errmsg, errflg) - use GFS_typedefs, only: GFS_control_type,GFS_interstitial_type + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_diag_type, GFS_interstitial_type implicit none ! interface variables type(GFS_interstitial_type), intent(inout) :: Interstitial + type(GFS_diag_type), intent(inout) :: Diag type(GFS_control_type), intent(in) :: Model - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + real(kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind_phys) :: sec_zero + integer :: kdt_rad errmsg = '' errflg = 0 call Interstitial%rad_reset(Model) + !--- determine if radiation diagnostics buckets need to be cleared + sec_zero = nint(Model%fhzero*con_hr) + if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then + if (mod(Model%kdt,Model%nszero) == 1) then + call Diag%rad_zero(Model) + endif + else + kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) + if (mod(Model%kdt,kdt_rad) == 1) then + call Diag%rad_zero(Model) + endif + endif + end subroutine GFS_suite_interstitial_rad_reset_run end module GFS_suite_interstitial_rad_reset @@ -49,23 +69,30 @@ end subroutine GFS_suite_interstitial_phys_reset_finalize !> \section arg_table_GFS_suite_interstitial_phys_reset_run Argument Table !! \htmlinclude GFS_suite_interstitial_phys_reset_run.html !! - subroutine GFS_suite_interstitial_phys_reset_run (Interstitial, Model, errmsg, errflg) + subroutine GFS_suite_interstitial_phys_reset_run (Interstitial, Diag, Model, errmsg, errflg) - use GFS_typedefs, only: GFS_control_type, GFS_interstitial_type + use machine, only: kind_phys + use GFS_typedefs, only: GFS_control_type, GFS_diag_type, GFS_interstitial_type implicit none ! interface variables type(GFS_interstitial_type), intent(inout) :: Interstitial + type(GFS_diag_type), intent(inout) :: Diag type(GFS_control_type), intent(in) :: Model - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg errmsg = '' errflg = 0 call Interstitial%phys_reset(Model) + !--- determine if physics diagnostics buckets need to be cleared + if (mod(Model%kdt,Model%nszero) == 1) then + call Diag%phys_zero(Model) + endif + end subroutine GFS_suite_interstitial_phys_reset_run end module GFS_suite_interstitial_phys_reset diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index b27884f9a..b290a5723 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -15,6 +15,14 @@ type = GFS_interstitial_type intent = inout optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = derived type GFS_diag_type in FV3 + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F [Model] standard_name = GFS_control_type_instance long_name = Fortran DDT containing FV3-GFS model control parameters @@ -59,6 +67,14 @@ type = GFS_interstitial_type intent = inout optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = derived type GFS_diag_type in FV3 + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F [Model] standard_name = GFS_control_type_instance long_name = Fortran DDT containing FV3-GFS model control parameters diff --git a/physics/GFS_time_vary_pre.fv3.F90 b/physics/GFS_time_vary_pre.fv3.F90 index 27e36b649..ba971fa67 100644 --- a/physics/GFS_time_vary_pre.fv3.F90 +++ b/physics/GFS_time_vary_pre.fv3.F90 @@ -9,7 +9,7 @@ module GFS_time_vary_pre private - public GFS_time_vary_pre_init, GFS_time_vary_pre_run, GFS_time_vary_pre_finalize + public GFS_time_vary_pre_init, GFS_time_vary_pre_timestep_init, GFS_time_vary_pre_finalize logical :: is_initialized = .false. @@ -62,12 +62,12 @@ subroutine GFS_time_vary_pre_finalize(errmsg, errflg) end subroutine GFS_time_vary_pre_finalize -!> \section arg_table_GFS_time_vary_pre_run Argument Table -!! \htmlinclude GFS_time_vary_pre_run.html +!> \section arg_table_GFS_time_vary_pre_timestep_init Argument Table +!! \htmlinclude GFS_time_vary_pre_timestep_init.html !! - subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lkm, lsm, lsm_noahmp, nsswr, & - nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, & - kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) + subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, lkm, lsm, lsm_noahmp, nsswr, & + nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, & + kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) use machine, only: kind_phys @@ -104,8 +104,7 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lkm, lsm, lsm_noahmp, nsswr, ! Check initialization status if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called & - &before GFS_time_vary_pre_init" + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called before GFS_time_vary_pre_init" errflg = 1 return end if @@ -190,6 +189,6 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lkm, lsm, lsm_noahmp, nsswr, print *,' solhr ', solhr endif - end subroutine GFS_time_vary_pre_run + end subroutine GFS_time_vary_pre_timestep_init end module GFS_time_vary_pre diff --git a/physics/GFS_time_vary_pre.fv3.meta b/physics/GFS_time_vary_pre.fv3.meta index e5e388a07..6266889aa 100644 --- a/physics/GFS_time_vary_pre.fv3.meta +++ b/physics/GFS_time_vary_pre.fv3.meta @@ -49,7 +49,7 @@ ######################################################################## [ccpp-arg-table] - name = GFS_time_vary_pre_run + name = GFS_time_vary_pre_timestep_init type = scheme [jdat] standard_name = forecast_date_and_time diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 8b3555826..f16b41b2b 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -2,175 +2,159 @@ !! This file repopulates specific time-varying surface properties for !! atmospheric forecast runs. +module gcycle_mod + + implicit none + + private + + public gcycle + +contains + !>\ingroup mod_GFS_phys_time_vary !! This subroutine repopulates specific time-varying surface properties for !! atmospheric forecast runs. - SUBROUTINE GCYCLE (nblks, nthrds, Model, Grid, Sfcprop, Cldprop) + subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & + input_nml_file, lsoil, kice, idate, ialb, isot, ivegsrc, use_ufo, & + nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, frac_grid, & + smc, slc, stc, tiice, tg3, tref, tsfc, tsfco, tisfc, hice, fice, & + facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, zorlo, weasd,& + slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, imap, jmap) ! ! - USE MACHINE, only: kind_phys - USE PHYSCONS, only: PI => con_PI - USE GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_sfcprop_type, GFS_cldprop_type + use machine, only: kind_phys implicit none - integer, intent(in) :: nblks, nthrds - type(GFS_control_type), intent(in) :: Model - type(GFS_grid_type), intent(in) :: Grid(nblks) - type(GFS_sfcprop_type), intent(inout) :: Sfcprop(nblks) - type(GFS_cldprop_type), intent(inout) :: Cldprop(nblks) - + integer, intent(in) :: me, nthrds, nx, ny, isc, jsc, nsst, & + tile_num, nlunit, lsoil, kice + integer, intent(in) :: idate(:), ialb, isot, ivegsrc + character(len=*), intent(in) :: input_nml_file(:) + logical, intent(in) :: use_ufo, nst_anl, frac_grid + real(kind=kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), & + min_seaice, min_lakeice, & + xlat_d(:), xlon_d(:) + real(kind=kind_phys), intent(inout) :: smc(:,:), & + slc(:,:), & + stc(:,:), & + tiice(:,:), & + tg3(:), & + tref(:), & + tsfc(:), & + tsfco(:), & + tisfc(:), & + hice(:), & + fice(:), & + facsf(:), & + facwf(:), & + alvsf(:), & + alvwf(:), & + alnsf(:), & + alnwf(:), & + zorli(:), & + zorll(:), & + zorlo(:), & + weasd(:), & + slope(:), & + snoalb(:), & + canopy(:), & + vfrac(:), & + vtype(:), & + stype(:), & + shdmin(:), & + shdmax(:), & + snowd(:), & + cv(:), & + cvb(:), & + cvt(:), & + oro(:), & + oro_uf(:), & + slmsk(:) + + integer, intent(in) :: imap(:), jmap(:) ! ! Local variables ! --------------- - integer :: & - I_INDEX(Model%nx*Model%ny), & - J_INDEX(Model%nx*Model%ny) - - real(kind=kind_phys) :: & - RLA (Model%nx*Model%ny), & - RLO (Model%nx*Model%ny), & - SLMASK (Model%nx*Model%ny), & - OROG (Model%nx*Model%ny), & - OROG_UF (Model%nx*Model%ny), & - SLIFCS (Model%nx*Model%ny), & - TSFFCS (Model%nx*Model%ny), & - SNOFCS (Model%nx*Model%ny), & - ZORFCS (Model%nx*Model%ny), & - TG3FCS (Model%nx*Model%ny), & - CNPFCS (Model%nx*Model%ny), & - AISFCS (Model%nx*Model%ny), & -! F10MFCS(Model%nx*Model%ny), & - VEGFCS (Model%nx*Model%ny), & - VETFCS (Model%nx*Model%ny), & - SOTFCS (Model%nx*Model%ny), & - CVFCS (Model%nx*Model%ny), & - CVBFCS (Model%nx*Model%ny), & - CVTFCS (Model%nx*Model%ny), & - SWDFCS (Model%nx*Model%ny), & - SIHFCS (Model%nx*Model%ny), & - SICFCS (Model%nx*Model%ny), & - SITFCS (Model%nx*Model%ny), & - VMNFCS (Model%nx*Model%ny), & - VMXFCS (Model%nx*Model%ny), & - SLPFCS (Model%nx*Model%ny), & - ABSFCS (Model%nx*Model%ny), & - ALFFC1 (Model%nx*Model%ny*2), & - ALBFC1 (Model%nx*Model%ny*4), & - SMCFC1 (Model%nx*Model%ny*Model%lsoil), & - STCFC1 (Model%nx*Model%ny*Model%lsoil), & - SLCFC1 (Model%nx*Model%ny*Model%lsoil) - - logical :: lake(Model%nx*Model%ny) - - character(len=6) :: tile_num_ch - real(kind=kind_phys), parameter :: pifac=180.0/pi - real(kind=kind_phys) :: sig1t, dt_warm - integer :: npts, len, nb, ix, jx, ls, ios, ll - logical :: exists + real(kind=kind_phys) :: & + SLMASK (nx*ny), & + TSFFCS (nx*ny), & + ZORFCS (nx*ny), & + AISFCS (nx*ny), & + ALFFC1 (nx*ny*2), & + ALBFC1 (nx*ny*4), & + SMCFC1 (nx*ny*lsoil), & + STCFC1 (nx*ny*lsoil), & + SLCFC1 (nx*ny*lsoil) + + logical :: lake(nx*ny) + character(len=6) :: tile_num_ch + real(kind=kind_phys) :: sig1t, dt_warm + integer :: npts, nb, ix, jx, ls, ios, ll + logical :: exists ! !@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ! ! if (Model%me .eq. 0) print *,' nlats=',nlats,' lonsinpe=' ! *,lonsinpe(0,1) - +! tile_num_ch = " " - if (Model%tile_num < 10) then - write(tile_num_ch, "(a4,i1)") "tile", Model%tile_num + if (tile_num < 10) then + write(tile_num_ch, "(a4,i1)") "tile", tile_num else - write(tile_num_ch, "(a4,i2)") "tile", Model%tile_num + write(tile_num_ch, "(a4,i2)") "tile", tile_num endif - - len = 0 - do jx = Model%jsc, (Model%jsc+Model%ny-1) - do ix = Model%isc, (Model%isc+Model%nx-1) - len = len + 1 - i_index(len) = ix - j_index(len) = jx - enddo - enddo - +! sig1t = 0.0_kind_phys - npts = Model%nx*Model%ny + npts = nx*ny ! - len = 0 - do nb = 1,nblks - do ix = 1,size(Grid(nb)%xlat,1) - len = len + 1 - RLA (len) = Grid(nb)%xlat (ix) * pifac - RLO (len) = Grid(nb)%xlon (ix) * pifac - OROG (len) = Sfcprop(nb)%oro (ix) - OROG_UF (len) = Sfcprop(nb)%oro_uf (ix) - SLIFCS (len) = Sfcprop(nb)%slmsk (ix) - if ( Model%nstf_name(1) > 0 ) then - TSFFCS(len) = Sfcprop(nb)%tref (ix) - else - TSFFCS(len) = Sfcprop(nb)%tsfc (ix) - endif - SNOFCS (len) = Sfcprop(nb)%weasd (ix) - ZORFCS (len) = Sfcprop(nb)%zorll (ix) - if (SLIFCS(len) > 1.9_kind_phys .and. .not. Model%frac_grid) then - ZORFCS (len) = Sfcprop(nb)%zorli (ix) - elseif (SLIFCS(len) < 0.1_kind_phys .and. .not. Model%frac_grid) then - ZORFCS (len) = Sfcprop(nb)%zorlo (ix) - endif - TG3FCS (len) = Sfcprop(nb)%tg3 (ix) - CNPFCS (len) = Sfcprop(nb)%canopy (ix) -! F10MFCS (len) = Sfcprop(nb)%f10m (ix) - VEGFCS (len) = Sfcprop(nb)%vfrac (ix) - VETFCS (len) = Sfcprop(nb)%vtype (ix) - SOTFCS (len) = Sfcprop(nb)%stype (ix) - CVFCS (len) = Cldprop(nb)%cv (ix) - CVBFCS (len) = Cldprop(nb)%cvb (ix) - CVTFCS (len) = Cldprop(nb)%cvt (ix) - SWDFCS (len) = Sfcprop(nb)%snowd (ix) - SIHFCS (len) = Sfcprop(nb)%hice (ix) - SICFCS (len) = Sfcprop(nb)%fice (ix) - SITFCS (len) = Sfcprop(nb)%tisfc (ix) - VMNFCS (len) = Sfcprop(nb)%shdmin (ix) - VMXFCS (len) = Sfcprop(nb)%shdmax (ix) - SLPFCS (len) = Sfcprop(nb)%slope (ix) - ABSFCS (len) = Sfcprop(nb)%snoalb (ix) - - ALFFC1 (len ) = Sfcprop(nb)%facsf (ix) - ALFFC1 (len + npts) = Sfcprop(nb)%facwf (ix) - - ALBFC1 (len ) = Sfcprop(nb)%alvsf (ix) - ALBFC1 (len + npts ) = Sfcprop(nb)%alvwf (ix) - ALBFC1 (len + npts*2) = Sfcprop(nb)%alnsf (ix) - ALBFC1 (len + npts*3) = Sfcprop(nb)%alnwf (ix) - - do ls = 1,Model%lsoil - SMCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%smc (ix,ls) - STCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%stc (ix,ls) - SLCFC1 (len + (ls-1)*npts) = Sfcprop(nb)%slc (ix,ls) - enddo - - IF (SLIFCS(len) < 0.1_kind_phys .OR. SLIFCS(len) > 1.5_kind_phys) THEN - SLMASK(len) = 0.0_kind_phys - ELSE - SLMASK(len) = 1.0_kind_phys - ENDIF - - IF (SLIFCS(len) > 1.99_kind_phys) THEN - AISFCS(len) = 1.0_kind_phys - ELSE - AISFCS(len) = 0.0_kind_phys - ENDIF - if (Sfcprop(nb)%lakefrac(ix) > 0.0_kind_phys) then - lake(len) = .true. - else - lake(len) = .false. - endif - -! if (Model%me .eq. 0) -! & print *,' len=',len,' rla=',rla(len),' rlo=',rlo(len) - ENDDO !-----END BLOCK SIZE LOOP------------------------------ - ENDDO !-----END BLOCK LOOP------------------------------- - -! check -! call mymaxmin(slifcs,len,len,1,'slifcs') -! call mymaxmin(slmask,len,len,1,'slmsk') + if ( nsst > 0 ) then + TSFFCS = tref + else + TSFFCS = tsfc + end if +! + do ix=1,npts + ZORFCS(ix) = zorll (ix) + if (slmsk(ix) > 1.9_kind_phys .and. .not. frac_grid) then + ZORFCS(ix) = zorli (ix) + elseif (slmsk(ix) < 0.1_kind_phys .and. .not. frac_grid) then + ZORFCS(ix) = zorlo (ix) + endif + ! DH* Why not 1.9 as for ZORFCS? + IF (slmsk(ix) > 1.99_kind_phys) THEN + AISFCS(ix) = 1.0_kind_phys + ELSE + AISFCS(ix) = 0.0_kind_phys + ENDIF + ! + ALFFC1(ix ) = facsf(ix) + ALFFC1(ix + npts ) = facwf(ix) + ! + ALBFC1(ix ) = alvsf(ix) + ALBFC1(ix + npts ) = alvwf(ix) + ALBFC1(ix + npts*2) = alnsf(ix) + ALBFC1(ix + npts*3) = alnwf(ix) + ! + do ls = 1,lsoil + ll = ix + (ls-1)*npts + SMCFC1(ll) = smc(ix,ls) + STCFC1(ll) = stc(ix,ls) + SLCFC1(ll) = slc(ix,ls) + enddo + ! + IF (slmsk(ix) < 0.1_kind_phys .OR. slmsk(ix) > 1.5_kind_phys) THEN + SLMASK(ix) = 0.0_kind_phys + ELSE + SLMASK(ix) = 1.0_kind_phys + ENDIF + ! + if (lakefrac(ix) > 0.0_kind_phys) then + lake(ix) = .true. + else + lake(ix) = .false. + endif + end do ! #ifndef INTERNAL_FILE_NML inquire (file=trim(Model%fn_nml),exist=exists) @@ -182,90 +166,59 @@ SUBROUTINE GCYCLE (nblks, nthrds, Model, Grid, Sfcprop, Cldprop) rewind (Model%nlunit) endif #endif - CALL SFCCYCLE (9998, npts, Model%lsoil, SIG1T, Model%fhcyc, & - Model%idate(4), Model%idate(2), & - Model%idate(3), Model%idate(1), & - Model%phour, RLA, RLO, SLMASK, & -! Model%fhour, RLA, RLO, SLMASK, & - OROG, OROG_UF, Model%USE_UFO, Model%nst_anl, & - SIHFCS, SICFCS, SITFCS, SWDFCS, SLCFC1, & - VMNFCS, VMXFCS, SLPFCS, ABSFCS, TSFFCS, & - SNOFCS, ZORFCS, ALBFC1, TG3FCS, CNPFCS, & - SMCFC1, STCFC1, SLIFCS, AISFCS, & - VEGFCS, VETFCS, SOTFCS, ALFFC1, CVFCS, & - CVBFCS, CVTFCS, Model%me, nthrds, & - Model%nlunit, size(Model%input_nml_file), & - Model%input_nml_file, & - lake, Model%min_lakeice, Model%min_seaice, & - Model%ialb, Model%isot, Model%ivegsrc, & - trim(tile_num_ch), i_index, j_index) + CALL SFCCYCLE (9998, npts, lsoil, sig1t, fhcyc, & + idate(4), idate(2), idate(3), idate(1), & + phour, xlat_d, xlon_d, slmask, & + oro, oro_uf, use_ufo, nst_anl, & + hice, fice, tisfc, snowd, slcfc1, & + shdmin, shdmax, slope, snoalb, tsffcs, & + weasd, zorfcs, albfc1, tg3, canopy, & + smcfc1, stcfc1, slmsk, aisfcs, & + vfrac, vtype, stype, alffc1, cv, & + cvb, cvt, me, nthrds, & + nlunit, size(input_nml_file), input_nml_file,& + lake, min_lakeice, min_seaice, & + ialb, isot, ivegsrc, & + trim(tile_num_ch), imap, jmap) #ifndef INTERNAL_FILE_NML close (Model%nlunit) #endif - - len = 0 - do nb = 1,nblks - do ix = 1,size(Grid(nb)%xlat,1) - len = len + 1 - Sfcprop(nb)%slmsk (ix) = SLIFCS (len) - if ( Model%nstf_name(1) > 0 ) then - Sfcprop(nb)%tref(ix) = TSFFCS (len) -! if ( Model%nstf_name(2) == 0 ) then -! dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & -! / Sfcprop(nb)%xz(ix) -! Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & -! + dt_warm - Sfcprop(nb)%dt_cool(ix) -! endif - else - Sfcprop(nb)%tsfc(ix) = TSFFCS (len) - Sfcprop(nb)%tsfco(ix) = TSFFCS (len) - endif - Sfcprop(nb)%weasd (ix) = SNOFCS (len) - Sfcprop(nb)%zorll (ix) = ZORFCS (len) - if (SLIFCS(len) > 1.9_kind_phys .and. .not. Model%frac_grid) then - Sfcprop(nb)%zorli(ix) = ZORFCS (len) - elseif (SLIFCS(len) < 0.1_kind_phys .and. .not. Model%frac_grid) then - Sfcprop(nb)%zorlo(ix) = ZORFCS (len) - endif - Sfcprop(nb)%tg3 (ix) = TG3FCS (len) - Sfcprop(nb)%canopy (ix) = CNPFCS (len) -! Sfcprop(nb)%f10m (ix) = F10MFCS (len) - Sfcprop(nb)%vfrac (ix) = VEGFCS (len) - Sfcprop(nb)%vtype (ix) = VETFCS (len) - Sfcprop(nb)%stype (ix) = SOTFCS (len) - Cldprop(nb)%cv (ix) = CVFCS (len) - Cldprop(nb)%cvb (ix) = CVBFCS (len) - Cldprop(nb)%cvt (ix) = CVTFCS (len) - Sfcprop(nb)%snowd (ix) = SWDFCS (len) - Sfcprop(nb)%hice (ix) = SIHFCS (len) - Sfcprop(nb)%fice (ix) = SICFCS (len) - Sfcprop(nb)%tisfc (ix) = SITFCS (len) - Sfcprop(nb)%shdmin (ix) = VMNFCS (len) - Sfcprop(nb)%shdmax (ix) = VMXFCS (len) - Sfcprop(nb)%slope (ix) = SLPFCS (len) - Sfcprop(nb)%snoalb (ix) = ABSFCS (len) - - Sfcprop(nb)%facsf (ix) = ALFFC1 (len ) - Sfcprop(nb)%facwf (ix) = ALFFC1 (len + npts) - - Sfcprop(nb)%alvsf (ix) = ALBFC1 (len ) - Sfcprop(nb)%alvwf (ix) = ALBFC1 (len + npts ) - Sfcprop(nb)%alnsf (ix) = ALBFC1 (len + npts*2) - Sfcprop(nb)%alnwf (ix) = ALBFC1 (len + npts*3) - do ls = 1,Model%lsoil - ll = len + (ls-1)*npts - Sfcprop(nb)%smc (ix,ls) = SMCFC1 (ll) - Sfcprop(nb)%stc (ix,ls) = STCFC1 (ll) - Sfcprop(nb)%slc (ix,ls) = SLCFC1 (ll) - if (ls<=Model%kice) Sfcprop(nb)%tiice (ix,ls) = STCFC1 (ll) - enddo - ENDDO !-----END BLOCK SIZE LOOP-------------------------- - ENDDO !-----END BLOCK LOOP------------------------------- - -! check -! call mymaxmin(slifcs,len,len,1,'slifcs') +! + if ( nsst > 0 ) then + tref = TSFFCS + else + tsfc = TSFFCS + tsfco = TSFFCS + end if +! + do ix=1,npts + zorll(ix) = ZORFCS(ix) + if (slmsk(ix) > 1.9_kind_phys .and. .not. frac_grid) then + zorli(ix) = ZORFCS(ix) + elseif (slmsk(ix) < 0.1_kind_phys .and. .not. frac_grid) then + zorlo(ix) = ZORFCS(ix) + endif + ! + facsf(ix) = ALFFC1(ix ) + facwf(ix) = ALFFC1(ix + npts ) + ! + alvsf(ix) = ALBFC1(ix ) + alvwf(ix) = ALBFC1(ix + npts ) + alnsf(ix) = ALBFC1(ix + npts*2) + alnwf(ix) = ALBFC1(ix + npts*3) + ! + do ls = 1,lsoil + ll = ix + (ls-1)*npts + smc(ix,ls) = SMCFC1(ll) + stc(ix,ls) = STCFC1(ll) + slc(ix,ls) = SLCFC1(ll) + if (ls<=kice) tiice(ix,ls) = STCFC1(ll) + enddo + enddo ! ! if (Model%me .eq. 0) print*,'executed gcycle during hour=',fhour - +! RETURN END + +end module gcycle_mod diff --git a/physics/h2o_def.f b/physics/h2o_def.f index d1d6407dd..72748a613 100644 --- a/physics/h2o_def.f +++ b/physics/h2o_def.f @@ -4,6 +4,11 @@ !>\ingroup mod_GFS_phys_time_vary !! This module defines arrays in H2O scheme. module h2o_def + +!> \section arg_table_h2o_def +!! \htmlinclude h2o_def.html +!! + use machine , only : kind_phys implicit none diff --git a/physics/h2o_def.meta b/physics/h2o_def.meta new file mode 100644 index 000000000..21f3b903f --- /dev/null +++ b/physics/h2o_def.meta @@ -0,0 +1,29 @@ +[ccpp-table-properties] + name = h2o_def + type = module + dependencies = machine.F + +[ccpp-arg-table] + name = h2o_def + type = module + +[levh2o] + standard_name = vertical_dimension_of_h2o_forcing_data + long_name = number of vertical layers in h2o forcing data + units = count + dimensions = () + type = integer +[h2o_coeff] + standard_name = number_of_coefficients_in_h2o_forcing_data + long_name = number of coefficients in h2o forcing data + units = index + dimensions = () + type = integer +[h2o_pres] + standard_name = natural_log_of_h2o_forcing_data_pressure_levels + long_name = natural log of h2o forcing data pressure levels + units = log(Pa) + dimensions = (vertical_dimension_of_h2o_forcing_data) + type = real + kind = kind_phys + active = (flag_for_stratospheric_water_vapor_physics) \ No newline at end of file diff --git a/physics/ozne_def.f b/physics/ozne_def.f index 3f7fddb8b..8f3af6240 100644 --- a/physics/ozne_def.f +++ b/physics/ozne_def.f @@ -4,6 +4,11 @@ !>\ingroup mod_GFS_phys_time_vary !! This module defines arrays in Ozone scheme. module ozne_def + +!> \section arg_table_ozne_def +!! \htmlinclude ozne_def.html +!! + use machine , only : kind_phys implicit none diff --git a/physics/ozne_def.meta b/physics/ozne_def.meta new file mode 100644 index 000000000..27698eec6 --- /dev/null +++ b/physics/ozne_def.meta @@ -0,0 +1,29 @@ +[ccpp-table-properties] + name = ozne_def + type = module + dependencies = machine.F + +[ccpp-arg-table] + name = ozne_def + type = module + +[levozp] + standard_name = vertical_dimension_of_ozone_forcing_data + long_name = number of vertical layers in ozone forcing data + units = count + dimensions = () + type = integer +[oz_coeff] + standard_name = number_of_coefficients_in_ozone_forcing_data + long_name = number of coefficients in ozone forcing data + units = index + dimensions = () + type = integer +[oz_pres] + standard_name = natural_log_of_ozone_forcing_data_pressure_levels + long_name = natural log of ozone forcing data pressure levels + units = log(Pa) + dimensions = (vertical_dimension_of_ozone_forcing_data) + type = real + kind = kind_phys + active = (index_for_ozone>0) From 04ee898cfabb6af07087c6ea9a3108f758ac668a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 18 Dec 2020 08:07:30 -0700 Subject: [PATCH 158/274] Updates to physics/GFS_phys_time_vary.fv3.* and physics/gcycle.F90 following the merge of NCAR master --- physics/GFS_phys_time_vary.fv3.F90 | 33 ++++++++++++++------------- physics/GFS_phys_time_vary.fv3.meta | 35 +++++++++++++++++++++++++++++ physics/gcycle.F90 | 18 +++++++++------ 3 files changed, 63 insertions(+), 23 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 4043b9090..71e0dbf3e 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -264,11 +264,11 @@ subroutine GFS_phys_time_vary_timestep_init ( jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & - imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, kice, & - ialb, isot, ivegsrc, input_nml_file, use_ufo, nst_anl, frac_grid, fhcyc, phour, & - lakefrac, min_seaice, min_lakeice, smc, slc, stc, tiice, tg3, tref, tsfc, tsfco, tisfc, & - hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, zorlo, weasd, & - slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & + imap, jmap, prsl, seed0, rann, nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, lsoil_lsm,& + kice, ialb, isot, ivegsrc, input_nml_file, use_ufo, nst_anl, frac_grid, fhcyc, phour, & + lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, & + tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & + zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, errmsg, errflg) implicit none @@ -294,15 +294,15 @@ subroutine GFS_phys_time_vary_timestep_init ( integer, intent(in) :: seed0 real(kind_phys), intent(out) :: rann(:,:) ! For gcycle only - integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil, kice - integer, intent(in) :: ialb, isot, ivegsrc + integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil + integer, intent(in) :: lsoil_lsm, kice, ialb, isot, ivegsrc character(len=*), intent(in) :: input_nml_file(:) logical, intent(in) :: use_ufo, nst_anl, frac_grid real(kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice, & xlat_d(:), xlon_d(:) - ! - real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), tiice(:,:), tg3(:), & - tref(:), tsfc(:), tsfco(:), tisfc(:), hice(:), fice(:), & + real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), smois(:,:), sh2o(:,:), & + tslb(:,:), tiice(:,:), tg3(:), tref(:), & + tsfc(:), tsfco(:), tisfc(:), hice(:), fice(:), & facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:), & zorli(:), zorll(:), zorlo(:), weasd(:), slope(:), snoalb(:), & canopy(:), vfrac(:), vtype(:), stype(:), shdmin(:), shdmax(:), & @@ -405,12 +405,13 @@ subroutine GFS_phys_time_vary_timestep_init ( if (nscyc > 0) then if (mod(kdt,nscyc) == 1) THEN call gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & - input_nml_file, lsoil, kice, idate, ialb, isot, ivegsrc, use_ufo, & - nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, frac_grid, & - smc, slc, stc, tiice, tg3, tref, tsfc, tsfco, tisfc, hice, fice, & - facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, zorlo, weasd,& - slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, imap, jmap) + input_nml_file, lsoil, lsoil_lsm, kice, idate, ialb, isot, ivegsrc, & + use_ufo, nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, & + frac_grid, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, tsfc, & + tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & + zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & + stype, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & + xlat_d, xlon_d, slmsk, imap, jmap) endif endif diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index e78a13e4b..0258e084f 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -847,6 +847,14 @@ type = integer intent = in optional = F +[lsoil_lsm] + standard_name = soil_vertical_dimension_for_land_surface_model + long_name = number of soil layers internal to land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F [kice] standard_name = ice_vertical_dimension long_name = vertical loop extent for ice levels, start at 1 @@ -984,6 +992,33 @@ kind = kind_phys intent = inout optional = F +[smois] + standard_name = volume_fraction_of_soil_moisture_for_land_surface_model + long_name = volumetric fraction of soil moisture for lsm + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[sh2o] + standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model + long_name = volume fraction of unfrozen soil moisture for lsm + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[tslb] + standard_name = soil_temperature_for_land_surface_model + long_name = soil temperature for land surface model + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F [tiice] standard_name = internal_ice_temperature long_name = sea ice internal temperature diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 6aaab8836..558a65860 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -16,19 +16,20 @@ module gcycle_mod !! This subroutine repopulates specific time-varying surface properties for !! atmospheric forecast runs. subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & - input_nml_file, lsoil, kice, idate, ialb, isot, ivegsrc, use_ufo, & - nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, frac_grid, & - smc, slc, stc, tiice, tg3, tref, tsfc, tsfco, tisfc, hice, fice, & - facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, zorlo, weasd,& - slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, imap, jmap) + input_nml_file, lsoil, lsoil_lsm, kice, idate, ialb, isot, ivegsrc, & + use_ufo, nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, & + frac_grid, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, tsfc, & + tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & + zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & + stype, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & + xlat_d, xlon_d, slmsk, imap, jmap) ! ! use machine, only: kind_phys implicit none integer, intent(in) :: me, nthrds, nx, ny, isc, jsc, nsst, & - tile_num, nlunit, lsoil, kice + tile_num, nlunit, lsoil, lsoil_lsm, kice integer, intent(in) :: idate(:), ialb, isot, ivegsrc character(len=*), intent(in) :: input_nml_file(:) logical, intent(in) :: use_ufo, nst_anl, frac_grid @@ -38,6 +39,9 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & real(kind=kind_phys), intent(inout) :: smc(:,:), & slc(:,:), & stc(:,:), & + smois(:,:), & + sh2o(:,:), & + tslb(:,:), & tiice(:,:), & tg3(:), & tref(:), & From 5ce1183c08507eb94e5a84e24b214686d40afca1 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 18 Dec 2020 19:45:33 +0000 Subject: [PATCH 159/274] Add do_mynnedmf to GP to GFDL-MP coupling. Bound particle size for use in GP cloud-optics. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 61 ++++++++++++++++++++---------- physics/GFS_rrtmgp_gfdlmp_pre.meta | 56 +++++++++++++++++++++------ 2 files changed, 86 insertions(+), 31 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 31c67d62f..16844304b 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -6,16 +6,19 @@ module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys use rrtmgp_aux, only: check_error_msg use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp + use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr ! Parameters real(kind_phys), parameter :: & reliq_def = 10.0 , & ! Default liq radius to 10 micron (used when effr_in=F) reice_def = 50.0, & ! Default ice radius to 50 micron (used when effr_in=F) rerain_def = 1000.0, & ! Default rain radius to 1000 micron (used when effr_in=F) - resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) - reice_min = 10.0, & ! Minimum ice size allowed by scheme - reice_max = 150.0 ! Maximum ice size allowed by scheme - + resnow_def = 250.0, & ! Default snow radius to 250 micron (used when effr_in=F) + reice_min = 10.0, & ! Minimum ice size allowed by GFDL MP scheme + reice_max = 150.0 ! Maximum ice size allowed by GFDL MP scheme + ! NOTE: When using RRTMGP cloud-optics, the min/max particle size allowed are imported + ! from initialization. + public GFS_rrtmgp_gfdlmp_pre_init, GFS_rrtmgp_gfdlmp_pre_run, GFS_rrtmgp_gfdlmp_pre_finalize contains @@ -30,9 +33,9 @@ end subroutine GFS_rrtmgp_gfdlmp_pre_init !! \htmlinclude GFS_rrtmgp_gfdlmp_pre_run.html !! subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cldice, & - i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, doSWrad, doLWrad, effr_in, & - p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & - effrin_cldsnow, tracer, con_g, con_rd, & + i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, doSWrad, doLWrad, effr_in, kdt, & + do_mynnedmf, p_lev, p_lay, tv_lay, effrin_cldliq, effrin_cldice, effrin_cldrain, & + effrin_cldsnow, tracer, con_g, con_rd, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, errmsg, errflg) implicit none @@ -48,11 +51,15 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld i_cldrain, & ! Index into tracer array for cloud rain. i_cldsnow, & ! Index into tracer array for cloud snow. i_cldgrpl, & ! Index into tracer array for cloud groupel. - i_cldtot ! Index into tracer array for cloud total amount. + i_cldtot, & ! Index into tracer array for cloud total amount. + kdt ! Current forecast iteration logical, intent(in) :: & doSWrad, & ! Call SW radiation? doLWrad, & ! Call LW radiation - effr_in ! Provide hydrometeor radii from macrophysics? + effr_in, & ! Provide hydrometeor radii from macrophysics? + do_mynnedmf, & ! Flag to activate MYNN-EDMF + doGP_cldoptics_LUT, & ! Flag to do GP cloud-optics (LUTs) + doGP_cldoptics_PADE ! (PADE approximation) real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant con_rd ! Physical constant: gas-constant for dry air @@ -69,7 +76,7 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld tracer ! Cloud condensate amount in layer by type () ! Outputs - real(kind_phys), dimension(nCol,nLev),intent(out) :: & + real(kind_phys), dimension(nCol,nLev),intent(inout) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path cld_reliq, & ! Cloud liquid effective radius @@ -106,14 +113,10 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld return endif - ! Initialize outputs - cld_lwp(:,:) = 0.0 + ! Initialize outputs cld_reliq(:,:) = reliq_def - cld_iwp(:,:) = 0.0 cld_reice(:,:) = reice_def - cld_rwp(:,:) = 0.0 cld_rerain(:,:) = rerain_def - cld_swp(:,:) = 0.0 cld_resnow(:,:) = resnow_def ! #################################################################################### @@ -137,8 +140,8 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) enddo - enddo - + enddo + ! Particle size do iLay = 1, nLev do iCol = 1, nCol @@ -151,12 +154,32 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld endif enddo enddo + + ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from + ! 2.5 - 21.5 microns for liquid clouds, + ! 10 - 180 microns for ice-clouds + if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then + where(cld_reliq .lt. radliq_lwr) cld_reliq = radliq_lwr + where(cld_reliq .gt. radliq_upr) cld_reliq = radliq_upr + where(cld_reice .lt. radice_lwr) cld_reice = radice_lwr + where(cld_reice .gt. radice_upr) cld_reice = radice_upr + endif ! Cloud-fraction - cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + if (do_mynnedmf .and. kdt .gt. 1) then + do iLay = 1, nLev + do iCol = 1, nCol + if (tracer(iCol,iLay,i_cldrain) > 1.0e-7 .OR. tracer(iCol,iLay,i_cldsnow)>1.0e-7) then + cld_frac(iCol,iLay) = tracer(iCol,iLay,i_cldtot) + endif + enddo + enddo + else + cld_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + endif ! Precipitation fraction (Hack. For now use cloud-fraction) - precip_frac(1:nCol,1:nLev) = tracer(1:nCol,1:nLev,i_cldtot) + precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) end subroutine GFS_rrtmgp_gfdlmp_pre_run diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.meta b/physics/GFS_rrtmgp_gfdlmp_pre.meta index 5894d9f5d..19d09cd79 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.meta +++ b/physics/GFS_rrtmgp_gfdlmp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_gfdlmp_pre type = scheme - dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90 + dependencies = rrtmgp_aux.F90, radiation_cloud_overlap.F90, rrtmgp_lw_cloud_optics.F90 ######################################################################## [ccpp-arg-table] @@ -62,7 +62,39 @@ dimensions = () type = logical intent = in - optional = F + optional = F +[doGP_cldoptics_PADE] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_PADE + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[doGP_cldoptics_LUT] + standard_name = flag_to_calc_lw_cld_optics_using_RRTMGP_LUT + long_name = logical flag to control cloud optics scheme. + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F [i_cldliq] standard_name = index_for_liquid_cloud_condensate long_name = tracer index for cloud condensate (or liquid water) @@ -208,7 +240,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_lwp] standard_name = cloud_liquid_water_path @@ -217,7 +249,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reliq] standard_name = mean_effective_radius_for_liquid_cloud @@ -226,7 +258,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_iwp] standard_name = cloud_ice_water_path @@ -235,7 +267,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_reice] standard_name = mean_effective_radius_for_ice_cloud @@ -244,7 +276,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_swp] standard_name = cloud_snow_water_path @@ -253,7 +285,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_resnow] standard_name = mean_effective_radius_for_snow_flake @@ -262,7 +294,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rwp] standard_name = cloud_rain_water_path @@ -271,7 +303,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [cld_rerain] standard_name = mean_effective_radius_for_rain_drop @@ -280,7 +312,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [precip_frac] standard_name = precipitation_fraction_by_layer @@ -289,7 +321,7 @@ dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message From 96cce1f883c986139502d9bef861e29d9aec06ce Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Fri, 18 Dec 2020 19:58:44 +0000 Subject: [PATCH 160/274] The max and min soil moisture for a given soil type is saved in the GFS_Control_type arrays pores and resid for use in the stochastic perturbations of soil moisture (lndp_type=2). --- physics/sfc_drv.f | 12 ++++++++++-- physics/sfc_drv.meta | 16 ++++++++++++++++ physics/sfc_drv_ruc.F90 | 9 +++++++-- physics/sfc_drv_ruc.meta | 16 ++++++++++++++++ physics/sfc_noahmp_drv.f | 11 +++++++++-- physics/sfc_noahmp_drv.meta | 16 ++++++++++++++++ 6 files changed, 74 insertions(+), 6 deletions(-) diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 45c501db2..4343d5dff 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -4,7 +4,9 @@ !> This module contains the CCPP-compliant Noah land surface scheme driver. module lsm_noah + use machine, only: kind_phys use set_soilveg_mod, only: set_soilveg + use namelist_soilveg implicit none @@ -20,11 +22,14 @@ module lsm_noah !! \htmlinclude lsm_noah_init.html !! subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, - & errmsg, errflg) + & pores, resid, errmsg, errflg) implicit none integer, intent(in) :: me, isot, ivegsrc, nlunit + + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -48,6 +53,9 @@ subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit) + pores (:) = maxsmc (:) + resid (:) = drysmc (:) + end subroutine lsm_noah_init @@ -199,7 +207,7 @@ subroutine lsm_noah_run & & smcwlt2, smcref2, wet1, errmsg, errflg & & ) ! - use machine , only : kind_phys + !use machine , only : kind_phys use funcphys, only : fpvs use surface_perturbation, only : ppfbet diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index eb3f77a98..ff1766774 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -39,6 +39,22 @@ type = integer intent = in optional = F +[pores] + standard_name = maximum_soil_moisture_content_for_land_surface_model + long_name = maximum soil moisture for a given soil type for land surface model + units = m + dimensions = (30) + type = real + intent = out + kind = kind_phys +[resid] + standard_name = minimum_soil_moisture_content_for_land_surface_model + long_name = minimum soil moisture for a given soil type for land surface model + units = m + dimensions = (30) + type = real + intent = out + kind = kind_phys [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index c3ad85a9e..23d99d6ef 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -32,7 +32,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & tsfc_lnd, tsfc_wat, & ! in tg3, smc, slc, stc, & ! in zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out - tsice, errmsg, errflg) + tsice, pores, resid, errmsg, errflg) implicit none ! --- in @@ -65,6 +65,8 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & real (kind=kind_phys), dimension(im,lsoil_ruc), intent(inout) :: tslb, smois real (kind=kind_phys), dimension(im,kice), intent(out) :: tsice + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -113,6 +115,9 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & !--- initialize soil vegetation call set_soilveg_ruc(me, isot, ivegsrc, nlunit) + pores (:) = maxsmc (:) + resid (:) = drysmc (:) + soiltyp(:) = 0 vegtype(:) = 0 @@ -138,7 +143,7 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & endif enddo - call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) + call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) call rucinit (flag_restart, im, lsoil_ruc, lsoil, nlev, & ! in me, master, lsm_ruc, lsm, slmsk, & ! in diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 0aad3157d..229bce1fc 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -263,6 +263,22 @@ kind = kind_phys intent = out optional = F +[pores] + standard_name = maximum_soil_moisture_content_for_land_surface_model + long_name = maximum soil moisture for a given soil type for land surface model + units = m + dimensions = (30) + type = real + intent = out + kind = kind_phys +[resid] + standard_name = minimum_soil_moisture_content_for_land_surface_model + long_name = minimum soil moisture for a given soil type for land surface model + units = m + dimensions = (30) + type = real + intent = out + kind = kind_phys [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index 963810734..e44aac872 100644 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -24,14 +24,18 @@ module noahmpdrv !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! - subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, errmsg, & - & errflg) + subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, + & errmsg, errflg) use set_soilveg_mod, only: set_soilveg + use namelist_soilveg implicit none integer, intent(in) :: me, isot, ivegsrc, nlunit + + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -54,6 +58,9 @@ subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, errmsg, & !--- initialize soil vegetation call set_soilveg(me, isot, ivegsrc, nlunit) + + pores (:) = maxsmc (:) + resid (:) = drysmc (:) end subroutine noahmpdrv_init diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index ecfd3e09f..32fc2f15a 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -39,6 +39,22 @@ type = integer intent = in optional = F +[pores] + standard_name = maximum_soil_moisture_content_for_land_surface_model + long_name = maximum soil moisture for a given soil type for land surface model + units = m + dimensions = (30) + type = real + intent = out + kind = kind_phys +[resid] + standard_name = minimum_soil_moisture_content_for_land_surface_model + long_name = minimum soil moisture for a given soil type for land surface model + units = m + dimensions = (30) + type = real + intent = out + kind = kind_phys [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From b33d1991b3e5ac249b2789e3f564e97c3cf1d505 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 21 Dec 2020 10:00:55 -0600 Subject: [PATCH 161/274] established merra2 and a bug fixed in radiation_aerosols.f --- physics/radiation_aerosols.f | 2 + physics/samfdeepcnv.f | 138 +++++++++++++++++------------------ physics/sfc_sice.f | 8 +- 3 files changed, 75 insertions(+), 73 deletions(-) diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index f732c37ef..130c6471f 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -4446,6 +4446,8 @@ subroutine aeropt asy1 = f_zero sca1 = f_zero ssa1 = f_zero + asy = f_zero + ssa = f_zero do m = 1, kcm1 cm = max(aerms(k,m),0.0) * dz1(k) ext1 = ext1 + cm*extrhi_grt(m,ib) diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 1b71e011e..f2a21c683 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -161,7 +161,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & jmin(im), lmin(im), kbmax(im), & kbm(im), kmax(im) ! -! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), + real(kind=kind_phys) acrt(im), acrtfct(im) real(kind=kind_phys) aa1(im), tkemean(im),clamt(im), & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), @@ -247,18 +247,18 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & qrcko(im,km), qrcdo(im,km), & pwo(im,km), pwdo(im,km), c0t(im,km), & tx1(im), sumx(im), cnvwt(im,km) -! &, rhbar(im) + &, rhbar(im) ! logical do_aerosols, totflg, cnvflg(im), asqecflg(im), flg(im) ! ! asqecflg: flag for the quasi-equilibrium assumption of Arakawa-Schubert ! -! real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) -!! save pcrit, acritt -! data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., -! & 350.,300.,250.,200.,150./ -! data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, -! & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ + real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) + save pcrit, acritt + data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., + & 350.,300.,250.,200.,150./ + data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, + & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ c gdas derived acrit c data acritt/.203,.515,.521,.566,.625,.665,.659,.688, c & .743,.813,.886,.947,1.138,1.377,1.896/ @@ -318,8 +318,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & edt(i) = 0. edto(i) = 0. edtx(i) = 0. -! acrt(i) = 0. -! acrtfct(i) = 1. + acrt(i) = 0. + acrtfct(i) = 1. aa1(i) = 0. aa2(i) = 0. xaa0(i) = 0. @@ -395,9 +395,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo endif c -! do k = 1, 15 -! acrit(k) = acritt(k) * (975. - pcrit(k)) -! enddo + do k = 1, 15 + acrit(k) = acritt(k) * (975. - pcrit(k)) + enddo ! dt2 = delt ! val = 1200. @@ -1246,7 +1246,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! aa1(i) = 0. qcko(i,kb(i)) = qo(i,kb(i)) qrcko(i,kb(i)) = qo(i,kb(i)) -! rhbar(i) = 0. + rhbar(i) = 0. endif enddo !> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water (dellal). @@ -1268,7 +1268,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & cj dq = eta(i,k) * (qcko(i,k) - qrch) c -! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) + rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) c c check if there is excess moisture to release latent heat c @@ -1311,12 +1311,12 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo c -! do i = 1, im -! if(cnvflg(i)) then -! indx = ktcon(i) - kb(i) - 1 -! rhbar(i) = rhbar(i) / float(indx) -! endif -! enddo + do i = 1, im + if(cnvflg(i)) then + indx = ktcon(i) - kb(i) - 1 + rhbar(i) = rhbar(i) / float(indx) + endif + enddo c c calculate cloud work function c @@ -2319,56 +2319,56 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & c c calculate critical cloud work function c -! do i = 1, im -! if(cnvflg(i)) then -! if(pfld(i,ktcon(i)) < pcrit(15))then -! acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) -! & /(975.-pcrit(15)) -! else if(pfld(i,ktcon(i)) > pcrit(1))then -! acrt(i)=acrit(1) -! else -! k = int((850. - pfld(i,ktcon(i)))/50.) + 2 -! k = min(k,15) -! k = max(k,2) -! acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* -! & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) -! endif -! endif -! enddo -! do i = 1, im -! if(cnvflg(i)) then -! if(islimsk(i) == 1) then -! w1 = w1l -! w2 = w2l -! w3 = w3l -! w4 = w4l -! else -! w1 = w1s -! w2 = w2s -! w3 = w3s -! w4 = w4s -! endif + do i = 1, im + if(cnvflg(i)) then + if(pfld(i,ktcon(i)) < pcrit(15))then + acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) + & /(975.-pcrit(15)) + else if(pfld(i,ktcon(i)) > pcrit(1))then + acrt(i)=acrit(1) + else + k = int((850. - pfld(i,ktcon(i)))/50.) + 2 + k = min(k,15) + k = max(k,2) + acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* + & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) + endif + endif + enddo + do i = 1, im + if(cnvflg(i)) then + if(islimsk(i) == 1) then + w1 = w1l + w2 = w2l + w3 = w3l + w4 = w4l + else + w1 = w1s + w2 = w2s + w3 = w3s + w4 = w4s + endif c c modify critical cloud workfunction by cloud base vertical velocity c -! if(pdot(i) <= w4) then -! acrtfct(i) = (pdot(i) - w4) / (w3 - w4) -! elseif(pdot(i) >= -w4) then -! acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) -! else -! acrtfct(i) = 0. -! endif -! val1 = -1. -! acrtfct(i) = max(acrtfct(i),val1) -! val2 = 1. -! acrtfct(i) = min(acrtfct(i),val2) -! acrtfct(i) = 1. - acrtfct(i) -c -c modify acrtfct(i) by colume mean rh if rhbar(i) is greater than 80 percent + if(pdot(i) <= w4) then + acrtfct(i) = (pdot(i) - w4) / (w3 - w4) + elseif(pdot(i) >= -w4) then + acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) + else + acrtfct(i) = 0. + endif + val1 = -1. + acrtfct(i) = max(acrtfct(i),val1) + val2 = 1. + acrtfct(i) = min(acrtfct(i),val2) + acrtfct(i) = 1. - acrtfct(i) c -c if(rhbar(i) >= .8) then -c acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. -c endif +c modify acrtfct(i) by colume mean rh if nhbar(i) is greater than 80 percent + + if(rhbar(i) >= .8) then + acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. + endif c c modify adjustment time scale by cloud base vertical velocity c @@ -2380,8 +2380,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! dtconv(i) = max(dtconv(i),dtmin) ! dtconv(i) = min(dtconv(i),dtmax) c -! endif -! enddo + endif + enddo ! ! compute convective turn-over time ! diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index ab67f849e..081bbf48e 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -287,11 +287,11 @@ subroutine sfc_sice_run & q0 = min(qs1, q0) if (fice(i) < cimin) then - print *,'warning: ice fraction is low:', fice(i) +! print *,'warning: ice fraction is low:', fice(i) fice(i) = cimin tice(i) = tgice tskin(i)= tgice - print *,'fix ice fraction: reset it to:', fice(i) +! print *,'fix ice fraction: reset it to:', fice(i) endif ffw(i) = one - fice(i) @@ -362,9 +362,9 @@ subroutine sfc_sice_run & snowd(i) = min( snowd(i), hsmax ) if (snowd(i) > (2.0_kind_phys*hice(i))) then - print *, 'warning: too much snow :',snowd(i) +! print *, 'warning: too much snow :',snowd(i) snowd(i) = hice(i) + hice(i) - print *,'fix: decrease snow depth to:',snowd(i) +! print *,'fix: decrease snow depth to:',snowd(i) endif endif enddo From 4c7d8ad899116aafe4ff2f02bcce1ff997881483 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 23 Dec 2020 22:12:27 +0000 Subject: [PATCH 162/274] merge with upstream NCAR --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 33c8a984c..566bee9cd 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 +Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d From 08bd983879df9c3e7d491912190170d6dcfb0c56 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 29 Dec 2020 08:53:34 -0700 Subject: [PATCH 163/274] Bugfixes for OpenMP and Zhao-Carr MP in physics/GFS_phys_time_vary.fv3.{F90,meta} --- physics/GFS_phys_time_vary.fv3.F90 | 8 ++++++-- physics/GFS_rad_time_vary.fv3.meta | 12 ++++++------ 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 71e0dbf3e..1c3f2cf45 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -92,7 +92,7 @@ subroutine GFS_phys_time_vary_init ( if (is_initialized) return !$OMP parallel num_threads(nthrds) default(none) & -!$OMP shared (me,master,ntoz,h2o_phys,im) & +!$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,idate) & !$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres,ozpl) & !$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & @@ -177,7 +177,11 @@ subroutine GFS_phys_time_vary_init ( ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif -!$OMP barrier +!$OMP end sections + +! Need an OpenMP barrier here (implicit in "end sections") + +!$OMP sections !$OMP section !> - Call setindxoz() to initialize ozone data diff --git a/physics/GFS_rad_time_vary.fv3.meta b/physics/GFS_rad_time_vary.fv3.meta index 4c8f8362c..ffe33810c 100644 --- a/physics/GFS_rad_time_vary.fv3.meta +++ b/physics/GFS_rad_time_vary.fv3.meta @@ -164,18 +164,18 @@ intent = inout optional = F [t_1delt] - standard_name = water_vapor_specific_humidity_two_timesteps_back - long_name = water vapor specific humidity two timesteps back - units = kg kg-1 + standard_name = air_temperature_at_previous_timestep + long_name = air temperature at previous timestep + units = K dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = inout optional = F [qv_2delt] - standard_name = air_temperature_at_previous_timestep - long_name = air temperature at previous timestep - units = K + standard_name = water_vapor_specific_humidity_two_timesteps_back + long_name = water vapor specific humidity two timesteps back + units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys From 7107b4970af1aa39d4a908030767b5bbaab51efe Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 29 Dec 2020 09:38:59 -0700 Subject: [PATCH 164/274] Remove unused num_p2d = array_dimension_of_2d_arrays_for_microphysics from physics/GFS_rrtmg_setup.{F90,meta} --- physics/GFS_rrtmg_setup.F90 | 15 +++++++-------- physics/GFS_rrtmg_setup.meta | 8 -------- 2 files changed, 7 insertions(+), 16 deletions(-) diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index 920b6465e..85ffe7d67 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -43,13 +43,13 @@ module GFS_rrtmg_setup !! \section arg_table_GFS_rrtmg_setup_init Argument Table !! \htmlinclude GFS_rrtmg_setup_init.html !! - subroutine GFS_rrtmg_setup_init ( & - si, levr, ictm, isol, ico2, iaer, ialb, iems, ntcw, num_p2d, & - num_p3d, npdf3d, ntoz, iovr, isubc_sw, isubc_lw, & - icliq_sw, crick_proof, ccnorm, & - imp_physics, & - norad_precip, idate, iflip, & - im, faerlw, faersw, aerodp, & ! for consistency checks + subroutine GFS_rrtmg_setup_init ( & + si, levr, ictm, isol, ico2, iaer, ialb, iems, ntcw, & + num_p3d, npdf3d, ntoz, iovr, isubc_sw, isubc_lw, & + icliq_sw, crick_proof, ccnorm, & + imp_physics, & + norad_precip, idate, iflip, & + im, faerlw, faersw, aerodp, & ! for consistency checks me, errmsg, errflg) ! ================= subprogram documentation block ================ ! ! ! @@ -174,7 +174,6 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: ialb integer, intent(in) :: iems integer, intent(in) :: ntcw - integer, intent(in) :: num_p2d integer, intent(in) :: num_p3d integer, intent(in) :: npdf3d integer, intent(in) :: ntoz diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index cfd6e6e9e..e0019b4c5 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -80,14 +80,6 @@ type = integer intent = in optional = F -[num_p2d] - standard_name = array_dimension_of_2d_arrays_for_microphysics - long_name = number of 2D arrays needed for microphysics - units = count - dimensions = () - type = integer - intent = in - optional = F [num_p3d] standard_name = array_dimension_of_3d_arrays_for_microphysics long_name = number of 3D arrays needed for microphysics From b52215c3eddeb0ff2d13d373b1d67cd5b62ba499 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 29 Dec 2020 17:17:17 +0000 Subject: [PATCH 165/274] Add machine(kind_physics) ti init. --- physics/sfc_noahmp_drv.f | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index e44aac872..ac6eff462 100644 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -27,6 +27,7 @@ module noahmpdrv subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & errmsg, errflg) + use machine, only: kind_phys use set_soilveg_mod, only: set_soilveg use namelist_soilveg From 0bc4b34fb810ec594d10fc8886fc70932bf11a57 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 29 Dec 2020 21:03:19 +0000 Subject: [PATCH 166/274] Remove tracer_sanitizer* --- physics/tracer_sanitizer.F90 | 113 ------------------------------- physics/tracer_sanitizer.meta | 124 ---------------------------------- 2 files changed, 237 deletions(-) delete mode 100644 physics/tracer_sanitizer.F90 delete mode 100644 physics/tracer_sanitizer.meta diff --git a/physics/tracer_sanitizer.F90 b/physics/tracer_sanitizer.F90 deleted file mode 100644 index 668cf6edd..000000000 --- a/physics/tracer_sanitizer.F90 +++ /dev/null @@ -1,113 +0,0 @@ -module tracer_sanitizer - - use machine, only : kind_phys - - implicit none - - private - - public :: tracer_sanitizer_init, tracer_sanitizer_run, tracer_sanitizer_finalize - - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys - real(kind=kind_phys), parameter :: qvmin = 1.0E-6_kind_phys - -contains - - subroutine tracer_sanitizer_init() - end subroutine tracer_sanitizer_init - -!> \section arg_table_tracer_sanitizer_run Argument Table -!! \htmlinclude tracer_sanitizer_run.html -!! - subroutine tracer_sanitizer_run(tracers, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, & - ntlnc, ntinc, ntrnc, ntsnc, ntgnc, errmsg, errflg) - - ! Interface variables - integer, intent(in ) :: ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, & - ntlnc, ntinc, ntrnc, ntsnc, ntgnc - real(kind=kind_phys), intent(inout) :: tracers(:,:,:) - character(len=*), intent( out) :: errmsg - integer, intent( out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Water vapor specific humidity - if (ntqv>0) then - where (tracers(:,:,ntqv)0) then - where (tracers(:,:,ntcw)0) then - where (tracers(:,:,ntlnc)==zero) - tracers(:,:,ntlnc)=zero - end where - end if - end if - - ! Ice water - if (ntiw>0) then - where (tracers(:,:,ntiw)0) then - where (tracers(:,:,ntinc)==zero) - tracers(:,:,ntinc)=zero - end where - end if - end if - - ! Rain water - if (ntrw>0) then - where (tracers(:,:,ntrw)0) then - where (tracers(:,:,ntrnc)==zero) - tracers(:,:,ntrnc)=zero - end where - end if - end if - - ! Snow - if (ntsw>0) then - where (tracers(:,:,ntsw)0) then - where (tracers(:,:,ntsnc)==zero) - tracers(:,:,ntsnc)=zero - end where - end if - end if - - ! Graupel - if (ntgl>0) then - where (tracers(:,:,ntgl)0) then - where (tracers(:,:,ntgnc)==zero) - tracers(:,:,ntgnc)=zero - end where - end if - end if - - end subroutine tracer_sanitizer_run - - subroutine tracer_sanitizer_finalize() - end subroutine tracer_sanitizer_finalize - -end module tracer_sanitizer \ No newline at end of file diff --git a/physics/tracer_sanitizer.meta b/physics/tracer_sanitizer.meta deleted file mode 100644 index e41d5d03d..000000000 --- a/physics/tracer_sanitizer.meta +++ /dev/null @@ -1,124 +0,0 @@ -[ccpp-table-properties] - name = tracer_sanitizer - type = scheme - dependencies = machine.F - -######################################################################## - -[ccpp-arg-table] - name = tracer_sanitizer_run - type = scheme -[tracers] - standard_name = tracer_concentration_updated_by_physics - long_name = tracer concentration updated by physics - units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) - type = real - kind = kind_phys - intent = inout - optional = F -[ntqv] - standard_name = index_for_water_vapor - long_name = tracer index for water vapor (specific humidity) - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntcw] - standard_name = index_for_liquid_cloud_condensate - long_name = tracer index for cloud condensate (or liquid water) - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntiw] - standard_name = index_for_ice_cloud_condensate - long_name = tracer index for ice water - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntrw] - standard_name = index_for_rain_water - long_name = tracer index for rain water - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntsw] - standard_name = index_for_snow_water - long_name = tracer index for snow water - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntgl] - standard_name = index_for_graupel - long_name = tracer index for graupel - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntlnc] - standard_name = index_for_liquid_cloud_number_concentration - long_name = tracer index for liquid number concentration - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntinc] - standard_name = index_for_ice_cloud_number_concentration - long_name = tracer index for ice number concentration - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntrnc] - standard_name = index_for_rain_number_concentration - long_name = tracer index for rain number concentration - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntsnc] - standard_name = index_for_snow_number_concentration - long_name = tracer index for snow number concentration - units = index - dimensions = () - type = integer - intent = in - optional = F -[ntgnc] - standard_name = index_for_graupel_number_concentration - long_name = tracer index for graupel number concentration - units = index - dimensions = () - type = integer - intent = in - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F From 1eebface86c4a134e742bf15c2ce1de3eb6462f3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 30 Dec 2020 08:19:26 -0700 Subject: [PATCH 167/274] Remove reset of diagnostic buckets from GFS_suite_interstitial.{F90,meta} --- physics/GFS_suite_interstitial.F90 | 33 ++++------------------------- physics/GFS_suite_interstitial.meta | 16 -------------- 2 files changed, 4 insertions(+), 45 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index eb7f9789f..c465f74e7 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -14,43 +14,24 @@ end subroutine GFS_suite_interstitial_rad_reset_finalize !> \section arg_table_GFS_suite_interstitial_rad_reset_run Argument Table !! \htmlinclude GFS_suite_interstitial_rad_reset_run.html !! - subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, Diag, Model, errmsg, errflg) + subroutine GFS_suite_interstitial_rad_reset_run (Interstitial, Model, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_diag_type, GFS_interstitial_type + use GFS_typedefs, only: GFS_control_type, GFS_interstitial_type implicit none ! interface variables type(GFS_interstitial_type), intent(inout) :: Interstitial - type(GFS_diag_type), intent(inout) :: Diag type(GFS_control_type), intent(in) :: Model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - ! local variables - real(kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind_phys) :: sec_zero - integer :: kdt_rad - errmsg = '' errflg = 0 call Interstitial%rad_reset(Model) - !--- determine if radiation diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 1) then - call Diag%rad_zero(Model) - endif - else - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt,kdt_rad) == 1) then - call Diag%rad_zero(Model) - endif - endif - end subroutine GFS_suite_interstitial_rad_reset_run end module GFS_suite_interstitial_rad_reset @@ -69,16 +50,15 @@ end subroutine GFS_suite_interstitial_phys_reset_finalize !> \section arg_table_GFS_suite_interstitial_phys_reset_run Argument Table !! \htmlinclude GFS_suite_interstitial_phys_reset_run.html !! - subroutine GFS_suite_interstitial_phys_reset_run (Interstitial, Diag, Model, errmsg, errflg) + subroutine GFS_suite_interstitial_phys_reset_run (Interstitial, Model, errmsg, errflg) use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_diag_type, GFS_interstitial_type + use GFS_typedefs, only: GFS_control_type, GFS_interstitial_type implicit none ! interface variables type(GFS_interstitial_type), intent(inout) :: Interstitial - type(GFS_diag_type), intent(inout) :: Diag type(GFS_control_type), intent(in) :: Model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -88,11 +68,6 @@ subroutine GFS_suite_interstitial_phys_reset_run (Interstitial, Diag, Model, err call Interstitial%phys_reset(Model) - !--- determine if physics diagnostics buckets need to be cleared - if (mod(Model%kdt,Model%nszero) == 1) then - call Diag%phys_zero(Model) - endif - end subroutine GFS_suite_interstitial_phys_reset_run end module GFS_suite_interstitial_phys_reset diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 89b727c9b..fdf1716f1 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -15,14 +15,6 @@ type = GFS_interstitial_type intent = inout optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = derived type GFS_diag_type in FV3 - units = DDT - dimensions = () - type = GFS_diag_type - intent = inout - optional = F [Model] standard_name = GFS_control_type_instance long_name = Fortran DDT containing FV3-GFS model control parameters @@ -67,14 +59,6 @@ type = GFS_interstitial_type intent = inout optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = derived type GFS_diag_type in FV3 - units = DDT - dimensions = () - type = GFS_diag_type - intent = inout - optional = F [Model] standard_name = GFS_control_type_instance long_name = Fortran DDT containing FV3-GFS model control parameters From e11fb718bd8ad5f2ad111347baeac3b40417e0bf Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 30 Dec 2020 15:34:16 -0700 Subject: [PATCH 168/274] Bugfix in physics/GFS_phys_time_vary.fv3.{F90,meta}, correct intent of variabale 'rann' --- physics/GFS_phys_time_vary.fv3.F90 | 2 +- physics/GFS_phys_time_vary.fv3.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 1c3f2cf45..8f0bc50d9 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -296,7 +296,7 @@ subroutine GFS_phys_time_vary_timestep_init ( integer, intent(in) :: imap(:), jmap(:) real(kind_phys), intent(in) :: prsl(:,:) integer, intent(in) :: seed0 - real(kind_phys), intent(out) :: rann(:,:) + real(kind_phys), intent(inout) :: rann(:,:) ! For gcycle only integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil integer, intent(in) :: lsoil_lsm, kice, ialb, isot, ivegsrc diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 0258e084f..7ae6b4948 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -789,7 +789,7 @@ dimensions = (horizontal_dimension,array_dimension_of_random_number) type = real kind = kind_phys - intent = out + intent = inout optional = F [nthrds] standard_name = omp_threads From f18c4ef6a46c479ac8d2cc725bba77e9b88bbff0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 30 Dec 2020 15:35:57 -0700 Subject: [PATCH 169/274] Bugfix in physics/GFS_rrtmgp_setup.{F90,meta}, rename _run to _timestep_init --- physics/GFS_rrtmgp_setup.F90 | 19 ++++++++++--------- physics/GFS_rrtmgp_setup.meta | 2 +- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index a32f96ccf..308456e06 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -13,7 +13,7 @@ module GFS_rrtmgp_setup iaermdl, ialbflg, iemsflg, ivflip implicit none - public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_run, GFS_rrtmgp_setup_finalize + public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_timestep_init, GFS_rrtmgp_setup_finalize ! Version tag and last revision date character(40), parameter :: & @@ -27,7 +27,7 @@ module GFS_rrtmgp_setup logical :: & is_initialized = .false. ! Control flag for the first time of reading climatological ozone data - ! (set/reset in subroutines GFS_rrtmgp_setup_init/GFS_rrtmgp_setuup_run, it is used only if + ! (set/reset in subroutines GFS_rrtmgp_setup_init/GFS_rrtmgp_setup_timestep_init, it is used only if ! the control parameter ioznflg=0) logical :: loz1st = .true. @@ -151,13 +151,13 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics end subroutine GFS_rrtmgp_setup_init ! ######################################################################################### - ! SUBROUTINE GFS_rrtmgp_setup_run + ! SUBROUTINE GFS_rrtmgp_setup_timestep_init ! ######################################################################################### -!> \section arg_table_GFS_rrtmgp_setup_run -!! \htmlinclude GFS_rrtmgp_setup_run.html +!> \section arg_table_GFS_rrtmgp_setup_timestep_init +!! \htmlinclude GFS_rrtmgp_setup_timestep_init.html !! - subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & - slag, sdec, cdec, solcon, errmsg, errflg) + subroutine GFS_rrtmgp_setup_timestep_init (idate, jdate, deltsw, deltim, lsswr, me, & + slag, sdec, cdec, solcon, errmsg, errflg) ! Inputs integer, intent(in) :: idate(:) @@ -188,7 +188,7 @@ subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & ! Check initialization state if (.not.is_initialized) then - write(errmsg, fmt='((a))') 'GFS_rrtmgp_setup_run called before GFS_rrtmgp_setup_init' + write(errmsg, fmt='((a))') 'GFS_rrtmgp_setup_timestep_init called before GFS_rrtmgp_setup_init' errflg = 1 return end if @@ -251,7 +251,7 @@ subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & if ( loz1st ) loz1st = .false. return - end subroutine GFS_rrtmgp_setup_run + end subroutine GFS_rrtmgp_setup_timestep_init ! ######################################################################################### ! SUBROUTINE GFS_rrtmgp_setup_finalize @@ -273,4 +273,5 @@ subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) is_initialized = .false. end subroutine GFS_rrtmgp_setup_finalize + end module GFS_rrtmgp_setup diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index fb31f5c7a..9a1d302ac 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -260,7 +260,7 @@ ######################################################################## [ccpp-arg-table] - name = GFS_rrtmgp_setup_run + name = GFS_rrtmgp_setup_timestep_init type = scheme [idate] standard_name = date_and_time_at_model_initialization From c90a4d1c0322f4b4a6c37a382695a272d42eb4d6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 31 Dec 2020 09:42:06 -0700 Subject: [PATCH 170/274] Remove additional/unnecessary SIMD instruction sets from CMakeLists.txt --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2f8b7e9d6..7efe7bb5f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -180,7 +180,7 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") string(REPLACE "-xCORE-AVX2" "-xCORE-AVX-I" CMAKE_Fortran_FLAGS_LOPT1 "${CMAKE_Fortran_FLAGS_LOPT1}") - string(REPLACE "-axSSE4.2,AVX,CORE-AVX2,CORE-AVX512" "-axSSE4.2,AVX,CORE-AVX-I" + string(REPLACE "-axSSE4.2,CORE-AVX2" "-axSSE4.2,CORE-AVX-I" CMAKE_Fortran_FLAGS_LOPT1 "${CMAKE_Fortran_FLAGS_LOPT1}") SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f From ddace04d7d2137a866a28b18ed3755232cbcfd19 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 5 Jan 2021 09:53:32 -0700 Subject: [PATCH 171/274] switch modulo calls for time intervals to 0 from 1 --- physics/GFS_phys_time_vary.scm.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 5fcc9ed84..be62e5052 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -353,18 +353,18 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, !--- determine if diagnostics buckets need to be cleared sec_zero = nint(Model%fhzero*con_hr) if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 1) then + if (mod(Model%kdt,Model%nszero) == 0) then call Diag%rad_zero (Model) call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif else - if (mod(Model%kdt,Model%nszero) == 1) then + if (mod(Model%kdt,Model%nszero) == 0) then call Diag%phys_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 1) then + if (mod(Model%kdt, kdt_rad) == 0) then call Diag%rad_zero (Model) !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED endif From 3750b6b1c45eb56807668a34b230eaaa62d97e59 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Wed, 6 Jan 2021 15:38:27 +0000 Subject: [PATCH 172/274] add cloud perturbations and clean up radiation perturbations --- physics/GFS_MP_generic.F90 | 10 +--- physics/GFS_MP_generic.meta | 34 -------------- physics/GFS_debug.F90 | 2 +- physics/GFS_rrtmg_pre.F90 | 73 ++++++++++++++++++++++++++--- physics/GFS_rrtmg_pre.meta | 26 ++++++++++ physics/GFS_stochastics.F90 | 32 +++++++------ physics/GFS_stochastics.meta | 19 ++++++-- physics/GFS_suite_interstitial.F90 | 5 +- physics/GFS_suite_interstitial.meta | 9 ---- physics/GFS_surface_generic.F90 | 8 +--- physics/GFS_surface_generic.meta | 25 ---------- physics/dcyc2.f | 30 +++++++++--- physics/dcyc2.meta | 22 +++++++-- 13 files changed, 170 insertions(+), 125 deletions(-) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 435a80509..672be5ba6 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -89,7 +89,7 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_qv, rain0, ice0, snow0, & graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp, totprcp, totice, & totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & - do_sppt, ca_global, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & + drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, errmsg, errflg) ! use machine, only: kind_phys @@ -119,9 +119,6 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, real(kind=kind_phys), dimension(:,:), intent(inout) :: dq3dt ! only if ldiag3d and qdiag3d ! Stochastic physics / surface perturbations - logical, intent(in) :: do_sppt, ca_global - real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdtr - real(kind=kind_phys), dimension(im,levs), intent(in) :: dtdtc real(kind=kind_phys), dimension(im), intent(inout) :: drain_cpl real(kind=kind_phys), dimension(im), intent(inout) :: dsnow_cpl @@ -391,11 +388,6 @@ subroutine GFS_MP_generic_post_run(im, levs, kdt, nrcm, ncld, nncl, ntcw, ntrac, pwat(i) = pwat(i) * onebg enddo - ! Stochastic physics / surface perturbations - if (do_sppt .or. ca_global) then -!--- radiation heating rate - dtdtr(1:im,:) = dtdtr(1:im,:) + dtdtc(1:im,:)*dtf - endif end subroutine GFS_MP_generic_post_run !> @} diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 981f5478d..c42b12c31 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -728,40 +728,6 @@ kind = kind_phys intent = inout optional = F -[do_sppt] - standard_name = flag_for_stochastic_physics_perturbations - long_name = flag for stochastic physics perturbations - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ca_global] - standard_name = flag_for_global_cellular_automata - long_name = switch for global ca - units = flag - dimensions = () - type = logical - intent = in - optional = F -[dtdtr] - standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step - long_name = temp. change due to radiative heating per time step - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[dtdtc] - standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky - long_name = clear sky radiative (shortwave + longwave) heating rate at current time - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [drain_cpl] standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling long_name = change in rain_cpl (coupling_type) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index b5066637d..0b90f2ade 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -534,7 +534,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%acvt' , Tbd%acvt) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%hpbl' , Tbd%hpbl) if (Model%do_sppt) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dtdtr' , Tbd%dtdtr) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dtdtnp' , Tbd%dtdtnp) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dtotprcp' , Tbd%dtotprcp) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Tbd%dcnvprcp' , Tbd%dcnvprcp) end if diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 109df3b65..524a34b26 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -26,8 +26,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ltaerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf, lmfshal, & lmfdeep2, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, tsfc, slmsk, & - prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, & - cnvw_in, cnvc_in, qgrs, aer_nm, dx, icloud, & !inputs from here and above + prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, pert_clds,sppt_wts,& + sppt_amp, cnvw_in, cnvc_in, qgrs, aer_nm, dx, icloud, & !inputs from here and above coszen, coszdg, effrl_inout, effri_inout, effrs_inout, & clouds1, clouds2, clouds3, clouds4, clouds5, & !in/out from here and above kd, kt, kb, mtopa, mbota, raddt, tsfg, tsfa, de_lgth, alb1d, delp, dz, & !output from here and below @@ -65,7 +65,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & & profsw_type, NBDSW use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW - use surface_perturbation, only: cdfnor + use surface_perturbation, only: cdfnor,ppfbet ! For Thompson MP use module_mp_thompson, only: calc_effectRad, Nt_c @@ -97,9 +97,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & logical, intent(in) :: lsswr, lslwr, ltaerosol, lgfdlmprad, & uni_cld, effr_in, do_mynnedmf, & - lmfshal, lmfdeep2 + lmfshal, lmfdeep2, pert_clds - real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian + real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp real(kind=kind_phys), intent(in) :: eps, epsm1, fvirt, rog, rocp, con_rd real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & @@ -109,7 +109,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, prslk, & tgrs, sfc_wts, & mg_cld, effrr_in, & - cnvw_in, cnvc_in + cnvw_in, cnvc_in, & + sppt_wts real(kind=kind_phys), dimension(:,:,:), intent(in) :: qgrs, aer_nm @@ -182,7 +183,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(im,lm+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & - dzb, hzb, cldcov, deltaq, cnvc, cnvw, & + dzb, hzb, cldcov, deltaq, cnvc, cnvw, & effrl, effri, effrr, effrs, rho, orho, plyrpa ! for Thompson MP @@ -200,6 +201,11 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(im,lm+LTP,NF_VGAS) :: gasvmr real(kind=kind_phys), dimension(im,lm+LTP,NBDSW,NF_AESW) :: faersw real(kind=kind_phys), dimension(im,lm+LTP,NBDLW,NF_AELW) :: faerlw + + ! for stochastic cloud perturbations + real(kind=kind_phys), dimension(im) :: cldp1d + real (kind=kind_phys) :: alpha0,beta0,m,s,cldtmp,tmp_wt,cdfz + integer :: iflag integer :: ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -932,6 +938,34 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK) endif +! perturb cld cover + !if (pert_clds) then + ! cldp1d(:) = 0. + ! do i=1,im + ! tmp_wt= -1*log( ( 2.0 / ( sppt_wts(i,38) ) ) - 1 ) + ! call cdfnor(tmp_wt,cdfz) + ! cldp1d(i) = cdfz + ! enddo + ! do i = 1, IM + ! do k = 1, LM + ! ! compute beta distribution parameters + ! m = cldcov(i,k+kd) + ! if (m<0.99 .AND. m > 0.01) then + ! s = sppt_amp*m*(1.-m) + ! alpha0 = m*m*(1.-m)/(s*s)-m + ! beta0 = alpha0*(1.-m)/m + ! ! compute beta distribution value corresponding + ! ! to the given percentile albPpert to use as new albedo + ! call ppfbet(cldp1d(i),alpha0,beta0,iflag,cldtmp) + ! cldcov(i,k+kd) = cldtmp + ! else + ! cldcov(i,k+kd) = m + ! endif + ! enddo ! end_do_i_loop + ! enddo ! end_do_k_loop + !endif + !print*,'after cld perts',minval(cldcov),maxval(cldcov) + if (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_mg) then ! zhao/moorthi's prognostic cloud scheme ! or unified cloud and/or with MG microphysics @@ -1038,6 +1072,31 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ! endif ! end_if_ntcw +! perturb cld cover + if (pert_clds) then + do i=1,im + tmp_wt= -1*log( ( 2.0 / ( sppt_wts(i,38) ) ) - 1 ) + call cdfnor(tmp_wt,cdfz) + cldp1d(i) = cdfz + enddo + do k = 1, LMK + do i = 1, IM + ! compute beta distribution parameters + m = clouds(i,k,1) + if (m<0.99 .AND. m > 0.01) then + s = sppt_amp*m*(1.-m) + alpha0 = m*m*(1.-m)/(s*s)-m + beta0 = alpha0*(1.-m)/m + ! compute beta distribution value corresponding + ! to the given percentile albPpert to use as new albedo + call ppfbet(cldp1d(i),alpha0,beta0,iflag,cldtmp) + clouds(i,k,1) = cldtmp + else + clouds(i,k,1) = m + endif + enddo ! end_do_i_loop + enddo ! end_do_k_loop + endif do k = 1, LMK do i = 1, IM clouds1(i,k) = clouds(i,k,1) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index eaa878ee7..14403f63d 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -395,6 +395,32 @@ type = logical intent = in optional = F +[sppt_wts] + standard_name = weights_for_stochastic_sppt_perturbation + long_name = weights for stochastic sppt perturbation + units = none + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sppt_amp] + standard_name = total_ampltiude_of_sppt_perturbation + long_name = toal ampltidue of stochastic sppt perturbation + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[pert_clds] + standard_name = flag_for_stochastic_cloud_fraction_perturbations + long_name = flag for stochastic cloud fraction physics perturbations + units = flag + dimensions = () + type = logical + intent = in + optional = F [do_mynnedmf] standard_name = do_mynnedmf long_name = flag to activate MYNN-EDMF diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index b125f881d..a3b4f30cf 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -26,13 +26,13 @@ end subroutine GFS_stochastics_finalize !! -# defines random seed indices for radiation (in a reproducible way) !! -# interpolates coefficients for prognostic ozone calculation !! -# performs surface data cycling via the GFS gcycle routine - subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, & + subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblck, & do_shum ,do_skeb, do_ca,ca_global,ca1,si,vfact_ca, & zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,& sppt_wts_inv, skebu_wts_inv, skebv_wts_inv, & shum_wts_inv, diss_est, ugrs, vgrs, tgrs, qgrs_wv, & qgrs_cw, qgrs_rw, qgrs_sw, qgrs_iw, qgrs_gl, & - gu0, gv0, gt0, gq0_wv, dtdtr, & + gu0, gv0, gt0, gq0_wv, dtdtnp, & gq0_cw, gq0_rw, gq0_sw, gq0_iw, gq0_gl, & rain, rainc, tprcp, totprcp, cnvprcp, & totprcpb, cnvprcpb, cplflx, & @@ -47,8 +47,9 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, integer, intent(in) :: im integer, intent(in) :: km integer, intent(in) :: kdt + real(kind_phys), intent(in) :: delt logical, intent(in) :: do_sppt - logical, intent(in) :: do_pertmp + logical, intent(in) :: pert_mp logical, intent(in) :: do_ca logical, intent(in) :: ca_global logical, intent(in) :: use_zmtnblck @@ -91,8 +92,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, integer, intent(in) :: ntsw integer, intent(in) :: ntiw integer, intent(in) :: ntgl - ! dtdtr only allocated if do_sppt == .true. - real(kind_phys), dimension(:,:), intent(in) :: dtdtr + real(kind_phys), dimension(1:im,1:km), intent(inout) :: dtdtnp real(kind_phys), dimension(1:im), intent(in) :: rain real(kind_phys), dimension(1:im), intent(in) :: rainc real(kind_phys), dimension(1:im), intent(inout) :: tprcp @@ -149,7 +149,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, upert = (gu0(i,k) - ugrs(i,k)) * sppt_wts(i,k) vpert = (gv0(i,k) - vgrs(i,k)) * sppt_wts(i,k) - tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * sppt_wts(i,k) + tpert = (gt0(i,k) - tgrs(i,k) - (delt*dtdtnp(i,k))) * sppt_wts(i,k) qpert = (gq0_wv(i,k) - qgrs_wv(i,k)) * sppt_wts(i,k) gu0(i,k) = ugrs(i,k)+upert @@ -159,11 +159,11 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, qnew = qgrs_wv(i,k)+qpert if (qnew >= 1.0e-10) then gq0_wv(i,k) = qnew - gt0(i,k) = tgrs(i,k) + tpert + dtdtr(i,k) + gt0(i,k) = tgrs(i,k) + tpert + (delt*dtdtnp(i,k)) endif - if (do_pertmp) then + if (pert_mp) then if (ntcw>0) then - qpert = gq0_cw(i,k) - qgrs_cw(i,k) * sppt_wts(i,k) + qpert = (gq0_cw(i,k) - qgrs_cw(i,k)) * sppt_wts(i,k) qnew = qgrs_cw(i,k)+qpert gq0_cw(i,k) = qnew if (qnew < 0.0) then @@ -171,7 +171,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, endif endif if (ntrw>0) then - qpert = gq0_rw(i,k) - qgrs_rw(i,k) * sppt_wts(i,k) + qpert = (gq0_rw(i,k) - qgrs_rw(i,k)) * sppt_wts(i,k) qnew = qgrs_rw(i,k)+qpert gq0_rw(i,k) = qnew if (qnew < 0.0) then @@ -179,7 +179,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, endif endif if (ntsw>0) then - qpert = gq0_sw(i,k) - qgrs_sw(i,k) * sppt_wts(i,k) + qpert = (gq0_sw(i,k) - qgrs_sw(i,k)) * sppt_wts(i,k) qnew = qgrs_sw(i,k)+qpert gq0_sw(i,k) = qnew if (qnew < 0.0) then @@ -187,7 +187,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, endif endif if (ntiw>0) then - qpert = gq0_iw(i,k) - qgrs_iw(i,k) * sppt_wts(i,k) + qpert = (gq0_iw(i,k) - qgrs_iw(i,k)) * sppt_wts(i,k) qnew = qgrs_iw(i,k)+qpert gq0_iw(i,k) = qnew if (qnew < 0.0) then @@ -195,7 +195,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, endif endif if (ntgl>0) then - qpert = gq0_gl(i,k) - qgrs_gl(i,k) * sppt_wts(i,k) + qpert = (gq0_gl(i,k) - qgrs_gl(i,k)) * sppt_wts(i,k) qnew = qgrs_gl(i,k)+qpert gq0_gl(i,k) = qnew if (qnew < 0.0) then @@ -219,6 +219,8 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:) snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:) endif +!zero out radiative heating tendency for next physics step + dtdtnp(:,:)=0.0 endif @@ -262,7 +264,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, upert = (gu0(i,k) - ugrs(i,k)) * ca(i,k) vpert = (gv0(i,k) - vgrs(i,k)) * ca(i,k) - tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * ca(i,k) + tpert = (gt0(i,k) - tgrs(i,k) - (delt*dtdtnp(i,k))) * ca(i,k) qpert = (gq0_wv(i,k) - qgrs_wv(i,k)) * ca(i,k) gu0(i,k) = ugrs(i,k)+upert gv0(i,k) = vgrs(i,k)+vpert @@ -270,7 +272,7 @@ subroutine GFS_stochastics_run (im, km, kdt, do_sppt, do_pertmp, use_zmtnblck, qnew = qgrs_wv(i,k)+qpert if (qnew >= 1.0e-10) then gq0_wv(i,k) = qnew - gt0(i,k) = tgrs(i,k) + tpert + dtdtr(i,k) + gt0(i,k) = tgrs(i,k) + tpert + (delt*dtdtnp(i,k)) endif enddo enddo diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index aae5868d1..26dcfd47e 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -31,6 +31,15 @@ type = integer intent = in optional = F +[delt] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [ntcw] standard_name = index_for_liquid_cloud_condensate long_name = tracer index for cloud condensate (or liquid water) @@ -79,7 +88,7 @@ type = logical intent = in optional = F -[do_pertmp] +[pert_mp] standard_name = flag_for_stochastic_microphysics_perturbations long_name = flag for stochastic microphysics physics perturbations units = flag @@ -406,10 +415,10 @@ kind = kind_phys intent = inout optional = F -[dtdtr] - standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step - long_name = temp. change due to radiative heating per time step - units = K +[dtdtnp] + standard_name = tendency_of_air_temperature_to_withold_from_sppt + long_name = temp. change from physics that should not be perturbed by sppt + units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 62efa00d5..3ae660f81 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -85,7 +85,7 @@ end subroutine GFS_suite_interstitial_1_finalize !! \htmlinclude GFS_suite_interstitial_1_run.html !! subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, dtf, dtp, slmsk, area, dxmin, dxinv, pgr, & - islmsk, work1, work2, psurf, dudt, dvdt, dtdt, dtdtc, dqdt, errmsg, errflg) + islmsk, work1, work2, psurf, dudt, dvdt, dtdt, dqdt, errmsg, errflg) use machine, only: kind_phys @@ -98,7 +98,7 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, dtf, dtp, slmsk, area, integer, intent(out), dimension(im) :: islmsk real(kind=kind_phys), intent(out), dimension(im) :: work1, work2, psurf - real(kind=kind_phys), intent(out), dimension(im,levs) :: dudt, dvdt, dtdt, dtdtc + real(kind=kind_phys), intent(out), dimension(im,levs) :: dudt, dvdt, dtdt real(kind=kind_phys), intent(out), dimension(im,levs,ntrac) :: dqdt real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys character(len=*), intent(out) :: errmsg @@ -125,7 +125,6 @@ subroutine GFS_suite_interstitial_1_run (im, levs, ntrac, dtf, dtp, slmsk, area, dudt(i,k) = zero dvdt(i,k) = zero dtdt(i,k) = zero - dtdtc(i,k) = zero enddo enddo do n=1,ntrac diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index fdf1716f1..c09d02434 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -244,15 +244,6 @@ kind = kind_phys intent = out optional = F -[dtdtc] - standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky - long_name = clear sky radiative (shortwave + longwave) heating rate at current time - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F [dqdt] standard_name = tendency_of_tracers_due_to_model_physics long_name = updated tendency of the tracers diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index e7a81b7c4..483eccdf8 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -26,7 +26,7 @@ end subroutine GFS_surface_generic_pre_finalize !! subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, & - sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, ca_global,dtdtr,& + sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, & drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & lndp_var_list, lndp_prt_list, & z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, sfc_wts_inv, & @@ -51,8 +51,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, tsurf, zlvl ! Stochastic physics / surface perturbations - logical, intent(in) :: do_sppt, ca_global - real(kind=kind_phys), dimension(im,levs), intent(out) :: dtdtr real(kind=kind_phys), dimension(im), intent(out) :: drain_cpl real(kind=kind_phys), dimension(im), intent(out) :: dsnow_cpl real(kind=kind_phys), dimension(im), intent(in) :: rain_cpl @@ -100,10 +98,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, errmsg = '' errflg = 0 - ! Set initial quantities for stochastic physics deltas - if (do_sppt .or. ca_global) then - dtdtr = 0.0 - endif ! Scale random patterns for surface perturbations with perturbation size ! Turn vegetation fraction pattern into percentile pattern diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index 44e4f7f68..d4c8b1bca 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -188,31 +188,6 @@ kind = kind_phys intent = inout optional = F -[do_sppt] - standard_name = flag_for_stochastic_physics_perturbations - long_name = flag for stochastic physics perturbations - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ca_global] - standard_name = flag_for_global_cellular_automata - long_name = switch for global ca - units = flag - dimensions = () - type = logical - intent = in - optional = F -[dtdtr] - standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step - long_name = temp. change due to radiative heating per time step - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F [drain_cpl] standard_name = tendency_of_lwe_thickness_of_precipitation_amount_for_coupling long_name = change in rain_cpl (coupling_type) diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 389496d07..c8ef077f8 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -48,7 +48,7 @@ end subroutine dcyc2t3_finalize ! im, levs, deltim, fhswr, ! ! dry, icy, wet ! ! input/output: ! -! dtdt,dtdtc, ! +! dtdt,dtdtnp, ! ! outputs: ! ! adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, ! ! adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, ! @@ -100,8 +100,7 @@ end subroutine dcyc2t3_finalize ! input/output: ! ! dtdt(im,levs)- real, model time step adjusted total radiation ! ! heating rates ( k/s ) ! -! dtdtc(im,levs)- real, model time step adjusted clear sky radiation! -! heating rates ( k/s ) ! +! dtdtnp(im,levs)- real, heating rate adjustment for SPPT ! ! ! ! outputs: ! ! adjsfcdsw(im)- real, time step adjusted sfc dn sw flux (w/m**2) ! @@ -181,9 +180,10 @@ subroutine dcyc2t3_run & & im, levs, deltim, fhswr, & & dry, icy, wet, & & use_LW_jacobian, sfculw, sfculw_jac, & + & pert_radtend, do_sppt, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: - & dtdt,dtdtc, & + & dtdt,dtdtnp, & ! --- outputs: & adjsfcdsw,adjsfcnsw,adjsfcdlw,adjsfculw, & & adjsfculw_lnd,adjsfculw_ice,adjsfculw_wat,xmu,xcosz, & @@ -212,7 +212,7 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet - logical, intent(in) :: use_LW_jacobian + logical, intent(in) :: use_LW_jacobian, pert_radtend,do_sppt real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr @@ -233,7 +233,7 @@ subroutine dcyc2t3_run & ! --- input/output: real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & - &, dtdtc + &, dtdtnp ! --- outputs: real(kind=kind_phys), dimension(im), intent(out) :: & @@ -358,9 +358,25 @@ subroutine dcyc2t3_run & do k = 1, levs do i = 1, im dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + hlw(i,k) - dtdtc(i,k) = dtdtc(i,k) + swhc(i,k)*xmu(i) + hlwc(i,k) enddo enddo + if (do_sppt) then + if (pert_radtend) then +! clear sky + do k = 1, levs + do i = 1, im + dtdtnp(i,k) = dtdtnp(i,k) + swhc(i,k)*xmu(i) + hlwc(i,k) + enddo + enddo + else +! all sky + do k = 1, levs + do i = 1, im + dtdtnp(i,k) = dtdtnp(i,k) + swh(i,k)*xmu(i) + hlw(i,k) + enddo + enddo + endif + endif ! return !................................... diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index efba0a5f5..aa6d2c35a 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -362,9 +362,25 @@ kind = kind_phys intent = inout optional = F -[dtdtc] - standard_name = tendency_of_air_temperature_due_to_radiative_heating_assuming_clear_sky - long_name = clear sky radiative (shortwave + longwave) heating rate at current time +[pert_radtend] + standard_name = flag_for_stochastic_radiative_heating_perturbations + long_name = flag for stochastic radiative heating perturbations + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_sppt] + standard_name = flag_for_stochastic_physics_perturbations + long_name = flag for stochastic physics perturbations + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtdtnp] + standard_name = tendency_of_air_temperature_to_withold_from_sppt + long_name = temp. change from physics that should not be perturbed by sppt units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) type = real From 2d8c061a3f6aead4e8e8184095fad5a049009429 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 Jan 2021 09:40:36 -0700 Subject: [PATCH 173/274] Update CMakeLists.txt to look for the cmake include snippets in the right place --- CMakeLists.txt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 2f8b7e9d6..88d6240f0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -72,7 +72,7 @@ set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) if(TYPEDEFS) message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") else(TYPEDEFS) - include(./CCPP_TYPEDEFS.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") endif(TYPEDEFS) @@ -88,7 +88,7 @@ set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") else(SCHEMES) - include(./CCPP_SCHEMES.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") endif(SCHEMES) @@ -97,7 +97,7 @@ set(CAPS $ENV{CCPP_CAPS}) if(CAPS) message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") else(CAPS) - include(./CCPP_CAPS.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") endif(CAPS) From ca1afdb3ecebea579cfe13848130756ef6b39411 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 6 Jan 2021 09:40:54 -0700 Subject: [PATCH 174/274] Add #ifdef CCPP to three NoahMP routines --- physics/module_sf_noahmp_glacier.f90 | 1 + physics/module_sf_noahmplsm.f90 | 3 ++- physics/sfc_noahmp_drv.f | 1 + 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index f3e0531f5..0b3749b5a 100644 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -1,3 +1,4 @@ +#define CCPP !> \file module_sf_noahmp_glacier.f90 !! This file contains the NoahMP Glacier scheme. diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index 02ea70a6e..567f4a0cf 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -1,9 +1,10 @@ +#define CCPP !> \file module_sf_noahmplsm.f90 !! This file contains the NoahMP land surface model. !>\ingroup NoahMP_LSM module module_sf_noahmplsm -#ifndef CCPP +#ifndef CCPP use module_wrf_utl #endif diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index 963810734..f60a4233f 100644 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -1,3 +1,4 @@ +#define CCPP !> \file sfc_noahmp_drv.f !! This file contains the NoahMP land surface scheme driver. From 2950112f1d1334e942011e8adee9d217953c6316 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 8 Jan 2021 08:55:10 -0700 Subject: [PATCH 175/274] Add missing dependency of module_radiation_clouds on module_mp_thompson to metadata --- physics/GFS_rrtmg_setup.meta | 3 ++- physics/GFS_rrtmgp_pre.meta | 2 +- physics/GFS_rrtmgp_setup.meta | 3 ++- physics/module_SGSCloud_RadPre.meta | 2 +- 4 files changed, 6 insertions(+), 4 deletions(-) diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index b8d94db6c..f772fd2f9 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f + dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f, + dependencies = module_mp_thompson.F90,radiation_gases.f,radiation_surface.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f, ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index d07f9c137..fd7067ca6 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_pre type = scheme dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f - dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f,rrtmgp_aux.F90,rrtmg_lw_cloud_optics.F90 + dependencies = radiation_astronomy.f,radiation_clouds.f,module_mp_thompson.F90,radiation_gases.f,radiation_surface.f,rrtmgp_aux.F90,rrtmg_lw_cloud_optics.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index fb31f5c7a..9f23636c1 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_rrtmgp_setup type = scheme - dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,physparam.f,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_surface.f + dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,physparam.f,radiation_aerosols.f,radiation_astronomy.f + dependencies = module_mp_thompson.F90,radiation_clouds.f,radiation_gases.f,radiation_surface.f ######################################################################## [ccpp-arg-table] diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index c01cd94af..e9a18df8b 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = sgscloud_radpre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_clouds.f + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_clouds.f,module_mp_thompson.F90 ######################################################################## [ccpp-arg-table] From 918eca147d6646386a701fcbaef6d40f2b6a8a48 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 8 Jan 2021 16:47:49 +0000 Subject: [PATCH 176/274] Added lower limit to temperature used by RRTMGP. --- physics/GFS_rrtmgp_pre.F90 | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 73828999f..b5d1dbe1a 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -252,6 +252,15 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Temperature at layer-center t_lay(1:NCOL,:) = tgrs(1:NCOL,:) + ! Bound temperature at layer centers. + do iCol=1,NCOL + do iLay=1,nLev + if (t_lay(iCol,iLay) .le. lw_gas_props%get_temp_min()) then + t_lay = lw_gas_props%get_temp_min() + epsilon(lw_gas_props%get_temp_min()) + endif + enddo + enddo + ! Temperature at layer-interfaces if (top_at_1) then tem2da(1:nCol,2:iSFC) = log(p_lay(1:nCol,2:iSFC)) From 6d1994c8f37a4c410031e832875ba94a77c099a2 Mon Sep 17 00:00:00 2001 From: "valery.yudin" Date: Sat, 9 Jan 2021 19:47:02 -0500 Subject: [PATCH 177/274] update Jan 9 2021 from NCAR/ccpp-physics --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 33c8a984c..566bee9cd 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 +Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d From 7ddfb71983707d81252b3644cf0bafa340642942 Mon Sep 17 00:00:00 2001 From: "valery.yudin" Date: Sat, 9 Jan 2021 21:36:01 -0500 Subject: [PATCH 178/274] cires_ugwpv1*90 new ; ugwpv1_gsldrag* new unified_ugwp.* modified --- physics/cires_ugwpv1_initialize.F90 | 805 +++++++++++++++++ physics/cires_ugwpv1_module.F90 | 557 ++++++++++++ physics/cires_ugwpv1_oro.F90 | 1279 +++++++++++++++++++++++++++ physics/cires_ugwpv1_solv2.F90 | 1045 ++++++++++++++++++++++ physics/cires_ugwpv1_sporo.F90 | 353 ++++++++ physics/cires_ugwpv1_triggers.F90 | 446 ++++++++++ physics/ugwpv1_gsldrag.F90 | 671 ++++++++++++++ physics/ugwpv1_gsldrag.meta | 1265 ++++++++++++++++++++++++++ physics/ugwpv1_gsldrag_post.F90 | 107 +++ physics/ugwpv1_gsldrag_post.meta | 321 +++++++ physics/unified_ugwp.F90 | 205 +---- 11 files changed, 6857 insertions(+), 197 deletions(-) create mode 100644 physics/cires_ugwpv1_initialize.F90 create mode 100644 physics/cires_ugwpv1_module.F90 create mode 100644 physics/cires_ugwpv1_oro.F90 create mode 100644 physics/cires_ugwpv1_solv2.F90 create mode 100644 physics/cires_ugwpv1_sporo.F90 create mode 100644 physics/cires_ugwpv1_triggers.F90 create mode 100644 physics/ugwpv1_gsldrag.F90 create mode 100644 physics/ugwpv1_gsldrag.meta create mode 100644 physics/ugwpv1_gsldrag_post.F90 create mode 100644 physics/ugwpv1_gsldrag_post.meta diff --git a/physics/cires_ugwpv1_initialize.F90 b/physics/cires_ugwpv1_initialize.F90 new file mode 100644 index 000000000..1050da194 --- /dev/null +++ b/physics/cires_ugwpv1_initialize.F90 @@ -0,0 +1,805 @@ +!=============================== +! cu-cires ugwp-scheme +! initialization of selected +! init gw-solvers (1,2,3,4) +! init gw-source specifications +! init gw-background dissipation +!============================== +! +! Part-0 specifications of common constants, limiters and "criiical" values +! +! + + module ugwp_common +! + use machine, only : kind_phys +! use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & +! rv => con_rv, cpd => con_cp, fv => con_fvirt,& +! arad => con_rerth + implicit none + + real(kind=kind_phys), parameter :: grav =9.81, cpd = 1004. + real(kind=kind_phys), parameter :: rd = 287.0 , rv =461.5 + real(kind=kind_phys), parameter :: grav2 = grav + grav + real(kind=kind_phys), parameter :: rgrav = 1.0/grav, rgrav2= rgrav*rgrav + + real(kind=kind_phys), parameter :: fv = rv/rd - 1.0 + real(kind=kind_phys), parameter :: rdi = 1.0 / rd, rcpd = 1./cpd, rcpd2 = 0.5/cpd + real(kind=kind_phys), parameter :: gor = grav/rd + real(kind=kind_phys), parameter :: gr2 = grav*gor + real(kind=kind_phys), parameter :: grcp = grav*rcpd, gocp = grcp + real(kind=kind_phys), parameter :: rcpdl = cpd*rgrav ! 1/[g/cp] == cp/g + real(kind=kind_phys), parameter :: grav2cpd = grav*grcp ! g*(g/cp)= g^2/cp + + real(kind=kind_phys), parameter :: pi = 4.*atan(1.0), pi2 = 2.*pi, pih = .5*pi + real(kind=kind_phys), parameter :: rad_to_deg=180.0/pi, deg_to_rad=pi/180.0 + + real(kind=kind_phys), parameter :: arad = 6370.e3 +! + real(kind=kind_phys), parameter :: bnv2min = (pi2/1800.)*(pi2/1800.) + real(kind=kind_phys), parameter :: bnv2max = (pi2/30.)*(pi2/30.) + + real(kind=kind_phys), parameter :: dw2min=1.0, velmin=sqrt(dw2min), minvel = 0.5 + real(kind=kind_phys), parameter :: omega1 = pi2/86400. + real(kind=kind_phys), parameter :: omega2 = 2.*omega1, omega3 = 3.*omega1 + real(kind=kind_phys), parameter :: hpscale= 7000., rhp=1./hpscale, rhp2=.5*rhp, rh4 = 0.25*rhp + real(kind=kind_phys), parameter :: mkzmin = pi2/80.0e3, mkz2min = mkzmin*mkzmin + real(kind=kind_phys), parameter :: mkzmax = pi2/500., mkz2max = mkzmax*mkzmax + real(kind=kind_phys), parameter :: cdmin = 2.e-2/mkzmax + + end module ugwp_common +! +! +!=================================================== +! +!Part-1 init => wave dissipation + RFriction +! +!=================================================== + subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & + me, master) +! +! ccpp-damn con_pi !!! +! +!non-ccpp subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) +!non-ccpp use ugwp_common, only : pih + + use machine , only : kind_phys + + + implicit none + integer , intent(in) :: me, master + integer , intent(in) :: levs + real(kind=kind_phys), intent(in) :: con_pi + real(kind=kind_phys), intent(in) :: zkm(levs), pmb(levs) ! in km-Pa + real(kind=kind_phys), intent(out), dimension(levs+1) :: kvg, ktg, krad, kion +! +!locals + data +! + integer :: k + real(kind=kind_phys), parameter :: vusurf = 2.e-5 + real(kind=kind_phys), parameter :: musurf = vusurf/1.95 + real(kind=kind_phys), parameter :: hpmol = 7.0 +! + real(kind=kind_phys), parameter :: kzmin = 0.1 + real(kind=kind_phys), parameter :: kturbo = 100. + real(kind=kind_phys), parameter :: zturbo = 130. + real(kind=kind_phys), parameter :: zturw = 30. + real(kind=kind_phys), parameter :: inv_pra = 3. !kt/kv =inv_pr +! + real(kind=kind_phys), parameter :: alpha = 1./86400./15. ! height variable see Zhu-1993 from 60-days => 6 days + real(kind=kind_phys) :: pa_alp = 750. ! super-RF parameters from FV3-dycore GFSv17/16 sett + real(kind=kind_phys) :: tau_alp = 10. ! days (750 Pa /10days) +! + real(kind=kind_phys), parameter :: kdrag = 1./86400./30. !parametrization for WAM ion drag as e-density function + real(kind=kind_phys), parameter :: zdrag = 100. + real(kind=kind_phys), parameter :: zgrow = 50. +! + real(kind=kind_phys) :: vumol, mumol, keddy, ion_drag + real(kind=kind_phys) :: rf_fv3, rtau_fv3, ptop, pih_dlog +! + real(kind=kind_phys) :: ae1 ,ae2 +! +! ccpp con_pi +! + real(kind=kind_phys) :: pih + pih = 0.5*con_pi + + ptop = pmb(levs) + rtau_fv3 = 1./86400./tau_alp + pih_dlog = pih/log(pa_alp/ptop) + + do k=1, levs + ae1 = zkm(k)/hpmol + vumol = vusurf*exp(ae1) + mumol = musurf*exp(ae1) + ae2 = -((zkm(k)-zturbo) /zturw)**2 + keddy = kturbo*exp(ae2) + + kvg(k) = vumol + keddy + ktg(k) = mumol + keddy*inv_pra + + krad(k) = alpha +! + ion_drag = kdrag +! + kion(k) = ion_drag! +! add Rayleigh_Super of FV3 for pmb < pa_alp +! + if (pmb(k) .le. pa_alp) then + rf_fv3=rtau_fv3*sin(pih_dlog*log(pa_alp/pmb(k)))**2 + krad(k) = krad(k) + rf_fv3 + kion(k) = kion(k) + rf_fv3 + + endif + +! write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) + enddo + + k= levs+1 + kion(k) = kion(k-1) + krad(k) = krad(k-1) + kvg(k) = kvg(k-1) + ktg(k) = ktg(k-1) + + if (me == master) then + write(6, * ) ' zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) ... init_global_gwdis' + do k=1, levs, 1 + write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k), pmb(k) + enddo + endif +! + 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) + + end subroutine init_global_gwdis +! +! ======================================================================== +! Part 2 - sources +! wave sources +! ======================================================================== +! +! ugwp_oro_init +! +!========================================================================= + module ugwp_oro_init + use machine , only : kind_phys + use ugwp_common, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi + use ugwp_common, only : mkzmin, mkz2min + implicit none +! +! constants and "crirtical" values to run oro-mtb_gw physics +! +! + real(kind=kind_phys), parameter :: hncrit=9000. ! max value in meters for elvmax + real(kind=kind_phys), parameter :: hminmt=50. ! min mtn height (*j*) + real(kind=kind_phys), parameter :: sigfac=4.0 ! mb3a expt test for elvmax factor + real(kind=kind_phys), parameter :: hpmax=2500.0 + real(kind=kind_phys), parameter :: hpmin=25.0 +! +! + real(kind=kind_phys), parameter :: minwnd=1.0 ! min wind component (*j*) + real(kind=kind_phys), parameter :: dpmin=5000.0 ! minimum thickness of the reference layer in pa + + + character(len=8) :: strver = 'gfs_2018' + character(len=8) :: strbase = 'gfs_2018' + real(kind=kind_phys), parameter :: rimin=-10., ric=0.25 + + real(kind=kind_phys), parameter :: frmax=10., frc =1.0, frmin =0.01 + real(kind=kind_phys), parameter :: ce=0.8, ceofrc=ce/frc, cg=0.5 + real(kind=kind_phys), parameter :: gmax=1.0, veleps=1.0, factop=0.5! + real(kind=kind_phys), parameter :: efmin=0.5, efmax=10.0 + + real(kind=kind_phys), parameter :: rlolev=50000.0 + integer,parameter :: mdir = 8 + real(kind=kind_phys), parameter :: fdir=.5*mdir/pi + + integer nwdir(mdir) + data nwdir/6,7,5,8,2,3,1,4/ + save nwdir + + real(kind=kind_phys), parameter :: odmin = 0.1, odmax = 10.0 + real(kind=kind_phys), parameter :: fcrit_sm = 0.7, fcrit_sm2 = fcrit_sm * fcrit_sm + real(kind=kind_phys), parameter :: fcrit_gfs = 0.7, fcrit_v1 = 0.7 + real(kind=kind_phys), parameter :: fcrit_mtb = 0.7 + + real(kind=kind_phys), parameter :: zbr_pi = (1.0/2.0)*pi + real(kind=kind_phys), parameter :: zbr_ifs = 0.5*pi + +! + + real(kind=kind_phys), parameter :: kxoro=6.28e-3/200. ! + real(kind=kind_phys), parameter :: coro = 0.0 + integer,parameter :: nridge=2 + real(kind=kind_phys), parameter :: sigma_std=1./100., gamm_std=1.0 + + real(kind=kind_phys) :: cdmb ! scale factors for mtb + real(kind=kind_phys) :: cleff ! scale factors for orogw + + integer :: nworo ! number of waves + integer :: nazoro ! number of azimuths + integer :: nstoro ! flag for stochastic launch above SG-peak + + +!------------------------------------------------------------------------------ +! small-scale orography parameters for TOFD of Beljaars et al., 2004, QJRMS +! SA-option can be controlled by Integral limits of fluxes +! in B2004: klow = 0.003 1/m ~ 2km and kinf ~ 6.28/10/(Z1)~< 1 km => meters +! these limits can change strength of TOFD... choice of k0tr ~1/10 km (10km ~dx of C768) +! kmax = kdis_pbl +!------------------------------------------------------------------------------ + real(kind=kind_phys), parameter :: kmax = 6.28/(10.*25.) ! max k-tofd + real(kind=kind_phys), parameter :: k1tr = 6.28/(2100) ! max k-transition from -1.9/slope to -2.8/slope + real(kind=kind_phys), parameter :: kflt = 6.28/(18.e3) ! + real(kind=kind_phys), parameter :: k0tr = 6.28/(10.e3) ! min k-tofd + real(kind=kind_phys), parameter :: nk1tr = 2.8 + real(kind=kind_phys), parameter :: nk0tr = 1.9 + real(kind=kind_phys), parameter :: a1_tofd = kflt ** nk1tr *1.e3 + real(kind=kind_phys), parameter :: a2_tofd = k1tr ** (nk0tr-nk1tr) + real(kind=kind_phys), parameter :: fix_tofd = 2.* 0.005 * 12 *0.6 !value= 0.072 +! +! B2004 scheme is based on the empirical vertical profile of the tofd divergence: +! Ax_tofd(Z)=exp(-[Z/ze_tofd]^3/2) / Z^1.2..... +! TOFD-flux/TMS-flux must dissipate due to PBL-diffusion with spectral damping +! Here we can enhance TOFD-impact by selecting k0tr and kmax limits +! as functions of resolution and PBL-dissipation +! + integer, parameter :: n_tofd = 2 ! depth of SSO for TOFD compared with Zpbl + real(kind=kind_phys), parameter :: const_tofd = 0.0759 ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 + real(kind=kind_phys), parameter :: ze_tofd = 1500.0 ! BJ's z-decay in meters, 1.5 km + real(kind=kind_phys), parameter :: a12_tofd = 0.0002662*0.005363 ! BJ's k-spect const for sigf2 * a1*a2*exp(-[z/zdec]**1.5] + real(kind=kind_phys), parameter :: ztop_tofd = 3.*ze_tofd ! no TOFD > this height 4.5 km +!------------------------------------------------------------------------------ +! + + contains +! + subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & + lonr, kxw ) +! +! + integer :: nwaves, nazdir, nstoch + integer :: lonr + real(kind=kind_phys) :: cdmbX + real(kind=kind_phys) :: kxw + real(kind=kind_phys) :: effac ! it is analog of cdmbgwd(2) for GWs, off for now +!-----------------------------! GFS-setup for cdmb & cleff +! cdmb = 4.0 * (192.0/IMX) +! cleff = 0.5E-5 / SQRT(IMX/192.0) = 0.5E-5*SQRT(192./IMX) +! + real(kind=kind_phys), parameter :: lonr_refmb = 4.0 * 192.0 + real(kind=kind_phys), parameter :: lonr_refgw = 192.0 + real(kind=kind_phys), parameter :: cleff_ref = 0.5e-5 ! 1256 km = 10 * 125 km ??? + +! copy to "ugwp_oro_init" => nwaves, nazdir, nstoch + + nworo = nwaves + nazoro = nazdir + nstoro = nstoch + + cdmbX = lonr_refmb/float(lonr) + + cdmb = cdmbX + cleff = cleff_ref * sqrt(lonr_refgw/float(lonr)) !* effac +! + end subroutine init_oro_gws +! + + end module ugwp_oro_init +! ========================================================================= +! +! ugwp_conv_init +! +!========================================================================= + module ugwp_conv_init + use machine , only : kind_phys + use cires_ugwpv1_triggers, only :init_nazdir + implicit none + real(kind=kind_phys) :: eff_con ! scale factors for conv GWs + integer :: nwcon ! number of waves + integer :: nazcon ! number of azimuths + integer :: nstcon ! flag for stochastic choice of launch level above Conv-cloud + real(kind=kind_phys) :: con_dlength + real(kind=kind_phys) :: con_cldf + + real(kind=kind_phys), parameter :: cmin = 5 !2.5 + real(kind=kind_phys), parameter :: cmax = 95. !82.5 + real(kind=kind_phys), parameter :: cmid = 22.5 + real(kind=kind_phys), parameter :: cwid = cmid + real(kind=kind_phys), parameter :: bns = 2.e-2, bns2 = bns*bns, bns4=bns2*bns2 + real(kind=kind_phys), parameter :: mstar = 6.28e-3/2. ! 2km + real(kind=kind_phys) :: dc + + real(kind=kind_phys), allocatable :: ch_conv(:), spf_conv(:) + real(kind=kind_phys), allocatable :: xaz_conv(:), yaz_conv(:) + contains +! + subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & + con_pi, arad, lonr, kxw) +! +! non-ccpp with use ugwp_common +! +! subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & +! lonr, kxw) +! +! use ugwp_common, only : pi2, arad + + + + implicit none + + + integer :: nwaves, nazdir, nstoch + integer :: lonr +! +! ccpp +! + real(kind=kind_phys) :: con_pi, arad + + real(kind=kind_phys) :: kxw, effac + real(kind=kind_phys) :: work1 = 0.5 + real(kind=kind_phys) :: chk, tn4, snorm + integer :: k + + nwcon = nwaves + nazcon = nazdir + nstcon = nstoch + eff_con = effac + + con_dlength = 2.0*con_pi*arad/float(lonr) +! +! allocate & define spectra in "selected direction": "dc" "ch(nwaves)" +! + if (.not. allocated(ch_conv)) allocate (ch_conv(nwaves)) + if (.not. allocated(spf_conv)) allocate (spf_conv(nwaves)) + if (.not. allocated(xaz_conv)) allocate (xaz_conv(nazdir)) + if (.not. allocated(yaz_conv)) allocate (yaz_conv(nazdir)) + + dc = (cmax-cmin)/float(nwaves-1) +! +! we may use different spectral "shapes" +! for example FVS-93 "Desabeius" +! E(s=1, t=3,m, w, k) ~ m^s/(m*^4 + m^4) ~ m^-3 saturated tail +! + do k = 1,nwaves + chk = cmin + (k-1)*dc + tn4 = (mstar*chk)**4 + ch_conv(k) = chk + spf_conv(k) = bns4*chk/(bns4+tn4) + enddo + + snorm = sum(spf_conv) + spf_conv = spf_conv/snorm*1.5 + + call init_nazdir(con_pi, nazdir, xaz_conv, yaz_conv) + end subroutine init_conv_gws + + + end module ugwp_conv_init +!========================================================================= +! +! ugwp_fjet_init +! +!========================================================================= + + module ugwp_fjet_init + use machine , only : kind_phys + use cires_ugwpv1_triggers, only :init_nazdir + + implicit none + real(kind=kind_phys) :: eff_fj ! scale factors for conv GWs + integer :: nwfj ! number of waves + integer :: nazfj ! number of azimuths + integer :: nstfj ! flag for stochastic choice of launch level above Conv-cloud +! + real(kind=kind_phys), parameter :: fjet_trig=0. ! if ( abs(frgf) > fjet_trig ) launch GW-packet + + + real(kind=kind_phys), parameter :: cmin = 2.5 + real(kind=kind_phys), parameter :: cmax = 67.5 + real(kind=kind_phys) :: dc + real(kind=kind_phys), allocatable :: ch_fjet(:) , spf_fjet(:) + real(kind=kind_phys), allocatable :: xaz_fjet(:), yaz_fjet(:) + contains + + subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, & + con_pi, lonr, kxw) +! non-ccpp +! +! subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) +! use ugwp_common, only : pi2, arad + + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real(kind=kind_phys) :: con_pi + real(kind=kind_phys) :: kxw, effac , chk + + integer :: k + + nwfj = nwaves + nazfj = nazdir + nstfj = nstoch + eff_fj = effac + + if (.not. allocated(ch_fjet)) allocate (ch_fjet(nwaves)) + if (.not. allocated(spf_fjet)) allocate (spf_fjet(nwaves)) + if (.not. allocated(xaz_fjet)) allocate (xaz_fjet(nazdir)) + if (.not. allocated(yaz_fjet)) allocate (yaz_fjet(nazdir)) + + dc = (cmax-cmin)/float(nwaves-1) + do k = 1,nwaves + chk = cmin + (k-1)*dc + ch_fjet(k) = chk + spf_fjet(k) = 1.0 + enddo + call init_nazdir(con_pi, nazdir, xaz_fjet, yaz_fjet) + + end subroutine init_fjet_gws + + end module ugwp_fjet_init +! +!========================================================================= +! +! + module ugwp_okw_init +!========================================================================= + use machine , only : kind_phys + use cires_ugwpv1_triggers, only :init_nazdir + implicit none + + real(kind=kind_phys) :: eff_okw ! scale factors for conv GWs + integer :: nwokw ! number of waves + integer :: nazokw ! number of azimuths + integer :: nstokw ! flag for stochastic choice of launch level above Conv-cloud +! + real(kind=kind_phys), parameter :: okw_trig=0. ! if ( abs(okwp) > okw_trig ) launch GW-packet + + real(kind=kind_phys), parameter :: cmin = 2.5 + real(kind=kind_phys), parameter :: cmax = 67.5 + real(kind=kind_phys) :: dc + real(kind=kind_phys), allocatable :: ch_okwp(:), spf_okwp(:) + real(kind=kind_phys), allocatable :: xaz_okwp(:), yaz_okwp(:) + + contains +! + subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, & + con_pi, lonr, kxw) + +! subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) +! use ugwp_common, only : pi2, arad + + implicit none + + integer :: nwaves, nazdir, nstoch + integer :: lonr + real(kind=kind_phys) :: con_pi + real(kind=kind_phys) :: kxw, effac , chk + + integer :: k + + nwokw = nwaves + nazokw = nazdir + nstokw = nstoch + eff_okw = effac + + if (.not. allocated(ch_okwp)) allocate (ch_okwp(nwaves)) + if (.not. allocated(spf_okwp)) allocate (spf_okwp(nwaves)) + if (.not. allocated(xaz_okwp)) allocate (xaz_okwp(nazdir)) + if (.not. allocated(yaz_okwp)) allocate (yaz_okwp(nazdir)) + dc = (cmax-cmin)/float(nwaves-1) + do k = 1,nwaves + chk = cmin + (k-1)*dc + ch_okwp(k) = chk + spf_okwp(k) = 1. + enddo + + call init_nazdir(con_pi, nazdir, xaz_okwp, yaz_okwp) +! non-ccpp +! call init_nazdir(nazdir, xaz_okwp, yaz_okwp) +! + end subroutine init_okw_gws + + end module ugwp_okw_init + +!=============================== end of GW sources +! +! init specific gw-solvers (1,2,3,4) +! +!=============================== +! Part -3 init wave solvers +!=============================== + + module ugwp_lsatdis_init + use machine , only : kind_phys + implicit none + + integer :: nwav, nazd + integer :: nst + real(kind=kind_phys) :: eff + integer, parameter :: incdim = 4, iazdim = 4 +! + contains + + subroutine initsolv_lsatdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) + + implicit none +! + integer :: me, master + integer :: nwaves, nazdir + integer :: nstoch + real(kind=kind_phys) :: effac + logical :: do_physb + real(kind=kind_phys) :: kxw +! +!locals: define azimuths and Ch(nwaves) - domain when physics-based soureces +! are not actibve +! + integer :: inc, jk, jl, iazi, i, j, k + + if( nwaves == 0 .or. nstoch == 1 ) then +! redefine from the default + nwav = incdim + nazd = iazdim + nst = 0 + eff = 1.0 + else +! from input_nml multi-wave spectra + nwav = nwaves + nazd = nazdir + nst = nstoch + eff = effac + endif +! + end subroutine initsolv_lsatdis +! + end module ugwp_lsatdis_init +! +! + module ugwp_wmsdis_init + use machine , only : kind_phys + use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, omega2 + use ugwp_common, only : bnv2max, bnv2min, minvel + use ugwp_common, only : mkzmin, mkz2min, mkzmax, mkz2max, cdmin + + implicit none + + real(kind=kind_phys), parameter :: maxdudt = 250.e-5, maxdtdt=15.e-2 + real(kind=kind_phys), parameter :: dked_min =0.01, dked_max=250.0 + + real(kind=kind_phys), parameter :: gptwo=2.0 + + real(kind=kind_phys) , parameter :: bnfix = pi2/300., bnfix2= bnfix * bnfix + real(kind=kind_phys) , parameter :: bnfix4 = bnfix2 * bnfix2 + real(kind=kind_phys) , parameter :: bnfix3 = bnfix2 * bnfix +! +! make parameter list that will be passed to SOLVER +! + integer , parameter :: iazidim=4 ! number of azimuths + integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum + real(kind=kind_phys) , parameter :: ucrit=cdmin + + real(kind=kind_phys) , parameter :: zcimin = 2.5 + real(kind=kind_phys) , parameter :: zcimax = 125.0 + real(kind=kind_phys) , parameter :: zgam = 0.25 +! +! Verical spectra +! + real(kind=kind_phys) , parameter :: pind_wd = 5./3. + real(kind=kind_phys) , parameter :: sind_kz = 1. + real(kind=kind_phys) , parameter :: tind_kz = 3. + real(kind=kind_phys) , parameter :: stind_kz = sind_kz + tind_kz +! +! copies from kmob_ugwp namelist +! + real(kind=kind_phys) :: nslope ! the GW sprctral slope at small-m + real(kind=kind_phys) :: lzstar + real(kind=kind_phys) :: lzmin + real(kind=kind_phys) :: lzmax + real(kind=kind_phys) :: lhmet + real(kind=kind_phys) :: tamp_mpa !amplitude for GEOS-5/MERRA-2 + real(kind=kind_phys) :: tau_min ! min of GW MF 0.25 mPa + integer :: ilaunch + real(kind=kind_phys) :: gw_eff + + real(kind=kind_phys) :: v_kxw, rv_kxw, v_kxw2 + + + +!=========================================================================== + integer :: nwav, nazd, nst + real(kind=kind_phys) :: eff + + real(kind=kind_phys) :: zaz_fct, zms + real(kind=kind_phys), allocatable :: zci(:), zci4(:), zci3(:),zci2(:), zdci(:) + real(kind=kind_phys), allocatable :: zcosang(:), zsinang(:) + real(kind=kind_phys), allocatable :: lzmet(:), czmet(:), mkzmet(:), dczmet(:), dmkz(:) + +! +! GW-eddy constants for wave-mode dissipation by background and stability of +! "final" flow after application of GW-effects +! + real(kind=kind_phys), parameter :: iPr_pt = 0.5 + real(kind=kind_phys), parameter :: lturb = 30., sc2 = lturb*lturb ! stable on 80-km TL lmix ~ 500 met. + real(kind=kind_phys), parameter :: ulturb=150., sc2u = ulturb* ulturb ! unstable + real(kind=kind_phys), parameter :: ric =0.25 + real(kind=kind_phys), parameter :: rimin = -10., prmin = 0.25 + real(kind=kind_phys), parameter :: prmax = 4.0 +! + contains +!============================================================================ + subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw, version) + +! call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & +! knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw,version) +! + implicit none +! +!input-control for solvers: +! nwaves, nazdir, nstoch, effac, do_physb, kxw +! +! + integer, intent(in) :: me, master, nwaves, nazdir, nstoch + integer, intent(in) :: version + + real(kind=kind_phys), intent(in) :: effac, kxw + logical, intent(in) :: do_physb + +! +!locals +! + real(kind=kind_phys) :: dlzmet + real(kind=kind_phys) :: cstar,rcstar, nslope3, fnorm, zcin + + integer :: inc, jk, jl, iazi +! + real(kind=kind_phys) :: zang, zang1, znorm + real(kind=kind_phys) :: zx1, zx2, ztx, zdx, zxran, zxmin, zxmax, zx, zpexp + real(kind=kind_phys) :: fpc, fpc_dc + real(kind=kind_phys) :: ae1,ae2 + if( nwaves == 0) then +! +! redefine from the deafault +! + nwav = incdim + nazd = iazidim + nst = 0 + eff = 1.0 + gw_eff = eff + else +! +! from input.nml +! + nwav = nwaves + nazd = nazdir + nst = nstoch + gw_eff = effac + endif + + + v_kxw = kxw ; v_kxw2 = v_kxw*v_kxw + rv_kxw = 1./v_kxw + + allocate ( zci(nwav), zci4(nwav), zci3(nwav),zci2(nwav), zdci(nwav) ) + allocate ( zcosang(nazd), zsinang(nazd) ) + allocate (lzmet(nwav), czmet(nwav), mkzmet(nwav), dczmet(nwav), dmkz(nwav) ) + + if (me == master) then + print *, 'ugwp_v1/v0: init_gw_wmsdis_control ' +! + print *, 'ugwp_v1/v0: WMS_DIS launch layer ', ilaunch + print *, 'ugwp_v1/v0: WMS_DIS tot_mflux in mpa', tamp_mpa*1000. + print *, 'ugwp_v1/v0: WMS_DIS lhmet in km ' , lhmet*1.e-3 + endif + + zpexp = gptwo * 0.5 ! gptwo=2 , zpexp = 1. + +! +! set up azimuth directions and some trig factors +! +! + zang = pi2 / float(nazd) + +! get normalization factor to ensure that the same amount of momentum +! flux is directed (n,s,e,w) no mater how many azimuths are selected. +! + znorm = 0.0 + do iazi=1, nazd + zang1 = (iazi-1)*zang + zcosang(iazi) = cos(zang1) + zsinang(iazi) = sin(zang1) + znorm = znorm + abs(zcosang(iazi)) + enddo +! zaz_fct = 1.0 + zaz_fct = 2.0 / znorm ! correction factor for azimuthal sums + +! define coordinate transform for "Ch" ....x = 1/c stretching transform +! ----------------------------------------------- +! +! x=1/Cphase transform +! Scinocca 2003. x = 1/c stretching transform +! + zxmax = 1.0 / zcimin + zxmin = 1.0 / zcimax + zxran = zxmax - zxmin + zdx = zxran / real(nwav-1) ! dkz +! + ae1=zxran/zgam + zx1 = zxran/(exp(ae1)-1.0 ) ! zgam =1./4. + zx2 = zxmin - zx1 + +! +! computations for zci =1/zx, stretching "accuracy" is not "accurate" spectra transform +! it represents additional "empirical" redistribution of "spectral" mode in C-space +! + zms = pi2 / lzstar + + do inc=1, nwav + ztx = real(inc-1)*zdx+zxmin + ae1 = (ztx-zxmin)/zgam + zx = zx1*exp(ae1)+zx2 !eq.(29-30),Scinocca-2003 + zci(inc) = 1.0 /zx ! + zdci(inc) = zci(inc)**2*(zx1/zgam)*exp(ae1)*zdx ! + zci4(inc) = (zms*zci(inc))**4 + zci2(inc) = (zms*zci(inc))**2 + zci3(inc) = (zms*zci(inc))**3 + enddo +! +! +! alternatuve lzmax-lzmin without x=1/c transform +! +! + if (version == 1) then + + dlzmet = (lzmax-lzmin)/ real(nwav-1) + do inc=1, nwav + lzmet(inc) = lzmin + (inc-1)*dlzmet + mkzmet(inc) = pi2/lzmet(inc) + zci(inc) =lzmet(inc)/(pi2/bnfix) + zci4(inc) = (zms*zci(inc))**4 + zci2(inc) = (zms*zci(inc))**2 + zci3(inc) = (zms*zci(inc))**3 + + enddo + + zdx = (zci(nwav)-zci(1))/ real(nwav-1) + do inc=1, nwav + zdci(inc) = zdx + enddo + + cstar = bnfix/zms + rcstar = 1./cstar + + if (me == master) then + print * + print *, 'ugwp_v0: zcimin=' , zcimin + print *, 'ugwp_v0: zcimax=' , zcimax + print *, 'ugwp_v0: zgam= ', zgam + print * + +! print *, ' ugwp_v1 nslope=', nslope + print * + print *, 'ugwp_v1: zcimin/zci=' , maxval(zci) + print *, 'ugwp_v1: zcimax/zci=' , minval(zci) + print *, 'ugwp_v1: cd_crit=', ucrit + print *, 'ugwp_v1: launch_level', ilaunch + print *, ' ugwp_v1 lzstar=', lzstar + print *, ' ugwp_v1 nslope=', nslope + + print * + nslope3=nslope+3.0 + do inc=1, nwav + zcin =zci(inc)*rcstar + fpc = rcstar*(zcin*zcin)/(1.+ zcin**nslope3) + fpc_dc = fpc * zdci(inc) + write(6,111) inc, zci(inc), zdci(inc),ucrit, fpc, fpc_dc, 6.28e-3/bnfix*zci(inc) + enddo + endif + + ENDIF ! if (version == 1) then + 111 format( 'wms-zci', i4, 7 (3x, F8.3)) + + end subroutine initsolv_wmsdis +! +! + end module ugwp_wmsdis_init diff --git a/physics/cires_ugwpv1_module.F90 b/physics/cires_ugwpv1_module.F90 new file mode 100644 index 000000000..eb740c7eb --- /dev/null +++ b/physics/cires_ugwpv1_module.F90 @@ -0,0 +1,557 @@ + +module cires_ugwpv1_module + +! +! driver is called after pbl & before chem-parameterizations +! it uses ugwp_common (like phys_cons) and some module-param od solvers/sources init-modules +!.................................................................................... +! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re +!................................................................................... +! +! + use machine, only : kind_phys + use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4 + use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar + use ugwp_wmsdis_init, only : tau_min, tamp_mpa + + implicit none + logical :: module_is_initialized + + character(len=8) :: strsolver='pss-1986' + logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources + logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver + integer, parameter :: idebug_gwrms=0 ! control for diag computaions pw wind-temp GW-rms and MF fluxs + logical, parameter :: do_adjoro = .false. + real(kind=kind_phys), parameter :: max_kdis = 450. ! 400 m2/s + real(kind=kind_phys), parameter :: max_axyz = 450.e-5 ! 400 m/s/day + real(kind=kind_phys), parameter :: max_eps = max_kdis*4.e-4 ! max_kdis*BN2 + real(kind=kind_phys), parameter :: maxdudt = max_axyz + real(kind=kind_phys), parameter :: maxdtdt = max_eps*1.e-3 ! max_kdis*BN2/cp + real(kind=kind_phys), parameter :: dked_min = 0.01 + real(kind=kind_phys), parameter :: dked_max = max_kdis +! +! +! Pr = Kv/Kt < 1 for upper layers; Pr_mol = 1./1.95 check it +! + real(kind=kind_phys), parameter :: Pr_kvkt = 1./1. ! kv/kt = 1./3. + real(kind=kind_phys), parameter :: Pr_kdis = Pr_kvkt/(1.+Pr_kvkt) + + real(kind=kind_phys), parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw + real(kind=kind_phys), parameter :: iPr_turb =1./3., iPr_mol =1.95 + + + real(kind=kind_phys), parameter :: hps = hpscale + real(kind=kind_phys), parameter :: hpskm = hps/1000. +! + real(kind=kind_phys), parameter :: rhp1=1./hps, rh2=0.5*rhp1, rhp4 = rh2*rh2 + real(kind=kind_phys), parameter :: khp = 0.287*rhp1 ! R/Cp/Hp + + real(kind=kind_phys), parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model + real(kind=kind_phys), parameter :: linsat = 1.00 + real(kind=kind_phys), parameter :: linsat2 = linsat*linsat + + real(kind=kind_phys), parameter :: ricrit = 0.25 + real(kind=kind_phys), parameter :: frcrit = 0.50 + + + integer :: knob_ugwp_version = 1 + integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) + integer, dimension(4) :: knob_ugwp_source=(/1,0,1,0/) ! [1,0,1,1] - (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_wvspec=(/1,32,32,32/) ! number of waves for- (oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_azdir=(/2,4,4,4/) ! number of wave azimuths for-(oro, fronts, conv, imbf-owp] + integer, dimension(4) :: knob_ugwp_stoch=(/0,0,0,0/) ! 0 - deterministic ; 1 - stochastic + real(kind=kind_phys), dimension(4) :: knob_ugwp_effac=(/1.,1.,1.,1./) ! efficiency factors for- (oro, fronts, conv, imbf-owp] + + integer :: knob_ugwp_doaxyz=1 ! 1 -gwdrag + integer :: knob_ugwp_doheat=1 ! 1 -gwheat + integer :: knob_ugwp_dokdis=0 ! 1 -gwmixing + integer :: knob_ugwp_ndx4lh = 2 ! n-number of "unresolved" "n*dx" for lh_gw + integer :: knob_ugwp_nslope = 1 ! spectral"growth" S-slope of GW-energy spectra mkz^S + + real(kind=kind_phys) :: knob_ugwp_palaunch = 500.e2 ! fixed pressure layer in Pa for "launch" of NGWs + real(kind=kind_phys) :: knob_ugwp_lzmax = 12.5e3 ! 12.5 km max-VERT-WL of GW-spectra + real(kind=kind_phys) :: knob_ugwp_lzstar = 2.0e3 ! UTLS mstar = 6.28/lzstar 2-2.5 km + real(kind=kind_phys) :: knob_ugwp_lzmin = 1.5e3 ! 1.5 km min-VERT-WL of GW-spectra + real(kind=kind_phys) :: knob_ugwp_taumin = 0.25e-3 + real(kind=kind_phys) :: knob_ugwp_tauamp = 7.75e-3 ! range from 30.e-3 to 3.e-3 ( space-borne values) + real(kind=kind_phys) :: knob_ugwp_lhmet = 200.e3 ! 200 km + logical :: knob_ugwp_tlimb = .true. + character(len=8) :: knob_ugwp_orosolv='pss-1986' + + real(kind=kind_phys) :: kxw = pi2/200.e3 ! single horizontal wavenumber of ugwp schemes +! +! tune-ups for qbo +! +! real(kind=kind_phys) :: knob_ugwp_qbolev = 500.e2 ! fixed pressure layer in Pa for "launch" of conv-GWs +! real(kind=kind_phys) :: knob_ugwp_qbosin = 1.86 ! semiannual cycle of tau_qbo_src in radians +! real(kind=kind_phys) :: knob_ugwp_qbotav = 2.285e-3 ! additional to "climate" for QBO-sg forcing +! real(kind=kind_phys) :: knob_ugwp_qboamp = 1.191e-3 ! additional to "climate" QBO +! real(kind=kind_phys) :: knob_ugwp_qbotau = 10. ! relaxation time scale in days +! real(kind=kind_phys) :: knob_ugwp_qbolat = 15. ! qbo-domain for extra-forcing +! real(kind=kind_phys) :: knob_ugwp_qbowid = 7.5 ! qbo-attenuation for extra-forcing +! character(len=250) :: knob_ugwp_qbofile='qbo_zmf_2009_2018.nc'! +! character(len=250) :: knob_ugwp_amffile='mern_zmf_amf_12month.nc' +! character(len=255) :: file_limb_tab='ugwp_limb_tau.nc' +! integer, parameter :: ny_tab=73, nt_tab=14 +! real(kind=kind_phys), parameter :: rdy_tab = 1./2.5, rdd_tab = 1./30. +! integer :: nqbo_d1y, nqbo_d2z, nqbo_d3t + + integer :: ugwp_azdir + integer :: ugwp_stoch + + integer :: ugwp_src + integer :: ugwp_nws + real(kind=kind_phys) :: ugwp_effac + +! + integer :: launch_level = 55 +! + namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & + knob_ugwp_stoch, knob_ugwp_effac,knob_ugwp_doaxyz, knob_ugwp_doheat, knob_ugwp_dokdis, & + knob_ugwp_ndx4lh, knob_ugwp_version, knob_ugwp_palaunch, knob_ugwp_nslope, knob_ugwp_lzmax, & + knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & + knob_ugwp_tlimb, knob_ugwp_orosolv + +! +! allocatable arrays, initilized during "cires_ugwp_init" & +! released during "cires_ugwp_finalize" +! + real(kind=kind_phys), allocatable :: kvg(:), ktg(:), krad(:), kion(:) + real(kind=kind_phys), allocatable :: zkm(:), pmb(:) + real(kind=kind_phys), allocatable :: rfdis(:), rfdist(:) + integer :: levs_rf + real(kind=kind_phys) :: pa_rf, tau_rf +!........................................................................................... +! tabulated GW-sources: GRACILE/Ern et al., 2018 and/or Resolved GWs from C384-Annual run +!........................................................................................... + +! integer :: ntau_d1y, ntau_d2t +! real(kind=kind_phys), allocatable :: ugwp_taulat(:) +! real(kind=kind_phys), allocatable :: tau_limb(:,:), days_limb(:) +! logical :: flag_alloctau = .false. +! character(len=255):: ugwp_taufile = 'ugwp_limb_tau.nc' +! +! simple modulation of tau_ngw by the total rain/precip strength +! + real(kind=kind_phys), parameter :: rain_max=8.e-5, rain_lat=41.0, rain_lim=1.e-5 + real(kind=kind_phys), parameter :: w_merra = 1.0, w_nomerra = 1.-w_merra, w_rain =1. + real(kind=kind_phys), parameter :: mtau_rain = 1.e-3, ft_min =0.5, ft_max=2 + real(kind=kind_phys), parameter :: tau_ngw_max = 20.e-3 ! 20 mPa + real(kind=kind_phys), parameter :: tau_ngw_min = .20e-3 ! .2 mPa +! +! Bushell et al. (2015) tau = tau_rainum (~3.8 km) x sqrt(Precip/base_rainum) +! + real(kind=kind_phys), parameter :: tau_rainum = 0.7488e-3 ! 0.74 mPa + real(kind=kind_phys), parameter :: base_rainum = 0.1e-5 ! ~0.1 mm/day + real(kind=kind_phys), parameter :: pbase_um =1./sqrt(base_rainum) * tau_rainum ! + integer, parameter :: metoum_rain = 0 +!================================================================= +! switches that can ba activated for NGW physics include/omit +! +! rotational, non-hydrostatic and eddy-dissipative +! F_coriol F_nonhyd F_kds +!=================================================== + real(kind=kind_phys), parameter :: F_coriol=1.0 ! Coriolis effects + real(kind=kind_phys), parameter :: F_nonhyd=1.0 ! Nonhydrostatic waves + real(kind=kind_phys), parameter :: F_kds =0.0 ! Eddy mixing due to GW-unstable below + + + contains +! +!----------------------------------------------------------------------- +! +! init of cires_ugwp (_init) called from CCPP cap file +! +! --------------------------------------------------------------------------------- +! non-ccpp .... +! +! subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, fn_nml2, & +! lonr, latr, levs, ak, bk, pref, dtp) +!----------------------------------------------------------------------------------- + + subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & + con_rerth, fn_nml2, lonr, latr, levs, ak, bk, pref, dtp, & + errmsg, errflg) +! +! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 +! + use netcdf + use ugwp_oro_init, only : init_oro_gws + use ugwp_conv_init, only : init_conv_gws + use ugwp_fjet_init, only : init_fjet_gws + use ugwp_okw_init, only : init_okw_gws + use ugwp_lsatdis_init, only : initsolv_lsatdis + + use ugwp_wmsdis_init, only : initsolv_wmsdis + use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar + use ugwp_wmsdis_init, only : tau_min, tamp_mpa + + implicit none + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + integer, intent (in) :: logunit + integer, intent (in) :: lonr + integer, intent (in) :: levs + integer, intent (in) :: latr + integer, intent (in) :: jdat_gfs(8) + real(kind=kind_phys), intent (in) :: ak(levs+1), bk(levs+1), pref + real(kind=kind_phys), intent (in) :: dtp +! +! consider to retire them +! + real(kind=kind_phys), intent (in) :: con_pi, con_rerth + + character(len=64), intent (in) :: fn_nml2 + character(len=64), parameter :: fn_nml='input.nml' + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! character, intent (in) :: input_nml_file +! + integer :: ios + logical :: exists + + integer :: ncid, iernc, vid, dimid, status + integer :: k + integer :: ddd_ugwp, curday_ugwp +! integer :: version + + +! + if (me == master) print *, trim (fn_nml), ' GW-namelist file ' + inquire (file =trim (fn_nml) , exist = exists) +! + if (.not. exists) then + if (me == master) & + write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' + + else + open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios) + endif + rewind (nlunit) + read (nlunit, nml = cires_ugwp_nml) + close (nlunit) +! + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + + strsolver= knob_ugwp_orosolv + + curday_ugwp = jdat_gfs(1)*10000 + jdat_gfs(2)*100 +jdat_gfs(3) + call calendar_ugwp(jdat_gfs(1), jdat_gfs(2), jdat_gfs(3), ddd_ugwp) + +! write version number and namelist to log file + if (me == master) then + write (logunit, *) " ================================================================== " + write (logunit, *) "CCPP cires_ugwp_namelist_extended_v1" + write (logunit, nml = cires_ugwp_nml) + write (logunit, *) " ================================================================== " + + write (6, *) " ================================================================== " + write (6, *) "CCPP cires_ugwp_namelist_extended_v1" + write (6, nml = cires_ugwp_nml) + write (6, *) " ================================================================== " + write (6, *) "calendar_ugwp ddd_ugwp=", ddd_ugwp + write (6, *) "calendar_ugwp curday_ugwp=", curday_ugwp + write (6, *) " ================================================================== " + write (6, *) ddd_ugwp, ' jdat_gfs ddd of year ' + endif +! +! effective kxw - resolution-aware +! +! + kxw = pi2/knob_ugwp_lhmet +! +! +! init global background dissipation for ugwp -> 4d-variable for fv3wam linked with pbl-vert_diff +! +! +! allocate(fcor(latr), fcor2(latr) ) +! + allocate( kvg(levs+1), ktg(levs+1) ) + allocate( krad(levs+1), kion(levs+1) ) + allocate( zkm(levs), pmb(levs) ) + +! +! ak -pa bk-dimensionless from surf => tol_lid_pressure =0 +! + + do k=1, levs + pmb(k) = ak(k) + pref*bk(k) ! Pa -unit Pref = 1.e5, pmb = Pa + zkm(k) = -hpskm*alog(pmb(k)/pref) + enddo + +! +! find ilaunch +! + + do k=levs, 1, -1 + if (pmb(k) .gt. knob_ugwp_palaunch ) exit + enddo + + launch_level = max(k-1, 5) ! above 5-layers from the surface + if (me == master) then + print *, 'cires_ugwpv1 klev_ngw =', launch_level, nint(pmb(launch_level)) + endif +! +! Part-1 :init_global_gwdis again "damn"-con_pi +! call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) +! + call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & + me, master) +! +! Part-2 :init_SOURCES_gws +! + +! +! call init-solver for "stationary" multi-wave spectra and sub-grid oro +! + call init_oro_gws( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & + knob_ugwp_stoch(1), knob_ugwp_effac(1), lonr, kxw ) +! +! call init-sources for "non-sationary" multi-wave spectra +! + do_physb_gwsrcs=.true. + + IF (do_physb_gwsrcs) THEN + + if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init_modv1 ' + if (knob_ugwp_wvspec(4) > 0) then +! okw + call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & + knob_ugwp_stoch(4), knob_ugwp_effac(4), & + con_pi, lonr, kxw ) + if (me == master) print *, ' init_okw_gws ' + endif + + if (knob_ugwp_wvspec(3) > 0) then +! fronts + call init_fjet_gws(knob_ugwp_wvspec(3), knob_ugwp_azdir(3), & + knob_ugwp_stoch(3), knob_ugwp_effac(3), & + con_pi, lonr, kxw ) + if (me == master) print *, ' init_fjet_gws ' + endif + + if (knob_ugwp_wvspec(2) > 0) then +! conv : con_pi, con_rerth, + call init_conv_gws(knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), & + con_pi, con_rerth, lonr, kxw ) + if (me == master) & + print *, ' init_convective GWs ', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) + + endif + + ENDIF !IF (do_physb_gwsrcs) + +!====================== +! Part-3 :init_SOLVERS +! ===================== +! +! call init-solvers for "broad" non-stationary multi-wave spectra +! + if (knob_ugwp_solver==1) then +! + kxw = pi2/lhmet + call initsolv_lsatdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw ) + endif + if (knob_ugwp_solver == 2) then +! +! re-assign from namelists +! + nslope = knob_ugwp_nslope ! the GW sprctral slope at small-m + lzstar = knob_ugwp_lzstar + lzmax = knob_ugwp_lzmax + lzmin = knob_ugwp_lzmin + lhmet = knob_ugwp_lhmet + tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 + tau_min =knob_ugwp_taumin ! min of GW MF 0.25 mPa + ilaunch = launch_level + + kxw = pi2/lhmet + + call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw, knob_ugwp_version) + + endif + + +!====================== + module_is_initialized = .true. + if (me == master) print *, ' CIRES_ugwpV1 is initialized ', module_is_initialized + + end subroutine cires_ugwpv1_init + + +!============================================= + + subroutine cires_ugwp_advance +!----------------------------------------------------------------------- +! FV3-dycore and CCPP-physics has limited options to +! add "horizontal" gradients of winds and temp-re to +! compute GW-triggers: reserved option if it will be funded ...... +! +! the day-to-day variable sources/spectra and diagnostics for stochastic "triggers" +! +! diagnose GW-source functions * FGF + OKWP + SGO/CONV from IAU-fields +! and use for stochastic GWP-sources "memory" +! +! this option is not active due to "weak" flexibility +! in communication between "ccpp/gfsphysics" and FV3-dycore +! extension of State%in is needed to pass horizontal gradients +! winds and temperature to compute "spontatneous" GW triggers +!----------------------------------------------------------------------- + implicit none +! +! update GW sources and dissipation +! a) physics-based GW triggers eliminated from cires_ugwpv1_triggers.F90 +! b) stochastic-based spectra and amplitudes is not considered +! c) use "memory" on GW-spectra from previous time-step is not considered +! d) update "background" dissipation of GWs as needed (option for FV3WAM) +! + end subroutine cires_ugwp_advance + +! +! ----------------------------------------------------------------------- +! finalize of cires_ugwp_dealloc +! ----------------------------------------------------------------------- + + + subroutine cires_ugwp_dealloc +! +! deallocate sources/spectra & some diagnostics need to find where "deaalocate them" +! before "end" of the FV3GFS +! + implicit none +! +! deallocate arrays employed in: +! cires_ugwp_advance / cires_ugwp_driver / cires_ugwp_init +! + if (allocated (kvg)) deallocate (kvg) + if (allocated (ktg)) deallocate (ktg) + if (allocated (krad)) deallocate (krad) + if (allocated (kion)) deallocate (kion) + if (allocated (zkm)) deallocate (zkm) + if (allocated (pmb)) deallocate (pmb) +! if (allocated (ugwp_taulat)) deallocate(ugwp_taulat) +! if (allocated (tau_limb)) deallocate (tau_limb) +! if (allocated (days_limb)) deallocate(days_limb) + + + end subroutine cires_ugwp_dealloc + +! +! + subroutine calendar_ugwp(yr, mm, dd, ddd_ugwp) +! +! computes day of year to get tau_limb forcing written with 1-day precision +! + implicit none + integer, intent(in) :: yr, mm, dd + integer :: ddd_ugwp + + integer :: iw3jdn + integer :: jd1, jddd + jd1 = iw3jdn(yr,1,1) + jddd = iw3jdn(yr,mm,dd) + ddd_ugwp = jddd-jd1+1 + + end subroutine calendar_ugwp + + + subroutine ngwflux_update(me, master, im, levs, kdt, ddd, curdate, & + tau_ddd, xlatd, sinlat,coslat, rain, tau_ngw) + + use machine, only: kind_phys + implicit none +!input + + integer, intent(in) :: me, master !, jdat(8) + integer, intent(in) :: im, levs, kdt + integer, intent(in) :: ddd, curdate + +! integer, intent(in), dimension(im) :: j1_tau, j2_tau +! real(kind=kind_phys), intent(in), dimension(im) :: ddy_j2tau, ddy_j1tau + + real(kind=kind_phys), intent(in), dimension(im) :: xlatd, sinlat,coslat + real(kind=kind_phys), intent(in), dimension(im) :: rain, tau_ddd + + real(kind=kind_phys), intent(inout), dimension(im) :: tau_ngw +! +! locals +! + + integer :: i, j1, j2, k, it1, it2, iday + real(kind=kind_phys) :: tem, tx1, tx2, w1, w2, wlat, rw1, rw2 + real(kind=kind_phys) :: tau_rain, flat_rain, tau_3dt + +! + +! code below inside cires_tauamf_data.F90 +! it1 = 2 +! do iday=1, ntau_d2t +! if (float(ddd) .lt. days_limb(iday) ) then +! it2 = iday +! exit +! endif +! enddo +! it2 = min(it2,ntau_d2t) +! it1 = max(it2-1,1) +! if (it2 > ntau_d2t ) then +! print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t +! stop +! endif +! w2 = (float(ddd)-days_limb(it1))/(days_limb(it2)-days_limb(it1)) +! w1 = 1.0-w2 +! do i=1, im +! j1 = j1_tau(i) +! j2 = j2_tau(i) +! tx1 = tau_limb(j1, it1)*ddy_j1tau(i)+tau_limb(j2, it1)*ddy_j2tau(i) +! tx2 = tau_limb(j1, it2)*ddy_j1tau(i)+tau_limb(j2, it2)*ddy_j2tau(i) +! tau_ddd(i) = tx1*w1 + w2*tx2 +! +! add modulattion by the total "rain"-strength Yudin et al.(2020-FV3GFS) and Bushell et al. (2015-UM/METO) +! + do i=1, im + tau_3dt = tau_ngw(i) * w_merra + w_nomerra *tau_ddd(i) + + if (w_rain > 0. .and. rain(i) > 0.) then + + wlat = abs(xlatd(i)) + + if (wlat <= rain_lat .and. rain(i) > rain_lim) then + flat_rain = wlat/rain_lat + rw1 = 0.75 * flat_rain ; rw2 = 1.-rw1 + + tau_rain = tau_3dt * rw1 + rw2 * mtau_rain*min(rain_max, rain(i))/rain_lim + tau_rain = tau_3dt*(1.-w_rain) + w_rain* tau_rain +! +! restict variations from the "tau_ngw" without precip-impact +! +! real, parameter :: ft_min =0.5*tau_g5 < tau_rain < ft_max =2. *tau_g5 +! + if (tau_rain < ft_min *tau_3dt) tau_rain = ft_min *tau_3dt + if (tau_rain > ft_max *tau_3dt) tau_rain = ft_max *tau_3dt + + tau_3dt = tau_rain + + endif + if (metoum_rain == 1) then + tau_rain = min( sqrt(rain(i))*pbase_um, tau_ngw_max) + tau_3dt = max(tau_ngw_min, tau_rain) + endif + endif + tau_ngw(i) = tau_3dt + enddo + + end subroutine ngwflux_update +! + end module cires_ugwpv1_module + diff --git a/physics/cires_ugwpv1_oro.F90 b/physics/cires_ugwpv1_oro.F90 new file mode 100644 index 000000000..6913b4c0e --- /dev/null +++ b/physics/cires_ugwpv1_oro.F90 @@ -0,0 +1,1279 @@ +module cires_ugwpv1_oro + +contains + + subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & + grav, con_omega, rd, cpd, rv, pi, arad, fv, & + xlatd, sinlat, coslat, sparea, & + cdmbgwd, hprime, oc, oa4, clx4, theta, sigmad, & + gammad, elvmaxd, sgh30, kpbl, & + u1 ,v1, t1, q1, prsi,del,prsl,prslk, zmeti, zmet, & + pdvdt, pdudt, pdtdt, pkdis, dusfc, dvsfc,rdxzb , & + zobl, zlwb, zogw, tau_ogw, dudt_ogw, dvdt_ogw, & + dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_ofdcol, dv_ofdcol, errmsg,errflg ) + +! call orogw_v1 (im, levs, lonr, me, master,dtp, kdt, do_tofd, & +! con_g, con_omega, con_rd, con_cp, con_rv,con_pi, con_rerth, con_fvirt, & +! xlat_d, sinlat, coslat, area, & +! cdmbgwd(1:2), hprime, oc, oa4, clx, theta, & +! sigma, gamma, elvmax, varss, kpbl, & +! ugrs, vgrs, tgrs, q1, prsi,del,prsl,prslk, zmeti, zmet, & +! Pdvdt, Pdudt, Pdtdt, Pkdis, DUSFCg, DVSFCg,rdxzb, & +! zobl, zlwb, zogw, tau_ogw, dudt_ogw, dvdt_ogw, & +! dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, & +! du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & +! du_ofdcol, dv_ofdcol, errmsg,errflg ) + +!--------------------------------------------------------------------------- +! ugwp_v1: orogw_v1 following recent updates of Lott & Miller 1997 +! eventually will be replaced with more "advanced" LLWB +! and multi-wave solver that produce competitive FV3GFS-skills +! +! computation of kref for ogw + coorde diagnostics +! all constants/parameters inside cires_ugwp_initialize.f90 +! +! 10/2020 main updates +! (a) introduce extra diagnostics of x-y obl-ofd-ogw as in the GSL-drag +! for intercomparisons +! +! (b) quit with cdmbgwd(1:2) +! cdmbgwd(1) = 1 for all resolutions, number of hills control SA-effects +! cdmbgwd(2) = 1 ...............number of hills control SA-effects +! +! (c) cleff = pi2/(nk*dx) lheff = nk*dx (nk = 6,4,2, 1) +! alternative lheff = min( dogw=hprime/sigma*gamma, dx) +! we still not use the "broad spectral solver" +! +! (d) hefff = (nsig * hprime -znlk)/nsig, orchestrating MB and OGW +! +! (e) for linsat-solver "eddy" damping Ked = Ked * Nhills, scale-aware +! amplification of the momentum deposition for low-res simulations +!---------------------------------------- + + use machine , only : kind_phys + use ugwp_common, only : dw2min, velmin + + use ugwp_oro_init, only : rimin, ric, efmin, efmax, & + hpmax, hpmin, sigfaci => sigfac, & + dpmin, minwnd, hminmt, hncrit, & + rlolev, gmax, veleps, factop, & + frc, ce, ceofrc, frmax, cg, & + fdir, mdir, nwdir, & + cdmb, cleff, fcrit_v1, & + n_tofd, ze_tofd, ztop_tofd + + use cires_ugwpv1_module, only : kxw, max_kdis, max_axyz + +! use cires_ugwpv1_sporo, only : oro_spectral_solver + +!---------------------------------------- + implicit none +!---------------------------------------- +! internal parameters +!---------------------------------------- + real(kind=kind_phys), parameter :: sigfac = 3 ! N*hprime height of Subgrid Hill over which SSO-flo + real(kind=kind_phys), parameter :: sigfacs = 0.25 ! M*hprime height is the low boundary of the hill + + real(kind=kind_phys), parameter :: dbmax = 1./3600./12. ! max-Krmtb in hours for u=10 m/s => 20 m/s/day + character(len=8) :: strsolver='pss-1986' ! current operational Ri-solver or 'spect_2020' + + + real(kind=kind_phys) :: gammin = 0.00999999 ! a/b = gammma_min =1% <====> + real(kind=kind_phys), parameter :: nhilmax = 15. ! max number of SSO-hills in grid-box + real(kind=kind_phys), parameter :: sso_min = 3000. ! min-lenghth of the hill, GTOP30 ~dx~1 km + + real(kind=kind_phys), parameter :: nfr = 2.+1. ! power in the emprical Function(Fr/Frc) + real(kind=kind_phys), parameter :: afr = 1. ! (Fr/Frc)^2/(afr +[Fr/Frc]^nfr), Fr = h*mkz + real(kind=kind_phys), parameter :: frnorm =afr+1.0 ! to get cont-ous taulin(Fr=Frc) = tau_nonlin(Fr=Frc) ! + real(kind=kind_phys), parameter :: max_frf =2.0 ! max-value of non-lin flux over the linear at Fr=Frc + + logical, parameter :: do_adjoro = .false. ! +!---------------------------------------- + + integer, intent(in) :: im, km, imx, kdt + integer, intent(in) :: me, master + logical, intent(in) :: do_tofd + + integer, intent(in) :: kpbl(im) ! index for the pbl top layer! + real(kind=kind_phys), intent(in) :: dtp ! time step + real(kind=kind_phys), intent(in) :: cdmbgwd(2) + + real(kind=kind_phys), intent(in) :: hprime(im), oc(im), oa4(im,4), & + clx4(im,4), theta(im), & + sigmad(im), gammad(im), elvmaxd(im) + + real(kind=kind_phys), intent(in) :: grav, con_omega, rd, cpd, rv, pi, arad, fv + + real(kind=kind_phys), intent(in) :: sgh30(im) + + real(kind=kind_phys), intent(in), dimension(im,km) :: & + u1, v1, t1, q1,del, prsl, prslk, zmet + + real(kind=kind_phys), intent(in),dimension(im,km+1):: prsi, zmeti + + real(kind=kind_phys), intent(in) :: xlatd(im),sinlat(im), coslat(im) + real(kind=kind_phys), intent(in) :: sparea(im) + +! +!output -phys-tend +! + real(kind=kind_phys),dimension(im,km),intent(out) :: & + pdvdt, pdudt, pkdis, pdtdt +! output - diag-coorde + real(kind=kind_phys),dimension(im,km),intent(out) :: & + dudt_ogw,dvdt_ogw, dudt_obl,dvdt_obl, dudt_ofd,dvdt_ofd + + real(kind=kind_phys),dimension(im),intent(out) :: dusfc, dvsfc, & + du_ogwcol,dv_ogwcol, du_oblcol,dv_oblcol, du_ofdcol,dv_ofdcol +! + real(kind=kind_phys),dimension(im),intent(out) :: rdxzb + real(kind=kind_phys),dimension(im),intent(out) :: zobl, zogw, zlwb, tau_ogw + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +!--------------------------------------------------------------------- +! # of permissible sub-grid orography hills for "any" resolution < 25 +! correction for "elliptical" hills based on shilmin-area =sgrid/25 +! 4.*gamma*b_ell*b_ell >= shilmin +! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min +! gamma_min = 1/4*shilmin/sso_min/sso_min +!23.01.2019: cdmb = 4.*192/768_c192=1 x 0.5 +! 192: cdmbgwd = 0.5, 2.5 +! cleff = 2.5*0.5e-5 * sqrt(192./768.) => lh_eff = 1004. km +! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective OGW-lin +!--------------------------------------------------------------------- +! +! locals vars for SSO +! + + real(kind=kind_phys), dimension(im) :: oa, clx + real(kind=kind_phys), dimension(im) :: sigma, gamma, elvmax ! corrected sigmaD, gammaD, elvmaxD + + real(kind=kind_phys) :: shilmin, sgrmax, sgrmin + real(kind=kind_phys) :: belpmin, dsmin, dsmax + + real(kind=kind_phys) :: arhills(im), mkd05_hills(im) ! number of hills in the grid + real(kind=kind_phys) :: taub_kd05(im) +! +! locals mean flow ...etc +! + real(kind=kind_phys), dimension(im,km) :: ri_n, bnv2, ro + real(kind=kind_phys), dimension(im,km) :: vtk, vtj, velco +!================== +!mtb +!================== + real(kind=kind_phys) :: ztoph,zlowh,ph_blk, dz_blk + real(kind=kind_phys), dimension(im) :: wk, pe, ek, up + + real(kind=kind_phys), dimension(im,km) :: db, ang, uds + + real(kind=kind_phys) :: zlen, dbtmp, r, phiang, dbim, zr + real(kind=kind_phys) :: eng0, eng1, cosang2, sinang2 + real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem + +!================== +! tofd +! some constants now in "use ugwp_oro_init" + "use ugwp_common" +! +!================== + + real(kind=kind_phys) :: unew, vnew, zpbl, sigflt, zsurf + real(kind=kind_phys), dimension(km) :: utofd1, vtofd1 + real(kind=kind_phys), dimension(km) :: epstofd1, krf_tofd1 + real(kind=kind_phys), dimension(km) :: up1, vp1, zpm +!================== +! ogw +!================== + real(kind=kind_phys) :: xlingfs + logical :: icrilv(im) +! + real(kind=kind_phys), dimension(im) :: xn, yn, ubar, vbar, ulow, & + roll, bnv2bar, scor, dtfac, xlinv, delks, delks1 +! + real(kind=kind_phys) :: taup(im,km+1), taud(im,km) + real(kind=kind_phys) :: taub(im), taulin(im), tausat(im), ahdxres(im) + real(kind=kind_phys) :: heff, hsat, hdis + + integer, dimension(im) :: kref, idxzb, ipt, khtop, iwk, izlow +! +! local real scalars +! + real(kind=kind_phys) :: bnv, fr, ri_gw, brvf, fr2 + real(kind=kind_phys) :: tem, tem1, tem2, temc, temv + real(kind=kind_phys) :: ti, rdz, dw2, shr2, bvf2 + real(kind=kind_phys) :: rdelks, efact, coefm, gfobnv + real(kind=kind_phys) :: scork, rscor, hd, fro, sira + real(kind=kind_phys) :: dtaux, dtauy, zmetp, zmetk + + real(kind=kind_phys) :: grav2, rcpdt, windik, wdir + real(kind=kind_phys) :: sigmin, dxres,sigres,hdxres, cdmb4, mtbridge + + real(kind=kind_phys) :: kxridge, inv_b2eff, zw1, zw2 + real(kind=kind_phys) :: belps, aelps, nhills, selps + + real(kind=kind_phys) :: rgrav, rcpd, rcpd2, rad_to_deg, deg_to_rad + real(kind=kind_phys) :: pi2, pi2h, rdi, gor, grcp, gocp, gr2, bnv2min + + real(kind=kind_phys) :: cleff_max ! resolution-aware max-wn + real(kind=kind_phys) :: nonh_fact ! non-hydroststic factor 1.-(kx/kz_hh)**2 + real(kind=kind_phys) :: fcrit2 + real(kind=kind_phys) :: fr_func, frnd +! +! +! local integers +! + integer :: kmm1, kmm2, lcap, lcapp1 + integer :: npt, kbps + integer :: kmps, idir, nwd, klcap, kp1, kmpbl, kmll + integer :: k_mtb, k_zlow, ktrial, klevm1 + integer :: i, j, k +! +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!=========================== +! First step Check do we have sub-grid hills +! +! +! out-arrays are zreoed in unified_ugwp.F90 +! + do i=1,im + rdxzb(i) = 0.0 + dusfc(i) = 0.0 + dvsfc(i) = 0.0 + ipt(i) = 0 + enddo + +! ---- for lm and gwd calculation points +!cires_ugwp_initialize.F90: real, parameter :: hpmax=2400.0, hpmin=25.0 +!cires_ugwp_initialize.F90: real, parameter :: hminmt=50. ! min mtn height (*j*) +!---- for lm and gwd calculation points +! ccpp-gwdps.f PARAMETER (hpmax=2400.0, hpmin=1.0) parameter (elvmax > hminmt=50.) + + npt = 0 + + do i = 1,im + if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then + npt = npt + 1 + ipt(npt) = i + endif + enddo + + if (npt == 0) then + +! print *, 'orogw_v1 npt = 0 elvmax ', maxval(elvmaxd), hminmt +! print *, 'orogw_v1 npt = 0 hprime ', maxval(hprime), hpmin + + return ! no ogw/mbl calculation done + endif +!=========================== +! scalars from phys-contants added by "CCPP-team" +! by rejecting to use "ugwp_common" +!=========================== + rcpdt = 1.0 / (cpd*dtp) + grav2 = grav + grav +! + rgrav = 1.0/grav + rcpd = 1.0/cpd + rcpd2 = 0.5/cpd + rad_to_deg=180.0/pi + deg_to_rad=pi/180.0 + pi2 = 2.*pi + pi2h = 0.5*pi + rdi = 1.0/rd + gor = grav/rd + grcp = grav*rcpd + gocp = grcp + gr2 = grav*gor + bnv2min = (pi2/1800.)*(pi2/1800.) ! tau_BV_max = 30 min ! +!=========================== +! Start +! +! initialize gamma and sigma +! + gamma(:) = gammad(:) + sigma(:) = sigmad(:) +! +!======================================================================= +! mtb-blocking sigma_min and dxres => cires_initialize (best way ....) +! + sgrmax = maxval(sparea) ; sgrmin = minval(sparea) + dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) + +! ! GTOP30-arc dx~1Km res-n so sso_hill ~ (2-4)*dx + cleff_max = pi2/max(dsmin/5.,sso_min) ! maxval for kx = 6.28/(dx_min/5. ~2.5 km) for C768 + cleff_max = pi2/dsmin + + hdxres = 0.5*dsmax + + gammin = min(sso_min/hdxres, 1.) + gammin = max(0.1, gammin) + ! sigma-degined as tan(angle) = h/2: L/2= h/L + sigmin = hpmin/hdxres ! min-slope Hmin= 2*hpmin, dxres=Lmax + + + + if ( kdt == -1 .and. me == master) then + print *, ' orogw_v1 scale2 ', cdmbgwd(2) + print *, ' orogw_v1 imx ', imx + print *, ' orogw_v1 gam_min ', gammin + print *, ' orogw_v1 sso_min ', sso_min + print *, ' orogw_v1 gam_min ', gammin + print *, ' orogw_v1 npt number of GRID-cells with hills ', npt + endif + +!============================================================ +! Purpose to adjust oro-specification on the fly +! needs to be done 1-time during init-n for each block +! hprime sigma gamma and grid-length must be "related" +! width_mount_a = hprime/sigma < dxres cannot access dxres +! width_mount_b = width_mount_a * gamma +! +! Sellipse= pi a*b = (width_mount_a)^2 *gamma <= Sarea +! Limiters on "elongated" hills gamma= a/b < gam_min +! Limiters on "longest" hills (b, a) <= sqrt(area) +! +! 0.01=gammin < gamma=a_hill/b_hill < 1 +! hpmin/(dx/2)=sigmin < sigma= hprime/a_ell < 1. +! Nhills = (dx*dy=Sarea)/(pi* a_hill *b_hill) +!============================================================= + + arhills(:) =0. + mkd05_hills(:) =0. + + do j = 1,npt + i = ipt(j) + dxres = sqrt(sparea(i)) + ahdxres(j) = dxres + if (gamma(i) > 1.0) gamma(i) = 1.0 + + gamma(i) = max(gammin, gamma(i)) +! +! min-adjustment: 1) abs(gamma(i)) ; 2) sigres = max(sigmin, sigma(i)) +! + sigres = max(sigmin, sigma(i)) + sigma(i) =sigres + aelps = min( hprime(i)/sigres, dxres) + belps = min(aelps/abs(gamma(i)), dxres) + gamma(i) = aelps/belps + + if (do_adjoro ) then +! +! more adjustments "lengths", gamma and sigma, valid assuminng H=2*hprime H/2 = hprime +! + if (hprime(i) > hdxres*sigres) sigres= hprime(i)/dxres + aelps = min( hprime(i)/sigres, hdxres) + sigma(i) = sigres + if (gamma(i) > 0.0 ) belps = min(aelps/gamma(i), dxres) +! +! small-scale "turbulent" oro-hills < sso_min, sso_min_dx = 3km +! will be treated as "circular" elevations +! + if( aelps < sso_min ) then +! +! a, b > sso_min upscale ellipse a/b > 0.1 a>sso_min & h/b=>new_sigm +! + aelps = sso_min + if (belps < sso_min ) then + gamma(i) = 1.0 + belps = aelps*gamma(i) + else + gamma(i) = min(aelps/belps, 1.0) + endif + + sigma(i) = hprime(i)/aelps + gamma(i) = min(aelps/belps, 1.0) + + endif !aelps < sso_min + endif ! ============== (do_adjoro ) + + selps = belps*belps*gamma(i)*pi ! area of the elliptical hill + + nhills = min(nhilmax, sparea(i)/selps) + arhills(j) = max(nhills, 1.0) + +! if (kdt==1 ) write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, belps*1.e-3, sigma(i),gamma(i) + + + enddo + 333 format( ' nhil: ', i6, 4(2x, f9.3), 2(2x, e9.3)) +!======================================================================= +! mtb-blocking : LM-1997; Zadra et al. 2004 ;metoffice dec 2010 H Wells +!======================================================================= + + do i=1,npt + khtop(i) = 2 + idxzb(i) = 0 + enddo + + do k=1,km + do i=1,im + db(i,k) = 0.0 + ang(i,k) = 0.0 + uds(i,k) = 0.0 + enddo + enddo + + kmm1 = km - 1 ; kmm2 = km - 2 ; kmll = kmm1 + lcap = km ; lcapp1 = lcap + 1 + + cdmb4 = 0.25*cdmb + + do i = 1, npt + j = ipt(i) +! +!gfsv15/16: ELVMAX(J) = min (ELVMAX(J) + sigfac * hprime(j), hncrit=8000.) Max-level of SSO-HILL +! + elvmax(j) = min ( sigfac * hprime(j), hncrit) + izlow(i) = 1 ! surface-level + enddo + + +!=================================================================== +! below khtop-level H= 3*hp, and izlow = 0.5*Hp or the "first" layer +! are used tp estimate "Mean" Flow that interact with SG-HILL +! if sig*HP < Hpbl => GWs-> above PBL +! WRF: ( 1 to max(2*Hp or H_pbl) +! GFS-15/16: OGWs (1 to max(Kpbl+1, or K_dPs=(Ps-Pk=50hPa) ~ 950 mb) +! excitation above Kref +! BLOCKING: ZDOMAIN (1 - Kaver => ELVMAX(J) + sigfac * hp) +!=================================================================== + + + do k = 1, kmm1 + do i = 1, npt + j = ipt(i) + + ztoph = sigfac * hprime(j) + zlowh = sigfacs* hprime(j) + zmetp = zmet(j,k+1) + zmetk = zmet(j,k) +! +! GFSv15/16: izlow=1 +! elvmax(j)=elvmaxd(J) + sig*hp: if (( elvmax(j) <= zmetp) .and. (elvmax(j).ge.zmetk) ) khtop(i) = max(khtop(i), k+1 ) +! + + if (( ztoph <= zmetp) .and. (ztoph >= zmetk) ) khtop(i) = max(khtop(i), k+1 ) + if (zlowh <= zmetp .and. zlowh >= zmetk) izlow(i) = max(izlow(i),k) + + enddo + enddo +! + do k = 1,km + do i =1,npt + j = ipt(i) + vtj(i,k) = t1(j,k) * (1.+fv*q1(j,k)) + vtk(i,k) = vtj(i,k) / prslk(j,k) + ro(i,k) = rdi * prsl(j,k) / vtj(i,k) ! density mid-levels + taup(i,k) = 0.0 + enddo + enddo +! +! perform ri_n or ri_mf computation for both OGW and OBL +! + do k = 1,kmm1 + do i =1,npt + j = ipt(i) + rdz = 1. / (zmet(j,k+1) - zmet(j,k)) + tem1 = u1(j,k) - u1(j,k+1) + tem2 = v1(j,k) - v1(j,k+1) + dw2 = tem1*tem1 + tem2*tem2 + shr2 = max(dw2,dw2min) * rdz * rdz + bvf2 = grav2 * rdz * (vtk(i,k+1)-vtk(i,k))/ (vtk(i,k+1)+vtk(i,k)) + + bnv2(i,k+1) = max( bvf2, bnv2min ) + ri_n(i,k+1) = bnv2(i,k)/shr2 ! richardson number consistent with bnv2 +! +! place here computation for "ktur" and ogw-dissipation for the spectral ORO-scheme +! + enddo + enddo + k = 1 + do i = 1, npt + bnv2(i,k) = bnv2(i,k+1) + enddo +! +! level khtop => zmet(j,k) < sigfac * hprime(j) < zmet(j,k+1) +! + do i = 1, npt + j = ipt(i) + k_zlow = izlow(i) + if (k_zlow == khtop(i)) k_zlow = 1 + delks(i) = 1.0 / (prsi(j,k_zlow) - prsi(j,khtop(i))) +! delks1(i) = 1.0 /(prsl(j,k_zlow) - prsl(j,khtop(i))) + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + pe (i) = 0.0 + ek (i) = 0.0 + bnv2bar(i) = 0.0 +! +! computation of the mean flow char zlow < z < ztop =sigfac*hprime +! + do k = k_zlow, khtop(i)-1 + rdelks = del(j,k) * delks(i) + ubar(i) = ubar(i) + rdelks * u1(j,k) + vbar(i) = vbar(i) + rdelks * v1(j,k) + roll(i) = roll(i) + rdelks * ro(i,k) + bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks + enddo + enddo +! + do i = 1, npt + j = ipt(i) +! +! integrate from ztoph = sigfac*hprime down to zblk if exists +! find ph_blk, dz_blk as introduced in LM-97 and ifs +! + ph_blk =0. + do k = khtop(i), 1, -1 + + phiang = atan2(v1(j,k),u1(j,k)) + phiang = theta(j)*rad_to_deg - phiang + + if ( phiang > pi2h ) phiang = phiang - pi + if ( phiang < -pi2h ) phiang = phiang + pi + ang(i,k) = phiang + uds(i,k) = max(sqrt(u1(j,k)*u1(j,k) + v1(j,k)*v1(j,k)), velmin) +! + if (idxzb(i) == 0 ) then + dz_blk = zmeti(j,k+1) - zmeti(j,k) + pe(i) = pe(i) + bnv2(i,k) *( elvmax(j) - zmet(j,k) ) * dz_blk + + up(i) = max(uds(i,k) * cos(ang(i,k)), velmin) + ek(i) = 0.5 * up(i) * up(i) + + ph_blk = ph_blk + dz_blk*sqrt(bnv2(i,k))/up(i) + +! --- dividing stream lime is found when pe =exceeds ek. oper-l gfs +! if ( pe(i) >= ek(i) ) then +! --- LM97 + if ( ph_blk >= fcrit_v1 ) then + idxzb(i) = k + zobl (j) = zmet(j, k) + rdxzb(j) = real(k, kind=kind_phys) + endif + + endif + enddo +! +! fcrit_v1/fr_flow +! + goto 788 +! +! alternative expression for blocking: +! zobl = max(heff*(1. -fcrit_v1/fr_Flow), 0) +! +! + + bnv = sqrt( bnv2bar(i) ) + heff = 2.*min(hprime(j),hpmax) + zw2 = ubar(i)*ubar(i)+vbar(i)*vbar(i) + ulow(i) = sqrt(max(zw2,dw2min)) + fr = heff*bnv/ulow(i) + zw1 = max(heff*(1. -fcrit_v1/fr), 0.0) + zw2 = zmet(j,2) + + if (fr > fcrit_v1 .and. zw1 > zw2 ) then + do k=2, kmm1 + zmetp = zmet(j,k+1) + zmetk = zmet(j,k) + if (zw1 <= zmetp .and. zw1 >= zmetk) exit + enddo + idxzb(i) = k + zobl (j) = zmet(j, k) + endif +788 continue +! +! --- the drag for the blocked flow +! + if ( idxzb(i) > 0 ) then +! +! (4.16)-ifs description +! + gam2 = gamma(j)*gamma(j) + bgam = 1.0 - 0.18*gamma(j) - 0.04*gam2 + cgam = 0.48*gamma(j) + 0.30*gam2 + + do k = idxzb(i)-1, 1, -1 +! +! empirical height dep-nt "blocking" length from LM-1997 +! + zlen = sqrt( (zobl(j)-zmet(j,k) )/(zmet(j,k ) + hprime(j)) ) +! +! + tem = cos(ang(i,k)) + cosang2 = tem * tem + sinang2 = 1.0 - cosang2 +! +! cos =1 sin =0 => 1/r= gam zr = 2.-gam +! cos =0 sin =1 => 1/r= 1/gam zr = 2.- 1/gam +! + rdem = cosang2 + gam2 * sinang2 + rnom = cosang2*gam2 + sinang2 +! +! metoffice dec 2010 +! correction of H. Wells & A. Zadra for the +! aspect ratio of the hill seen by mean flow +! (1/r , r-inverse below: 2-r) + + rdem = max(rdem, 1.e-6) + r = sqrt(rnom/rdem) + zr = max( 2. - r, 0. ) + sigres = max(sigmin, sigma(j)) + + mtbridge = zr * sigres*zlen / hprime(j) +! (4.15)-ifs +! dbtmp = cdmb4 * mtbridge * & +! & max(cos(ang(i,k)), gamma(j)*sin(ang(i,k))) +! (4.16)-ifs + dbtmp = cdmb4*mtbridge*(bgam* cosang2 +cgam* sinang2) +! +! linear damping due to OBL [1/sec]=[U/L_block_orthogonal] +! more accurate along 2-axes of ellipse, here zr-factor is based on Phillips' analytics +! + db(i,k)= dbtmp * uds(i,k) +! if (db(i,k) > dbmax) print *, ' db > dbmax ', 1./db(i,k)/3600., uds(i,k) + db(i,k)= min(db(i,k), dbmax) + enddo +! + endif + enddo +!............................. +!............................. +! end mtn blocking section +!............................. +!............................. +! +!--- OGW section +! +! scale cleff between im=384*2 and 192*2 for t126/t170 and t62 +! inside "cires_ugwp_initialize.f90" now +! + kmpbl = km / 2 + iwk(1:npt) = 2 +! +! in meto/UK-scheme: +! k_mtb = max(k_zmtb, k_n*hprime/2] to reduce diurnal variations taub_ogw +! + do k=3,kmpbl + do i=1,npt + j = ipt(i) + tem = (prsi(j,1) - prsi(j,k)) + if (tem < dpmin) iwk(i) = k ! dpmin=50 mb from the surface + enddo + enddo +! +! iwk - adhoc criteria to select ghe ogw-launch level between +! level ~0.4-0.5 km from surface or/and HPBL-top +! +! in all UGWP-schemes: zogw > zobl +! in ugwp-v1: we consider option for htop ~ (2-3)*hprime > zmtb +! the top hill can be inside PBL.... if kref = khtop +! + + kbps = 1 + kmps = km + k_mtb = 1 + + do i=1,npt + j = ipt(i) + k_mtb = max(1, idxzb(i)) + ! WRF/GSL: kogw = max(kpbl, ktop=2*var) + kref(i) = max(iwk(i), kpbl(j)+1 ) ! reference level pbl or smt-else...Zogw= sigfac*Hprime + kref(i) = max(kref(i), khtop(i) ) ! khtop => sigfac*hprime +! +! zogw > zobl +! + if (kref(i) <= k_mtb) kref(i) = k_mtb + 1 ! layer above blocking + kbps = max(kbps, kref(i)) + kmps = min(kmps, kref(i)) +! + delks(i) = 1.0 / (prsi(j,k_mtb) - prsi(j,kref(i))) + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + bnv2bar(i)= 0.0 + enddo +! +! +!====================== we estimate MF-parameters from k= k_mtb to [kref~kpbl] > k_mtb +!computation of the mean flow for zobl < z < ztop =sigfac*hprime inb GSL ztop =max(hpbl, ztop) +!===================== + do i = 1,npt + k_mtb = max(1, idxzb(i)) + do k = k_mtb,kbps !kbps = max(kref) kref = (kpbl+1, khtop) + if (k < kref(i)) then + j = ipt(i) + rdelks = del(j,k) * delks(i) + ubar(i) = ubar(i) + rdelks * u1(j,k) ! mean u below kref + vbar(i) = vbar(i) + rdelks * v1(j,k) ! mean v below kref + roll(i) = roll(i) + rdelks * ro(i,k) ! mean ro below kref + bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks + endif + enddo + enddo +! +! orographic asymmetry parameters (oa), and (clx) [Kim & Arakawa Kim & Doyle] +! + do i = 1,npt + j = ipt(i) + wdir = atan2(ubar(i),vbar(i)) + pi ! not sure about "+pi" due to "nwdir"-Kim OA/CLX-processing + idir = mod(nint(fdir*wdir),mdir) + 1 + nwd = nwdir(idir) + oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(j,mod(nwd-1,4)+1) + + clx(i) = clx4(j,mod(nwd-1,4)+1) ! number of "effective" hills in the grid-box KA-95/KD-05 +! +!GSLdrag ->identical to above +! +! wdir = atan2(ubar(i),vbar(i)) + pi +! idir = mod(nint(fdir*wdir),mdir) + 1 +! nwd = nwdir(idir) +! oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1) +! ol(i) = ol4(i,mod(nwd-1,4)+1) +! + dtfac(i) = 1.0 + icrilv(i) = .false. ! initialize critical level control Logic + + ulow(i) = max(sqrt(ubar(i)*ubar(i)+vbar(i)*vbar(i)),velmin) + xn(i) = ubar(i) / ulow(i) + yn(i) = vbar(i) / ulow(i) + enddo +! + do k = 1, kmm1 + do i = 1,npt + j = ipt(i) + velco(i,k) = 0.5 * ((u1(j,k)+u1(j,k+1))*xn(i)+ (v1(j,k)+v1(j,k+1))*yn(i)) + enddo + enddo + + do i = 1,npt + velco(i,km) = velco(i,kmm1) + enddo +! +!------------------------------------------------------------------------ +! v0/v1: incorporates modifications for kxridge and heff/hsat +! and employs taulin for fr <=fcrit_v1 +! concept of "clipped" hill if zmtb > 0. is uded to make +! the integrated "tau_sso = tau_ogw +tau_mtb" close to reanalysis +! now it is still used the "single-orowave" along ulow-upwind +! +! in contrast ifs/meto/e-canada employ the 2-orthogonal wave (2otw) schemes of +! it requires "aver angle" and wind projections on axes of ell-hill +! with 2-stresses: taub_a/b as suggested by analytics of Phillips (1984) +!------------------------------------------------------------------------ + + taub(:) = 0. ; taulin(:)= 0. ;taub_kd05 =0. + fcrit2 =fcrit_v1*fcrit_v1 +! +! taub_oro as in KA-95/KD-05 GSL & EMC includes ALL waves (POGWs, Lee-rotors, etc...) +! here taub represents mainly OGWs with nonh_fact = 1. -(kx/kz)**2 +! LLWB for Lee-rotors (downslope dynamics and flow-splitting ) is not considered +! + do i = 1,npt + j = ipt(i) + bnv = sqrt( bnv2bar(i) ) + heff = min(hprime(j),hpmax) + + if( zobl(j) > 0.) heff = max(sigfac*heff-zobl(j), 0.)/sigfac + + if (heff <= 0) cycle + zw1 = ulow(i)/bnv + hsat = fcrit_v1 *zw1 + heff = min(heff, hsat) ! similar hsat-limit in CAM as found in Dec 2020 + + fr = heff/zw1 ! Fr-GSL = Fr * OD -> gamma + + fr = min(fr, frmax) + fr2 = fr*fr + zw2 = fr2 *oc(j) ! oc-values from 0 to 10 (GSL => 100) + ! Fr-funct = zw2/(zw2+cg) +! +! [Kim & Doyle, 2005] +! + efact = (oa(i) + 2.) ** (ceofrc*fr) ! enhnancement factor due to the resonance ampification/downstream + efact = min( max(efact,efmin), efmax ) + gfobnv = efact* gmax /(zw2 + cg) ! withoutt "multiplication" on =zw2 +! +! !cleff_max(C768 = 6.28/(12.5 km/5.)) ..... +! xlinv(i) = min(coefm * cleff, cleff_max) +! + mkd05_hills(i) = (1. + clx(i)) ** (oa(i)+1.) ! ex-coefm (1-2) of eff-hills with "some" anizoropy as in KD-2005 + + + xlinv(i) = min(cleff * mkd05_hills(i), cleff_max) + + taub_kd05(i) = roll(i)*xlinv(i) *(gfobnv *zw2)* (zw1 * ulow(i)* ulow(i)) +! +! old: tem = fr2*oc(j) ; gfobnv = gmax * tem / ((tem + cg)*bnv(i)) +! kx =or max(kxridge, inv_b2eff) ! 6.28/lx ..0.5*sigma(j)/heff = 1./lridge +! + sigres = sigma(j) + inv_b2eff = pi*sigres/heff ! pi2/(2b) + kxridge = pi /ahdxres(i) ! pi2/(2*dx) + xlingfs = max(inv_b2eff, kxridge) +! +! xlinv(i) = max(xlingfs, xlinv(i) ) + + nonh_fact = 1. - xlinv(i)*zw1 * xlinv(i)*zw1 ! 1- (kx/kz)^2 + + if ( nonh_fact <= 0.) cycle ! non-hydrostatic trapping kx = kz = N/U +! + taulin(i) = xlinv(i)*roll(i)*bnv*ulow(i)*heff*heff * nonh_fact + tausat(i) = xlinv(i)*roll(i)* zw1*ulow(i)*ulow(i) *fcrit2 * nonh_fact +! +! taulin(i) = xlinv(i)*roll(i)*ulow(i)**3/bnv *fr2 => +! fr2 = (bnv*heff/Ulow)**2 + non-hydrostatic trapping effects Fr2_nh = Fr2 - kx2*heff^2 +! + if ( fr > fcrit_v1 ) then +! + frnd = fr/fcrit_v1 + fr_func = frnorm* frnd*frnd/(afr + frnd ** nfr) + taub(i) = tausat(i) *max(fr_func, max_frf) ! nonlinear flux tau0...xlinv(i) + else + taub(i) = taulin(i) ! linear flux for fr <= fcrit_v1 + endif + xlinv(i) = .5*xlinv(i) ! 1/2 rhoint-factor in Ri-solver of PSS-1986 +! + k = max(1, kref(i)-1) + tem = max(velco(i,k)*velco(i,k), dw2min) + scor(i) = bnv2(i,k) / tem ! scorer parameter below kref level Bn2/U2= kz^2 +! +! diagnostics for zogw, tau_ogw +! + zogw(j) = zmeti(j, kref(i) ) + tau_ogw(j) = taub(i) + +! if (kdt == 1) then +! print *, ' tau =', nint(taub(i)*1.e3), ' tkd05 =', nint(taub_kd05(i)*1.e3), 'Fr=', Fr +! print *, ' zogw=', nint(zogw(j)), ' zobl=', nint(zobl(j)) ! nint(mkd05_hills(i)), nint(arhills(i)) +! endif + + enddo +! +!----set up bottom values of stress +! + do i = 1,npt + taup(i, 1:kref(i) ) = taub(i) + enddo +!====================================================== +! +! Having : taub(i)/tau_ogw(j) => solve for OGW-effects +! +!====================================================== + if (strsolver == 'pss-1986') then + +!====================================================== +! v0-gfs orogw-solver of palmer et al 1986 -"pss-1986" +! modified by KD05 with the expression (11):below k=kref ??? +! tau(k+1) = tau(k)*Scorer(K+1)/Scorer(K) +! +! in v1-orogw linsatdis of "wam-2017" +! with llwb-mechanism for +! rotational/non-hydrostat ogws important for +! highres-fv3gfs with dx < 10 km +!====================================================== + + do k = kmps, kmm1 ! vertical level loop from min(kref) + kp1 = k + 1 + + do i = 1, npt + if (k >= kref(i)) then + icrilv(i) = icrilv(i) .or. ( ri_n(i,k) < ric).or. (velco(i,k) <= 0. ) + endif + enddo +! + do i = 1,npt + if (k >= kref(i)) then + if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) then + zw1 = max(velco(i,k), velmin) + temv = 1.0 / zw1 +!=============== +! Condition for levels below kref(i): k+1 < kref(i)) ??? see KD05 expression (11) for LLWB ??? only OA >0 +! k >= kref(i) and .... k+1 0. .and. kp1 < kref(i)) then + scork = bnv2(i,k) * temv * temv + rscor = min(1.0, scork / scor(i)) + scor(i) = scork + else + rscor = 1. + endif +!=============== + brvf = sqrt(bnv2(i,k)) ! brent-vaisala frequency interface +! xlinv(i)*0.5 + tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k)) *brvf* zw1 + + hd = sqrt(taup(i,k) / tem1) + fro = brvf * hd * temv +! +! rim is the "wave"-richardson number byPalmer,Shutts & Swinbank 1986 , PSS-1986 +! + tem2 = sqrt(ri_n(i,k)) + tem = 1. + tem2 * fro + ri_gw = ri_n(i,k) * (1.0-fro) / (tem * tem) +! +! check Ri-stability to employ the 'dynamical saturation hypothesis' PSS-1986 +! assuming co-existence of Dyn-Ins and Conv-Ins +! + if (ri_gw <= ric .and.(oa(i) <= 0. .or. kp1 >= kref(i) )) then + temc = 2.0 + 1.0 / tem2 + hd = zw1 * (2.*sqrt(temc)-temc) / brvf + taup(i,kp1) = tem1 * hd * hd + else + + taup(i,kp1) = taup(i,k) * rscor + endif +! + taup(i,kp1) = min(taup(i,kp1), taup(i,k)) + endif ! if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) + endif ! k >= kref(i)) + enddo ! oro-points + enddo ! do k = kmps, kmm1 vertical level loop +! +! zero momentum deposition at the top model layer: taup(k+1) = taup(k) +! + taup(1:npt,km+1) = taup(1:npt,km) +! +! calculate wave acc-n: - (grav)*d(tau)/d(p) = taud +! + do k = 1,km + do i = 1,npt + zw1 = grav*(taup(i,k+1) - taup(i,k))/del(ipt(i),k) +!====================================================================================== +! we estimated "impact" of the single sub-grid hill, we have "arhills" in the grid-box +! 2-estimations of "nhills": 1) geometry-arhills and 2) KDO5 mkd05_hills +! for OBL we used: 1) nhills=Grid_Area/Hill_area +! nhills = max(mkd05_hills(i), arhills(i)) +! Trapped "Lee" downslope wave regimes are not properly modelled: vertical shear +NH/Nonlin +! tau(z) = const => tau(z)/m2(z) = const (empirical mesoscale) +! +! Apply dU/dt-limiter +! +!====================================================================================== +! zw1 = zw1 * arhills(i) ! simple scale-awareness nhills=Grid_Area/Hill_area +! apply limiters for OGW tendency +!====================================================================================== + if (abs(zw1) > max_axyz ) then + zw1 = sign(max_axyz, zw1) +! if (kdt <=2 ) then +! print *, ' Hdudt ', nint(max_axyz*1.e5), nint(zw2*1.e5) +! print *, ' Hdudt ', xn(i), yn(i) +! endif + endif + taud(i,k)= zw1 + enddo + enddo + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +!------if the gravity wave drag would force a critical line in the +!------layers below sigma=rlolev during the next deltim timestep, +!------then only apply drag until that critical line is reached. +! empirical implementation of the llwb-mechanism: lower level wave breaking +! by limiting "ax = dtfac*ax" due to possible llwb around kref and 500 mb +! critical line [v - ax*dtp = 0.] is smt like "llwb" for stationary ogws +!2019: this option limits sensitivity of taux/tauy to variations in "taub" +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + do k = 1,kmm1 + do i = 1,npt + + if (k >= kref(i) .and. prsi(ipt(i),k) >= rlolev) then + + if(taud(i,k) /= 0.) then + tem = dtp * taud(i,k) ! tem = du/dt-oro*dt => U/dU vs 1 + dtfac(i) = min(dtfac(i),abs(velco(i,k)/tem)) ! reduce Ax= Ax*(1, or U/dU <=1) +! dtfac(i) = 1.0 + endif + endif + enddo + enddo +! +!--------- orogw-solver of gfs PSS-1986 is performed + + else + +!----------- orogw-solver of wam2017 out : taup, taud, pkdis + + dtfac(:) = 1.0 + + call oro_spectral_solver(im, km, npt, ipt, kref, kdt, me, master, & + dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsl, & + grav, con_omega, rd, & + del, sigma, hprime, gamma, theta, sinlat, xlatd, taup, taud, pkdis) + + endif ! oro_linsat - linsatdis-solver for stationary OGWs +! +!---- above orogw-solver of wam2017------------ +! +! tofd as in Beljaars-2004 IFS sep-scale ~5km +! CESM ~ 6km (TMS + OGW/OBL) +! sgh30 = varss of GSL (?) +! ---------------------------------------------- + + if( do_tofd ) then +! +! can scale varss(j) by adjusting filterd oro_turb spectra +! a1-coeff by (Lx_flt_cXXX/Lx_c768)^1.9 +! +! klow = 6.28/10km of Beljaars_etal_2004 and kflt^n1 +! kflt = 6.28/18km +! if ( kdt == 1 .and. me == 0) then +! print *, 'ugwp-v1 do_tofd from surface to ', ztop_tofd +! endif + + do i = 1,npt + j = ipt(i) + zpbl = zmet( j, kpbl(j) ) + + sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of ls-sso + ! GSL-2/limits a) 250 m ; b) var_maxfd =150m + zsurf = zmeti(j,1) + + do k=1,km + zpm(k) = zmet(j,k) + up1(k) = u1(j,k) + vp1(k) = v1(j,k) + enddo + + call ugwp_tofd1d(km, cpd, dtp, sigflt, zsurf, zpbl, & + up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) + + do k=1,km + dudt_ofd(j,k) = utofd1(k) + dvdt_ofd(j,k) = vtofd1(k) +! +! add tofd to gw-tendencies +! + pdvdt(j,k) = pdvdt(j,k) + utofd1(k) + pdudt(j,k) = pdudt(j,k) + vtofd1(k) + pdtdt(j,k) = pdtdt(j,k) + epstofd1(k) + enddo +!2018-diag + du_ofdcol(j) = sum( utofd1(1:km)* del(j,1:km)) + dv_ofdcol(j) = sum( vtofd1(1:km)* del(j,1:km)) + + dusfc(j) = dusfc(j) + du_ofdcol(j) + dvsfc(j) = dvsfc(j) + dv_ofdcol(j) + enddo + endif ! do_tofd + +!-------------------------------------------- +! combine oro-drag effects MB +TOFD + OGWs + diag-3d +!-------------------------------------------- +! + + do k = 1,km + do i = 1,npt + j = ipt(i) +! + eng0 = 0.5*(u1(j,k)*u1(j,k)+v1(j,k)*v1(j,k)) +! + if ( k < idxzb(i) .and. idxzb(i) /= 0 ) then +! +! if blocking layers -- no ogws +! + dbim = db(i,k) / (1.+db(i,k)*dtp) + + dudt_obl(j,k) = -dbim * u1(j,k) + dvdt_obl(j,k) = -dbim * v1(j,k) + + pdvdt(j,k) = dudt_obl(j,k) +pdvdt(j,k) + pdudt(j,k) = dvdt_obl(j,k) +pdudt(j,k) +!2018-diag + du_oblcol(j) = du_oblcol(j) + dudt_obl(j,k)* del(j,k) + dv_oblcol(j) = dv_oblcol(j) + dvdt_obl(j,k)* del(j,k) + + dusfc(j) = dusfc(j) + du_oblcol(j) + dvsfc(j) = dvsfc(j) + dv_oblcol(j) + + else +! +! ogw-s above blocking height +! + taud(i,k) = taud(i,k) * dtfac(i) + dtaux = taud(i,k) * xn(i) + dtauy = taud(i,k) * yn(i) +! + dudt_ogw(j,k) = dtaux + dvdt_ogw(j,k) = dtauy +! + pdvdt(j,k) = dtauy +pdvdt(j,k) + pdudt(j,k) = dtaux +pdudt(j,k) + +! + du_ogwcol(j) = du_ogwcol(j) + dtaux * del(j,k) + dv_ogwcol(j) = dv_ogwcol(j) + dtauy * del(j,k) +! + dusfc(j) = dusfc(j) + du_ogwcol(j) + dvsfc(j) = dvsfc(j) + dv_ogwcol(j) + endif +!============ +! local energy deposition sso-heat due to loss of kinetic energy +!============ + unew = u1(j,k) + pdudt(j,k)*dtp ! pdudt(j,k)*dtp + vnew = v1(j,k) + pdvdt(j,k)*dtp ! pdvdt(j,k)*dtp + eng1 = 0.5*(unew*unew + vnew*vnew) + pdtdt(j,k) = max(eng0-eng1,0.)*rcpdt + pdtdt(j,k) + + enddo + enddo +! dusfc w/o tofd sign as in the era-i, merra and cfsr + do i = 1,npt + j = ipt(i) + dusfc(j) = -rgrav * dusfc(j) + dvsfc(j) = -rgrav * dvsfc(j) + du_ogwcol(j) = -rgrav *du_ogwcol (j) + dv_ogwcol(j) = -rgrav *dv_ogwcol (j) + du_oblcol(j) = -rgrav *du_oblcol (j) + dv_oblcol(j) = -rgrav *dv_oblcol (j) + tau_ogw(j) = -rgrav * tau_ogw(j) + du_ofdcol(j) = -rgrav * du_ofdcol(j) + dv_ofdcol(j) = -rgrav * du_ofdcol(j) + enddo + + return + + +!============ debug ------------------------------------------------ + if (kdt <= 2 .and. me == 0) then + print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw_axoro' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw_ayoro' +! print *, maxval(kdis), minval(kdis), 'vgw_kdispro m2/sec' + print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw_epsoro' +! print *, maxval(zobl), ' z_mtb ', maxval(tau_mtb), ' tau_mtb ' + print *, maxval(zogw), ' z_ogw ', maxval(tau_ogw), ' tau_ogw ' +! print *, maxval(tau_tofd), ' tau_tofd ' +! print *, maxval(axtms)*86400., minval(axtms)*86400, 'vgw_axtms' +! print *,maxval(dudt_mtb)*86400.,minval(dudt_mtb)*86400,'vgw_axmtb' + if (maxval(abs(pdudt))*86400. > 100.) then + + print *, maxval(u1), minval(u1), ' u1 gwdps-v1 ' + print *, maxval(v1), minval(v1), ' v1 gwdps-v1 ' + print *, maxval(t1), minval(t1), ' t1 gwdps-v1 ' + print *, maxval(q1), minval(q1), ' q1 gwdps-v1 ' + print *, maxval(del), minval(del), ' del gwdps-v1 ' + print *, maxval(zmet),minval(zmet), 'zmet' + print *, maxval(zmeti),minval(zmeti), 'zmeti' + print *, maxval(prsi), minval(prsi), ' prsi ' + print *, maxval(prsl), minval(prsl), ' prsl ' + print *, maxval(ro), minval(ro), ' ro-dens ' + print *, maxval(bnv2(1:npt,:)), minval(bnv2(1:npt,:)),' bnv2 ' + print *, maxval(kpbl), minval(kpbl), ' kpbl ' + print *, maxval(sgh30), maxval(hprime), maxval(elvmax),'oro-d' + print * + do i =1, npt + j= ipt(i) + print *,zogw(j)/hprime(j), zobl(j)/hprime(j), & + zmet(j,1)*1.e-3, nint(hprime(j)/sigma(j)) +! + enddo + print * + stop + endif + endif + + return + end subroutine orogw_v1 +! +! + subroutine ugwp_tofd1d(levs, con_cp, dtp, sigflt, zsurf, zpbl, u, v, & + zmid, utofd, vtofd, epstofd, krf_tofd) + + use machine , only : kind_phys + use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd +! +! adding the implicit tendency estimate +! + implicit none + integer, intent(in) :: levs + real(kind_phys), intent(in) :: con_cp + real(kind_phys), intent(in) :: dtp + + real(kind_phys), intent(in), dimension(levs) :: u, v, zmid + real(kind_phys), intent(in) :: sigflt, zpbl, zsurf + + real(kind_phys), intent(out), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd + + +! +! locals +! + integer :: i, k + real(kind=kind_phys) :: rcpd2, tofd_mag, tofd_zdep + real(kind_phys) :: unew, vnew, eknew + real(kind=kind_phys), parameter :: sghmax = 5. ! dz(1)/5= 25/5 m dz-of the first layer + real(kind=kind_phys), parameter :: tend_imp = 1. + + + real(kind=kind_phys) :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, ztexp, krf +! + utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 + rcpd2 = 0.5/con_cp +! + zdec = max(n_tofd*sigflt, zpbl) ! ntimes*sgh_turb or Zpbl + zdec = min(ze_tofd, zdec) ! cannot exceed ~1.5 km +! H_efold = max(2*varss, hpbl) +! H_efold = min(H_efold,1500.) + rzdec = 1.0/zdec + + sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! 25 meters dz-of the first layer + tofd_mag = const_tofd * a12_tofd * sgh2 ! * scale_res + +! GSL-scheme: varmax_fd, beta_fd ,250. +! var_temp = MIN(varss,varmax_fd) + MAX(0., 0.1*(varss-varmax_fd)) +! var_temp = MIN(var_temp, 250.) +! var_temp = var_temp * var_temp +! +! a12=a1* 0.005363 * 0.0759 * 0.00026615161 +! +! rzdec 1./H_efold +! do k=1,levs +! zmet = zmid(k)-zsurf +! wsp=SQRT(u(k)*u(k) + v(k)*v(k)) ! abs(V) +! zarg = zmet*rzdec +! var_temp = var_temp * a12 * exp(-zarg*sqrt(zarg))*zmet**(-1.2) ! this > 0 +! krf = var_temp * wsp /(1. + var_temp*dtp*wsp) +! utofd(k) = -u(k) *krf +! vtofd(k) = -v(k)/(1. + var_temp*krf +! enddo + + do k=1, levs + zmet = zmid(k)-zsurf + if (zmet > ztop_tofd) cycle + + ekin = u(k)*u(k) + v(k)*v(k) + + umag = sqrt(ekin) + zarg = zmet*rzdec + ztexp = exp(-zarg * sqrt(zarg)) + + tofd_zdep = zmet ** (-1.2) *ztexp + krf = umag * tofd_mag * tofd_zdep + + if (tend_imp == 1.) then + krf = krf/(1.+krf*dtp) + endif + + utofd(k) = -krf*u(k) + vtofd(k) = -krf*v(k) + if (tend_imp == 1.) then + unew =u(k)+ utofd(k)*dtp ; vnew =v(k)+ vtofd(k)*dtp + eknew =unew*unew + vnew*vnew + epstofd(k) = rcpd2*(ekin-eknew) + else + epstofd(k) = rcpd2*krf*ekin + endif + ! more accurate heat/mom form using "implicit tend-solver" + ! to update momentum and temp-re; epstofd(k) can be skipped + krf_tofd(k) = krf ! can be used as addition to the mesoscale blocking + enddo +! + end subroutine ugwp_tofd1d + +end module cires_ugwpv1_oro diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/cires_ugwpv1_solv2.F90 new file mode 100644 index 000000000..ad8f8090d --- /dev/null +++ b/physics/cires_ugwpv1_solv2.F90 @@ -0,0 +1,1045 @@ +module cires_ugwpv1_solv2 + + +contains + + +!--------------------------------------------------- +! Broad spectrum FVS-1993, mkz^nSlope with nSlope = 0, 1,2 +! dissipative solver with NonHyd/ROT-effects +! reflected GWs treated as waves with "negligible" flux, +! they are out of given column +!--------------------------------------------------- +! call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, & +! tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, & +! zmet, zmeti,prslk, xlat_d, sinlat, coslat, & +! con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt, & +! dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw) + + subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & + tau_ngw, tm , um, vm, qm, prsl, prsi, zmet, zmeti, prslk, & + xlatd, sinlat, coslat, & + con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt, & + pdudt, pdvdt, pdtdt, dked, zngw) +! +!-------------------------------------------------------------------------------- +! nov 2015 alternative gw-solver for nggps-wam +! nov 2017 nh/rotational gw-modes for nh-fv3gfs +! oct 2019 adding empirical satellite-based +! source function and *F90 CIRES-style of the code +! oct 2020 Diagnostics of "tauabs, wrms, trms" is taken out +! -------------------------------------------------------------------------------- +! + use machine, only : kind_phys + + use cires_ugwpv1_module,only : krad, kvg, kion, ktg, iPr_ktgw, Pr_kdis, Pr_kvkt + + use cires_ugwpv1_module,only : knob_ugwp_doheat, knob_ugwp_dokdis, idebug_gwrms + + use cires_ugwpv1_module,only : psrc => knob_ugwp_palaunch + + use cires_ugwpv1_module,only : maxdudt, maxdtdt, max_eps, dked_min, dked_max + + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpdl, grav2cpd, & + omega2, rcpd, rcpd2, pi, pi2, fv, & + rad_to_deg, deg_to_rad, & + rdi, gor, grcp, gocp, & + bnv2min, bnv2max, dw2min, velmin, gr2, & + hpscale, rhp, rh4, grav2, rgrav2, mkzmin, mkz2min +! + use ugwp_wmsdis_init, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & + gw_eff, & + nslope, ilaunch, zms, & + zci, zdci, zci4, zci3, zci2, & + zaz_fct, zcosang, zsinang, nwav, nazd, & + zcimin, zcimax, rimin, sc2, sc2u, ric +! + implicit none +! + real(kind=kind_phys), intent(in) :: con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt + + real(kind=kind_phys), parameter :: zsp_gw = 106.5e3 ! sponge for GWs above the model top + real(kind=kind_phys), parameter :: linsat2 = 1.0, dturb_max = 100.0 + integer, parameter :: ener_norm =0 + integer, parameter :: ener_lsat=0 + integer, parameter :: nstdif = 1 + integer, parameter :: wave_sponge = 1 + + integer, intent(in) :: levs ! vertical level + integer, intent(in) :: im ! horiz tiles + integer, intent(in) :: mpi_id, master, kdt + + real(kind=kind_phys) ,intent(in) :: dtp ! model time step + real(kind=kind_phys) ,intent(in) :: tau_ngw(im) + + real(kind=kind_phys) ,intent(in) :: vm(im,levs) ! meridional wind + real(kind=kind_phys) ,intent(in) :: um(im,levs) ! zonal wind + real(kind=kind_phys) ,intent(in) :: qm(im,levs) ! spec. humidity + real(kind=kind_phys) ,intent(in) :: tm(im,levs) ! kinetic temperature + + real(kind=kind_phys) ,intent(in) :: prsl(im,levs) ! mid-layer pressure + real(kind=kind_phys) ,intent(in) :: prslk(im,levs) ! mid-layer exner function + real(kind=kind_phys) ,intent(in) :: zmet(im,levs) ! meters now !!!!! phil =philg/grav + real(kind=kind_phys) ,intent(in) :: prsi(im,levs+1) ! interface pressure + real(kind=kind_phys) ,intent(in) :: zmeti(im,levs+1) ! interface geopi/meters + real(kind=kind_phys) ,intent(in) :: xlatd(im) ! xlat_d in degrees + real(kind=kind_phys) ,intent(in) :: sinlat(im) + real(kind=kind_phys) ,intent(in) :: coslat(im) +! +! out-gw effects +! + real(kind=kind_phys) ,intent(out) :: pdudt(im,levs) ! zonal momentum tendency + real(kind=kind_phys) ,intent(out) :: pdvdt(im,levs) ! meridional momentum tendency + real(kind=kind_phys) ,intent(out) :: pdtdt(im,levs) ! gw-heating (u*ax+v*ay)/cp and cooling + real(kind=kind_phys) ,intent(out) :: dked(im,levs) ! gw-eddy diffusion + real(kind=kind_phys) ,intent(out) :: zngw(im) ! launch height +! +! +! +! local =========================================================================================== + + real(kind=kind_phys) :: tauabs(im,levs) ! + real(kind=kind_phys) :: wrms(im,levs) ! + real(kind=kind_phys) :: trms(im,levs) ! + + real(kind=kind_phys) :: zwrms(nwav,nazd), wrk1(levs), wrk2(levs) + real(kind=kind_phys) :: atrms(nazd, levs),awrms(nazd, levs), akzw(nwav,nazd, levs+1) +! +! local =========================================================================================== + real(kind=kind_phys) :: taux(levs+1) ! EW component of vertical momentum flux (pa) + real(kind=kind_phys) :: tauy(levs+1) ! NS component of vertical momentum flux (pa) + real(kind=kind_phys) :: fpu(nazd, levs+1) ! az-momentum flux + real(kind=kind_phys) :: ui(nazd, levs+1) ! azimuthal wind + + real(kind=kind_phys) :: fden_bn(levs+1) ! density/brent + real(kind=kind_phys) :: flux (nwav, nazd) , flux_m (nwav, nazd) +! + real(kind=kind_phys) :: bn(levs+1) ! interface BV-frequency + real(kind=kind_phys) :: bn2(levs+1) ! interface BV*BV-frequency + real(kind=kind_phys) :: rhoint(levs+1) ! interface density + real(kind=kind_phys) :: uint(levs+1) ! interface zonal wind + real(kind=kind_phys) :: vint(levs+1) ! meridional wind + real(kind=kind_phys) :: tint(levs+1) ! temp-re + + real(kind=kind_phys) :: irhodz_mid(levs) + real(kind=kind_phys) :: suprf(levs+1) ! RF-super linear dissipation + real(kind=kind_phys) :: cstar(levs+1) ,cstar2(levs+1) + real(kind=kind_phys) :: v_zmet(levs+1) + real(kind=kind_phys) :: vueff(levs+1) + real(kind=kind_phys) :: dfdz_v(nazd, levs), dfdz_heat(nazd, levs) ! axj = -df*rho/dz directional Ax + + real(kind=kind_phys), dimension(levs) :: atm , aum, avm, aqm, aprsl, azmet, dz_met + real(kind=kind_phys), dimension(levs+1) :: aprsi, azmeti, dz_meti + + real(kind=kind_phys), dimension(levs) :: wrk3 + real(kind=kind_phys), dimension(levs) :: uold, vold, told, unew, vnew, tnew + real(kind=kind_phys), dimension(levs) :: rho, rhomid, adif, cdif, acdif + real(kind=kind_phys), dimension(levs) :: Qmid, AKT + real(kind=kind_phys), dimension(levs+1) :: dktur, Ktint, Kvint + real(kind=kind_phys), dimension(levs+1) :: fden_lsat, fden_bnen + + integer, dimension(levs) :: Anstab + + real(kind=kind_phys) :: sig_u2az(nazd), sig_u2az_m(nazd) + real(kind=kind_phys) :: wave_dis(nwav, nazd), wave_disaz(nazd) + real(kind=kind_phys) :: rdci(nwav), rci(nwav) + real(kind=kind_phys) :: wave_act(nwav, nazd) ! active waves at given vert-level + real(kind=kind_phys) :: ul(nazd) ! velocity in azimuthal direction at launch level +! +! scalars +! + real(kind=kind_phys) :: bvi, bvi2, bvi3, bvi4, rcms ! BV at launch level + real(kind=kind_phys) :: c2f2, cf1, wave_distot + + + real(kind=kind_phys) :: flux_norm ! norm-factor + real(kind=kind_phys) :: taub_src, rho_src, zcool, vmdiff +! + real(kind=kind_phys) :: zthm, dtau, cgz, ucrit_maxdc + real(kind=kind_phys) :: vm_zflx_mode, vc_zflx_mode + real(kind=kind_phys) :: kzw2, kzw3, kdsat, cdf2, cdf1, wdop2,v_cdp2 + real(kind=kind_phys) :: ucrit_max + real(kind=kind_phys) :: pwrms, ptrms + real(kind=kind_phys) :: zu, zcin, zcin2, zcin3, zcin4, zcinc + real(kind=kind_phys) :: zatmp, fluxs, zdep, ze1, ze2 + +! + real(kind=kind_phys) :: zdelp, zdelm, taud_min + real(kind=kind_phys) :: tvc, tvm, ptc, ptm + real(kind=kind_phys) :: umfp, umfm, umfc, ucrit3 + real(kind=kind_phys) :: fmode, expdis, fdis + real(kind=kind_phys) :: v_kzi, v_kzw, v_cdp, v_wdp, tx1, fcorsat, dzcrit + real(kind=kind_phys) :: v_wdi, v_wdpc + real(kind=kind_phys) :: ugw, vgw, ek1, ek2, rdtp, rdtp2, rhp_wam + + integer :: j, jj, k, kk, inc, jk, jkp, jl, iaz + integer :: ksrc, km2, km1, kp1, ktop +! +! Kturb-part +! + real(kind=kind_phys) :: uz, vz, shr2 , ritur, ktur + + real(kind=kind_phys) :: kamp, zmetk, zgrow + real(kind=kind_phys) :: stab, stab_dt, dtstab + real(kind=kind_phys) :: nslope3 +! + integer :: nstab, ist + real(kind=kind_phys) :: w1, w2, w3, dtdif + + real(kind=kind_phys) :: dzmetm, dzmetp, dzmetf, bdif, bt_dif, apc, kturp + real(kind=kind_phys) :: rstar, rstar2 + + real(kind=kind_phys) :: snorm_ener, sigu2, flux_2_sig, ekin_norm + real(kind=kind_phys) :: taub_ch, sigu2_ch + real(kind=kind_phys) :: Pr_kdis_eff, mf_diss_heat, iPr_max + real(kind=kind_phys) :: exp_sponge, mi_sponge, gipr + +!-------------------------------------------------------------------------- +! + nslope3 = nslope + 3.0 + Pr_kdis_eff = gw_eff*pr_kdis + iPr_max = max(1.0, iPr_ktgw) + gipr = grav* Ipr_ktgw +! +! test for input fields +! + if (mpi_id == master .and. kdt < -2) then + print *, im, levs, dtp, kdt, ' vay-solv2-v1' + print *, minval(tm), maxval(tm), ' min-max-tm ' + print *, minval(vm), maxval(vm), ' min-max-vm ' + print *, minval(um), maxval(um), ' min-max-um ' + print *, minval(qm), maxval(qm), ' min-max-qm ' + print *, minval(prsl), maxval(prsl), ' min-max-Pmid ' + print *, minval(prsi), maxval(prsi), ' min-max-Pint ' + print *, minval(zmet), maxval(zmet), ' min-max-Zmid ' + print *, minval(zmeti), maxval(zmeti), ' min-max-Zint ' + print *, minval(prslk), maxval(prslk), ' min-max-Exner ' + print *, minval(tau_ngw), maxval(tau_ngw), ' min-max-taungw ' + print *, tau_min, ' tau_min ', tamp_mpa, ' tamp_mpa ' +! + endif + + if (idebug_gwrms == 1) then + tauabs=0.0; wrms =0.0 ; trms =0.0 + endif + + rci(:) = 1./zci(:) + rdci(:) = 1./zdci(:) + + rdtp = 1./dtp + rdtp2 = 0.5*rdtp + + ksrc= max(ilaunch, 3) + km2 = ksrc - 2 + km1 = ksrc - 1 + kp1 = ksrc + 1 + ktop= levs+1 + suprf(ktop) = kion(levs) + do k=1,levs + suprf(k) = kion(k) ! approximate 1-st order damping with Fast super-RF of FV3 + pdvdt(:,k) = 0.0 + pdudt(:,k) = 0.0 + pdtdt(:,k) = 0.0 + dked(: ,k) = 0.0 + enddo + +!----------------------------------------------------------- +! column-based j=1,im pjysics with 1D-arrays +!----------------------------------------------------------- + DO j=1, im + + jl =j + tx1 = omega2 * sinlat(j) *rv_kxw + cf1 = abs(tx1) + c2f2 = tx1 * tx1 + ucrit_max = max(ucrit, cf1) + ucrit3 = ucrit_max*ucrit_max*ucrit_max +! +! ngw-fluxes at all gridpoints (with tau_min at least) +! + aprsl(1:levs) = prsl(jl,1:levs) +! +! ksrc-define "aprsi(1:levs+1) redefine "ilaunch" +! + do k=1, levs + if (aprsl(k) .lt. psrc ) exit + enddo + ilaunch = max(k-1, 3) + ksrc= max(ilaunch, 3) + + zngw(j) = zmet(j, ksrc) + + km2 = ksrc - 2 + km1 = ksrc - 1 + kp1 = ksrc + 1 + +!=====ksrc + + aum(km2:levs) = um(jl,km2:levs) + avm(km2:levs) = vm(jl,km2:levs) + atm(km2:levs) = tm(jl,km2:levs) + aqm(km2:levs) = qm(jl,km2:levs) + azmet(km2:levs) = zmet(jl,km2:levs) + aprsi(km2:levs+1) = prsi(jl,km2:levs+1) + azmeti(km2:levs+1) = zmeti(jl,km2:levs+1) + + + rho_src = aprsl(ksrc)*rdi/atm(ksrc) + taub_ch = max(tau_ngw(jl), tau_min) + taub_src = taub_ch + + + sigu2 = taub_src/rho_src/v_kxw * zms + sig_u2az(1:nazd) = sigu2 +! +! compute diffusion-based arrays km2:levs +! + do jk = km2, levs + dz_meti(jk) = azmeti(jk+1)-azmeti(jk) + dz_met(jk) = azmet(jk)-azmeti(jk-1) + enddo +! --------------------------------------------- +! interface mean flow parameters launch -> levs+1 +! --------------------------------------------- + do jk= km1,levs + tvc = atm(jk) * (1. +fv*aqm(jk)) + tvm = atm(jk-1) * (1. +fv*aqm(jk-1)) + ptc = tvc/ prslk(jl, jk) + ptm = tvm/prslk(jl,jk-1) +! + zthm = 2.0 / (tvc+tvm) + rhp_wam = zthm*gor +!interface + uint(jk) = 0.5 *(aum(jk-1)+aum(jk)) + vint(jk) = 0.5 *(avm(jk-1)+avm(jk)) + tint(jk) = 0.5 *(tvc+tvm) + rhomid(jk) = aprsl(jk)*rdi/atm(jk) + rhoint(jk) = aprsi(jk)*rdi*zthm ! rho = p/(RTv) + zdelp = dz_meti(jk) ! >0 ...... dz-meters + v_zmet(jk) = 2.*zdelp ! 2*kzi*[Z_int(k+1)-Z_int(k)] + zdelm = 1./dz_met(jk) ! 1/dz ...... 1/meters +! +! bvf2 = grav2 * zdelm * (ptc-ptm)/ (ptc + ptm) ! N2=[g/PT]*(dPT/dz) +! + bn2(jk) = grav2cpd*zthm * (1.0+rcpdl*(tvc-tvm)*zdelm) + bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) + bn(jk) = sqrt(bn2(jk)) + + + wrk3(jk)= 1./zdelp/rhomid(jk) ! 1/rho_mid(k)/[Z_int(k+1)-Z_int(k)] + irhodz_mid(jk) = rdtp*zdelp*rhomid(jk)/rho_src +! +! +! diagnostics -Kzz above PBL +! + uz = aum(jk) - aum(jk-1) + vz = avm(jk) - avm(jk-1) + shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm + + zmetk = azmet(jk)* rh4 ! mid-layer height k_int => k_int+1 + zgrow = exp(zmetk) + ritur = bn2(jk)/shr2 + kamp = sqrt(shr2)*sc2 *zgrow + w1 = 1./(1. + 5*ritur) + ktur= min(max(kamp * w1 * w1, dked_min), dked_max) + zmetk = azmet(jk)* rhp + vueff(jk) = ktur + kvg(jk) + + akt(jk) = gipr/tvc + enddo + + if (idebug_gwrms == 1) then + do jk= km1,levs + wrk1(jk) = rv_kxw/rhoint(jk) + wrk2(jk)= rgrav2*zthm*zthm*bn2(jk) ! dimension [K*K]*(c2/m2) + enddo + endif + +! +! extrapolating values for ktop = levs+1 (lev-interface for prsi(levs+1) =/= 0) +! + jk = levs + + rhoint(ktop) = 0.5*aprsi(levs)*rdi/atm(jk) + tint(ktop) = atm(jk)*(1. +fv*aqm(jk)) + uint(ktop) = aum(jk) + vint(ktop) = avm(jk) + + v_zmet(ktop) = v_zmet(jk) + vueff(ktop) = vueff(jk) + bn2(ktop) = bn2(jk) + bn(ktop) = bn(jk) +! +! akt_mid *KT = -g*(1/H + 1/T*dT/dz)*KT ... grav/tvc for eddy heat conductivity +! + do jk=km1, levs + akt(jk) = -akt(jk)*(gor + (tint(jk+1)-tint(jk))/dz_meti(jk) ) + enddo + + + bvi = bn(ksrc); bvi2 = bvi * bvi; + bvi3 = bvi2*bvi; bvi4 = bvi2 * bvi2; rcms = zms/bvi +! +! project winds at ksrc +! + do iaz=1, nazd + ul(iaz) = zcosang(iaz) *uint(ksrc) + zsinang(iaz) *vint(ksrc) + enddo +! + + do jk=ksrc, ktop + cstar(jk) = bn(jk)/zms + cstar2(jk) = cstar(jk)*cstar(jk) + + fden_lsat(jk) = rhoint(jk)/bn(jk)*v_kxw*Linsat2 + + do iaz=1, nazd + zu = zcosang(iaz)*uint(jk) + zsinang(iaz)*vint(jk) + ui(iaz, jk) = zu !- ul(iaz)*0. + enddo + enddo + + rstar = 1./cstar(ksrc) + rstar2 = rstar*rstar +! ----------------------------------------- +! set launch momentum flux spectral density +! ----------------------------------------- + + fpu(1:nazd, km2:ktop) =0. + + do inc=1,nwav + + zcin = zci(inc)*rstar + +! +! integrate (flux(cin) x dcin ) old tau-flux and normalization +! + flux(inc,1) = rstar*(zcin*zcin)/(1.+ zcin**nslope3) +! +! fsat = rstar*(zcin*zcin) * taub_src / SN * [rho/rho_src *N_src/N] +! + fpu(1,ksrc) = fpu(1,ksrc) + flux(inc,1)*zdci(inc) ! dc/cstar = dim-less + + do iaz=1,nazd + akzw(inc, iaz, ksrc) = bvi*rci(inc) + enddo + + enddo +! +! adjust rho/bn vertical factors for saturated fluxes (E(m) ~m^-3) + + flux_norm = taub_src / fpu(1, ksrc) ! [Pa * dc/cstar *dim_less] + ze1 = flux_norm * bvi/rhoint(ksrc) *rstar *rstar2 + do jk=ksrc, ktop + fden_bn(jk) = ze1* rhoint(jk) / bn(jk) ! [Pa]/[m/s] * rstar2 + enddo +! + do inc=1, nwav + flux(inc,1) = flux_norm*flux(inc,1) + enddo + + + if (ener_norm == 1) then + snorm_ener = 0. + do inc=1,nwav + zcin = zci(inc)*rstar + + ze2 = zcin /(1.+ zcin**nslope3) + + snorm_ener = snorm_ener + ze2*zdci(inc)*rstar !dim-less + flux(inc,1) = ze2 * zcin + enddo + + ekin_norm = 1./snorm_ener + +! taub_src = sigu2 * rho_src * [v_kxw / zms ] +! sigu2 = taub_src*zms/(rho_src/v_kxw) +! ze1 = sigu2*ks*dens/Ns = taub*zms/Ns + + ze1 = taub_src*zms/bvi * ekin_norm + taub_src = 0. + + do inc=1,nwav + flux(inc,1) = ze1* flux(inc,1) + taub_src = taub_src + flux(inc,1)*zdci(inc) + enddo + ze1 = ekin_norm * v_kxw * rstar2 + do jk=ksrc, ktop + fden_bnen(jk) = rhoint(jk) / bn(jk) *ze1 ! mult on => sigu2(z)*cdf2 => flux_sat + enddo + + endif +! + do iaz=1,nazd + fpu(iaz, ksrc) = taub_src + fpu(iaz, km1) = taub_src + enddo + +! copy flux-1 into other azimuths +! -------------------------------- + + + do iaz=2, nazd + do inc=1,nwav + flux(inc,iaz) = flux(inc,1) + enddo + enddo + +! if (mpi_id == master .and. ener_norm == 1) then +! print * +! print *, 'vay_norm: ', taub_src, taub_ch, sigu2, flux_norm, ekin_norm +! print * +! endif + + if (idebug_gwrms == 1) then + pwrms =0. + ptrms =0. + tx1 = real(nazd)/rhoint(ksrc)*rv_kxw + ze2 = wrk2(ksrc) ! (bvi*atm(ksrc)*rgrav)**2 + do inc=1, nwav + v_kzw = bvi*rci(inc) + ze1 = flux(inc,1)*zdci(inc)*tx1*v_kzw + pwrms = pwrms + ze1 + ptrms = ptrms + ze1 * ze2 + enddo + wrms(jl, ksrc) = pwrms + trms(jl, ksrc) = ptrms + endif + +! -------------------------------- + wave_act(:,:) = 1.0 +! vertical do-loop + do jk=ksrc, levs + + jkp = jk+1 +! azimuth do-loop + do iaz=1, nazd + + sig_u2az_m(iaz) = sig_u2az(iaz) + + umfp = ui(iaz, jkp) + umfm = ui(iaz, jk) + umfc = .5*(umfm + umfp) +! wave-cin loop + dfdz_v(iaz, jk) = 0.0 + dfdz_heat(iaz, jk) = 0.0 + fpu(iaz, jkp) = 0.0 + sig_u2az(iaz) =0.0 +! +! wave_dis(iaz, :) = vueff(jk) + do inc=1, nwav + flux_m(inc, iaz) = flux(inc, iaz) + + zcin = zci(inc) ! zcin =/0 by definition + zcinc = rci(inc) + + if(wave_act(inc,iaz) == 1.0) then +!======================================================================= +! discrete mode +! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat +! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) +!======================================================================= + + v_cdp = zcin - umfp + v_cdp2=v_cdp*v_cdp + cdf2 = v_cdp2 - c2f2 + if (v_cdp .le. ucrit_max .or. cdf2 .le. 0.0) then +! +! between layer [k-1,k or jk-jkp] (Chi - Uk) -> ucrit_max, wave's absorption +! + wave_act(inc,iaz) =0. + akzw(inc, iaz, jkp) = pi/dz_meti(jk) ! pi2/dzmet + fluxs = 0.0 !max(0., rhobnk(jkp)*ucrit3)*rdci(inc) + flux(inc,iaz) = fluxs + + else + + v_wdp = v_kxw*v_cdp + wdop2 = v_wdp* v_wdp + +! +! rotational cut-off +! + kzw2 = (bn2(jkp)-wdop2)/Cdf2 +! +!cires_ugwp_initialize.F90: real, parameter :: mkzmin = pi2/80.0e3 +! + if ( kzw2 > mkz2min ) then + v_kzw = sqrt(kzw2) + akzw(inc, iaz, jkp) = v_kzw +! +!linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 +! +!kzw2 = (bn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) +! Kds_sat = kxw*Cdf1*rhp2/kzw3 +!krad, kvg, kion, ktg + v_cdp = sqrt( cdf2 ) + v_wdp = v_kxw * v_cdp + v_wdi = kzw2*vueff(jk) + kion(jk) ! supRF-diss due for "all" vars + v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) + v_kzi = v_kzw*v_wdi/v_wdpc + +! + ze1 = v_kzi*v_zmet(jk) + + if (ze1 .ge. 1.e-2) then + expdis = max(exp(-ze1), 0.01) + else + expdis = 1./(1.+ ze1) + endif + +! + wave_act(inc,iaz) = 1.0 + fmode = flux(inc,iaz) + + flux_2_sig = v_kzw/v_kxw/rhoint(jkp) + w1 = v_wdpc/kzw2/v_kzw/v_zmet(jk) + else ! kzw2 <= mkz2min large "Lz"-reflection + + expdis = 1.0 + v_kzw = mkzmin + + v_cdp = 0. ! no effects of reflected waves + wave_act(inc,iaz) = 0.0 + akzw(inc, iaz, jkp) = v_kzw + fmode = 0. + w1 =0. + endif +! expdis =1.0 + + fdis = fmode*expdis*wave_act(inc,iaz) +!============================================================================== +! +! Saturated Fluxes and Energy: Spectral and Dicrete Modes +! +! S2003 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz))**2/zcin +! WM2001 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz)) +! saturated flux + wave dissipation - Keddy_gwsat in UGWP-V1 +! linsatdis = 1.0 , here: u'^2 ~ linsatdis* [v_cdp*v_cdp] +! +! old-sat fluxs= fden_bn(jkp)*cdf2*zcinc*wave_act(inc,iaz) +! fluxs= fden_bn(jkp)*cdf2*zcinc*wave_act(inc,iaz) +! new sat fluxs= fden_bn(jkp)*sqrt(cdf2)*wave_act(inc,iaz) +! +! fluxs= fden_bn(jkp)*sqrt(cdf2)*wave_act(inc,iaz) + +! +! +! old spectral sat-limit with "mapping to source-level" sp_tau(cd) = fden_bn(jkp)*sqrt(cdf2) +! new spectral sat-limit with "mapping to source-level" sp_tau(cd) = fden_bn(jkp)*cdf2*rstar2 +! [fden_bn(jkp)] = Pa/dc +! fsat = rstar*(zcin*zcin) * [taub_src / SN * [ rstar3*rho/rho_src *N_src/N] = fden_bn ] + + if (ener_norm == 0) fluxs= fden_bn(jkp)*cdf2*wave_act(inc,iaz) ! dim-n: Pa/[m/s] +! +! single mode saturation limit: [rho(z)/bn(z)*kx *linsat2* cd^3] /dc +! + if (ener_lsat == 1) fluxs= fden_Lsat(jkp)*cdf2*sqrt(cdf2)*rdci(inc)*wave_act(inc,iaz) + + if (ener_norm == 1) then + +! spectral saturation limit + + if (ener_lsat == 0) fluxs= fden_bnen(jk)*cdf2*wave_act(inc,iaz)*sig_u2az_m(iaz) + +! single mode saturation limit: [rho(z)/bn(z)*kx *linsat2* cd^3] /dc + + if (ener_lsat == 1) fluxs= fden_Lsat(jkp)*cdf2*sqrt(cdf2)*rdci(inc)*wave_act(inc,iaz) +! + endif +!---------------------------------------------------------------------------- +! dicrete mode saturation fden_sat(jkp) = rhoint(jkp)/bn(jkp)*v_kxw +! fluxs = fden_sat(jkp)*cdf2*sqrt(cdf2)/zdci(inc)*L2sat +! fluxs_src = fden_sat(ksrc)*cdf2*sqrt(cdf2)/zdci(inc)*L2sat +!---------------------------------------------------------------------------- + zdep = fdis-fluxs ! dimension [Pa/dc] *dc = Pa + if(zdep > 0.0 ) then +! subs on sat-limit + ze1 = flux(inc,iaz) + flux(inc,iaz) = fluxs + ze2 = log(ze1/fluxs)*w1 ! Kdsat-compute damping of mode =>df = f-fluxs + ! here we can add extra-dissip for the next layer + else +! assign dis-ve flux + flux(inc,iaz) = fdis + endif + + dtau = flux_m(inc,iaz)-flux(inc,iaz) + if (dtau .lt. 0) then + flux(inc,iaz) = flux_m(inc,iaz) + endif +! +! GW-sponge domain: saturate all "GW"-modes above "zsp_gw" +! + if ( azmeti(jkp) .ge. zsp_gw) then + mi_sponge = .5/dz_meti(jk) + ze2 = v_wdp /v_kzw * mi_sponge ! Ksat*v_kzw2 = [mi_sat*wdp/kzw] + v_wdi = ze2 + v_wdi*0.25 ! diss-sat GW-sponge + v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) + v_kzi = v_kzw*v_wdi/v_wdpc +! + ze1 = v_kzi*v_zmet(jk) + exp_sponge = exp(-ze1) +! +! additional sponge +! + flux(inc,iaz) = flux(inc,iaz) *exp_sponge + endif + + endif ! coriolis or CL condition-checkif => (v_cdp .le. ucrit_max) then + endif ! only for waves w/o CL-absorption wave_act=1 +! +! sum for given (jk, iaz) all active "wave" contributions +! + if (wave_act(inc,iaz) == 1) then + + zcinc =zdci(inc) + vc_zflx_mode = flux(inc,iaz) + vmdiff = max(0., flux_m(inc,iaz)-vc_zflx_mode) + if (vmdiff <= 0. ) vc_zflx_mode = flux_m(inc,iaz) + ze1 = vc_zflx_mode*zcinc + fpu(iaz, jkp) = fpu(iaz,jkp) + ze1 ! flux (pa) at + sig_u2az(iaz) = sig_u2az(iaz) + ze1*flux_2_sig ! ekin(m2/s2) at z+dz + +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! (heat deposition integration over spectral mode for each azimuth +! later sum over selected azimuths as "non-negative" scalars) +! cdf1 = sqrt( (zci(inc)-umfc)**2-c2f2) +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +! zdelp = wrk3(jk)*cdf1 *zcinc + + zdelp = wrk3(jk)* v_cdp *zcinc * vmdiff + + +! zcool = 1. ! COOL=(-3.5 + Pr)/Pr +! zcool = [Kv/Pr]*N2*(Pr-Cp/R)/cp +! edis = (c-u)*ax/cp = Kv_dis*N2/cp +! cool = -Kt*N2/R +! add heat-conduction "bulk" impact: 1/Pr*(g*g*rho)* d [rho*Kv(dT/dp- R/Cp *T/p)] +! + dfdz_v(iaz, jk) = dfdz_v(iaz,jk) + zdelp ! +cool !heating & simple cooling < 0 + dfdz_heat(iaz, jk) = dfdz_heat(iaz,jk) + zdelp ! heating -only > 0 + endif !wave_act(inc,iaz) == 1) +! + enddo ! wave-inc-loop + + ze1 =fpu(iaz, jk) + if (fpu(iaz, jkp) > ze1 ) fpu(iaz, jkp) = ze1 +! +! compute wind and temp-re rms +! + if (idebug_gwrms == 1) then + pwrms =0. + ptrms =0. + do inc=1, nwav + if (wave_act(inc,iaz) > 0.) then + v_kzw =akzw(inc, iaz, jk) + ze1 = flux(inc,iaz)*v_kzw*zdci(inc)*wrk1(jk) + pwrms = pwrms + ze1 + ptrms = ptrms + ze1*wrk2(jk) + endif + enddo + Awrms(iaz, jk) = pwrms + Atrms(iaz, jk) = ptrms + endif + +! -------------- + enddo ! end Azimuth do-loop + +! +! eddy wave dissipation to limit GW-rms +! + tx1 = sum(abs(dfdz_heat(1:nazd, jk)))/bn2(jk) + ze1=max(dked_min, tx1) + ze2=min(dked_max, ze1) + vueff(jkp) = ze2 + vueff(jkp) +! + enddo ! end Vertical do-loop +! +! top-layers constant interface-fluxes and zero-heat +! we allow non-zero momentum fluxes and thermal effects +! fpu(1:nazd,levs+1) = fpu(1:nazd, levs) +! dfdz_v(1:nazd, levs) = 0.0 + +! --------------------------------------------------------------------- +! sum contribution for total zonal and meridional fluxes + +! energy dissipation +! --------------------------------------------------- +! +!======================================================================== +! at the source level and below taux = 0 (taux_E=-taux_W by assumption) +!======================================================================== + + do jk=ksrc, levs + taux(jk) = 0.0 + tauy(jk) = 0.0 + do iaz=1,nazd + taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) + tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) + pdtdt(jl,jk) = pdtdt(jl,jk) + dfdz_v(iaz,jk) + dked(jl,jk) = dked(jl,jk) + dfdz_heat(iaz,jk) + enddo + enddo + jk = ktop; taux(jk)=0.; tauy(jk)=0. + do iaz=1,nazd + taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) + tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) + enddo + + if (idebug_gwrms == 1) then + do jk=kp1, levs + do iaz=1,nazd + wrms(jl,jk) =wrms(jl,jk) + Awrms(iaz,jk) + trms(jl,jk) =trms(jl,jk) + Atrms(iaz,jk) + tauabs(jl,jk)=tauabs(jl,jk) + fpu(iaz,jk) + enddo + enddo + endif +! + + do jk=ksrc+1,levs + jkp = jk + 1 + zdelp = wrk3(jk)*gw_eff + ze1 = (taux(jkp)-taux(jk))* zdelp + ze2 = (tauy(jkp)-tauy(jk))* zdelp + + if (abs(ze1) >= maxdudt ) then + ze1 = sign(maxdudt, ze1) + endif + if (abs(ze2) >= maxdudt ) then + ze2 = sign(maxdudt, ze2) + endif + + pdudt(jl,jk) = -ze1 + pdvdt(jl,jk) = -ze2 +! +! Cx =0 based Cx=/= 0. above +! +! + if (knob_ugwp_doheat == 1) then +! +!maxdtdt= dked_max * bnfix2 +! + pdtdt(jl,jk) = pdtdt(jl,jk)*gw_eff + ze2 = pdtdt(jl,jk) + if (abs(ze2) >= max_eps ) pdtdt(jl,jk) = sign(max_eps, ze2) + + dked(jl,jk) = dked(jl,jk)/bn2(jk) + ze1 = max(dked_min, dked(jl,jk)) + dked(jl,jk) = min(dked_max, ze1) + qmid(jk) = pdtdt(j,jk) + endif + enddo +!---------------------------------------------------------------------------------- +! Update heat = ek_diss/cp and aply 1-2-1 smoother for "dked" => dktur +! here with "u_new = u +dtp*dudt ; vnew = v + v +dtp*dvdt +! can check "stability" in the column and "add" ktur-estimation +! to suppress instability as needed so dked = dked_gw + ktur_ric +!---------------------------------------------------------------------------------- + + dktur(1:levs) = dked(jl,1:levs) +! + do ist= 1, nstdif + do jk=ksrc,levs-1 + adif(jk) =.25*(dktur(jk-1)+ dktur(jk+1)) + .5*dktur(jk) + enddo + dktur(ksrc:levs-1) = adif(ksrc:levs-1) + enddo + dktur(levs) = .5*( dked(jl,levs)+ dked(jl,levs-1)) + dktur(levs+1) = dktur(levs) + + do jk=ksrc,levs + ze1 = .5*( dktur(jk) +dktur(jk-1) ) + kvint(jk) = ze1 + ktint(jk) = ze1*iPr_ktgw + enddo + +! +! Thermal budget qmid = qheat + qcool +! + do jk=ksrc+1,levs + ze2 = qmid(jk) + dktur(jk)*Akt(jk) + grav*(ktint(jk+1)-ktint(jk))/dz_meti(jk) + qmid(jk) = ze2 + if (abs(ze2) >= max_eps ) qmid(jk) = sign(max_eps, ze2) + pdtdt(jl,jk) = qmid(jk)*rcpd + dked(jl, jk) = dktur(jk) + enddo +! +! perform explicit eddy "diffusive" 3-point smoothing of "u-v-t" +! from the surface/launch-gw to the "top" +! +! +! update by source function X(t+dt) = X(t) + dtp * dXdt +! + uold(km2:levs) = aum(km2:levs)+pdudt(jl,km2:levs)*dtp + vold(km2:levs) = avm(km2:levs)+pdvdt(jl,km2:levs)*dtp + told(km2:levs) = atm(km2:levs)+pdtdt(jl,km2:levs)*dtp +! +! diagnose turb-profile using "stability-check" relying on the free-atm diffusion +! sc2 = 30m x 30m +! + dktur(km2:levs) = dked_min + + do jk=km1,levs + uz = uold(jk) - uold(jk-1) + vz = vold(jk) - vold(jk-1) + ze1 = dz_met(jk) + zdelm = 1./ze1 + + tvc = told(jk) * (1. +fv*aqm(jk)) + tvm = told(jk-1) * (1. +fv*aqm(jk-1)) + zthm = 2.0 / (tvc+tvm) + shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm + + bn2(jk) = grav2cpd*zthm * (1.0+rcpdl*(tvc-tvm)*zdelm) + + bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) + zmetk = azmet(jk)* rh4 ! mid-layer height k_int => k_int+1 + zgrow = exp(zmetk) + ritur = bn2(jk)/shr2 + w1 = 1./(1. + 5*ritur) + ze2 = min( sc2 *zgrow, 4.*ze1*ze1) +! +! Smag-type of eddy diffusion K_smag = Sqrt(Deformation - N2/Pr)* L2 *const +! + kamp = sqrt(shr2)* ze2 * w1 * w1 + ktur= min(max(kamp, dked_min), dked_max) + dktur(jk) = ktur +! +! update of dked = dked_gw + k_turb_mf +! + dked(jl, jk) = dked(jl, jk) +ktur + + enddo + +! +! apply eddy effects due to GWs: explicit scheme Kzz*dt/dz2 < 0.5 stability +! + if (knob_ugwp_dokdis == 2) then + + do jk=km1,levs + ze1 = min(.5*(dktur(jk) +dktur(jk-1)), dturb_max) + kvint(jk) = kvint(jk) + ze1 +! ktint(jk) = ktint(jk) + ze1*iPr_ktgw + enddo + + kvint(ktop) = kvint(levs) + + dzmetm = 1./dz_met(km1) + Adif(km1:levs) = 0. + Cdif(km1:levs) = 0. + do jk=km1,levs-1 + + dzmetp = 1./dz_met(jk+1) + dzmetf = 1./(dz_meti(jk)*rhomid(jk)) + + + ktur = kvint(jk) *rhoint(jk) * dzmetf + kturp =Kvint(jk+1)*rhoint(jk+1) * dzmetf + + Adif(jk) = ktur * dzmetm + Cdif(jk) = kturp * dzmetp + ApC = adif(jk)+cdif(jk) + ACdif(jk) = ApC + + w1 = ApC*iPr_max + if (rdtp < w1 ) then + Anstab(jk) = floor(w1*dtp) + 1 + else + Anstab(jk) = 1 + endif + dzmetm = dzmetp + enddo + + nstab = maxval( Anstab(ksrc:levs-1)) + +! if (nstab .ge. 3) print *, 'nstab ', nstab +! +! k instead Jk +! + dtdif = dtp/real(nstab) + ze1 = 1./dtdif + + do ist= 1, nstab + do k=ksrc,levs-1 + Bdif = ze1 - ACdif(k) + Bt_dif = ze1 - ACdif(k)* iPr_ktgw ! ipr_Ktgw = 1./Pr <1 + unew(k) = uold(k)*Bdif + uold(k-1)*Adif(k) + uold(k+1)*Cdif(k) + vnew(k) = vold(k)*Bdif + vold(k-1)*Adif(k) + vold(k+1)*Cdif(k) + tnew(k) = told(k)*Bt_dif+(told(k-1)*Adif(k) + told(k+1)*Cdif(k))*iPr_ktgw + enddo + + uold(ksrc:levs-1) = unew(ksrc:levs-1)*dtdif ! value du/dtp *dtp = du + vold(ksrc:levs-1) = vnew(ksrc:levs-1)*dtdif + told(ksrc:levs-1) = tnew(ksrc:levs-1)*dtdif +! +! smoothing the boundary points: "k-1" = ksrc-1 and "k+1" = levs +! + uold(levs) = uold(levs-1) + vold(levs) = vold(levs-1) + told(levs) = told(levs-1) + enddo +! +! compute "smoothed" tendencies by molecular + GW-eddy diffusions +! + do k=ksrc,levs-1 +! +! final updates of tendencies and diffusion +! + ze2 = rdtp*(uold(k) - aum(k)) + ze1 = rdtp*(vold(k) - avm(k)) + pdtdt(jl,k)= rdtp*( told(k) - atm(k) ) + + if (abs(pdtdt(jl,k)) >= maxdtdt ) pdtdt(jl,k) = sign(maxdtdt,pdtdt(jl,k) ) + if (abs(ze1) >= maxdudt ) then + ze1 = sign(maxdudt, ze1) + endif + if (abs(ze2) >= maxdudt ) then + ze2 = sign(maxdudt, ze2) + endif + + pdudt(jl, k) = ze2 + pdvdt(jl, k) = ze1 + uz = uold(k+1) - uold(k-1) + vz = vold(k+1) - vold(k-1) + ze2 = 1./(dz_met(k+1)+dz_met(k) ) + mf_diss_heat = rcpd*kvint(k)*(uz*uz +vz*vz)*ze2*ze2 ! vert grad heat + pdtdt(jl,k)= pdtdt(jl,k) + mf_diss_heat ! extra heat due to eddy viscosity + + enddo + + + ENDIF ! dissipative IF-loop for vertical eddy difusion u-v-t + + enddo ! J-loop +! + RETURN + +!================================= + if (kdt ==1 .and. mpi_id == master) then +! + print *, ' ugwpv1: nazd-nw-ilaunch=', nazd, nwav,ilaunch, maxval(kvg), ' kvg ' + print *, 'ugwpv1: zdci(inc)=' , maxval(zdci), minval(zdci) + print *, 'ugwpv1: zcimax=' , maxval(zci) ,' zcimin=' , minval(zci) +! print *, 'ugwpv1: tau_ngw=' , maxval(taub_src)*1.e3, minval(taub_src)*1.e3, tau_min + + print * + + endif + + if (kdt == 1 .and. mpi_id == master) then + print *, 'vgw done nstab ', nstab +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax ugwp' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay ugwp' + print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec ugwp' + print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps ugwp' +! +! print *, ' ugwp -heating rates ' + endif +!================================= + return + end subroutine cires_ugwpv1_ngw_solv2 + + +end module cires_ugwpv1_solv2 diff --git a/physics/cires_ugwpv1_sporo.F90 b/physics/cires_ugwpv1_sporo.F90 new file mode 100644 index 000000000..98eca419e --- /dev/null +++ b/physics/cires_ugwpv1_sporo.F90 @@ -0,0 +1,353 @@ + + subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, & + dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, & + grav, omega, con_rd, del, sigma, hprime, gamma, theta, & + sinlat, xlatd, taup, taud, pkdis) +! + USE MACHINE , ONLY : kind_phys +! + implicit none + + integer, intent(in) :: im, levs + integer, intent(in) :: npt + integer, intent(in) :: kdt, me, master + integer, intent(in) :: kref(im), ipt(im) + + real(kind=kind_phys), intent(in) :: dtp, dxres + real(kind=kind_phys), intent(in) :: taub(im) + + real(kind=kind_phys), intent(in) :: sinlat(im), xlatd(im) + real(kind=kind_phys), intent(in), dimension(im) :: sigma, & + hprime, gamma, theta + + real(kind=kind_phys), intent(in), dimension(im) :: xn, yn + + real(kind=kind_phys), intent(in), dimension(im, levs) :: & + u1, v1, t1, bn2, rho, prsl, del + real(kind=kind_phys), intent(in) :: grav, omega, con_rd + + real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi +! +! out : taup, taud, pkdis +! + real(kind=kind_phys), intent(inout), dimension(im, levs+1) :: taup + real(kind=kind_phys), intent(inout), dimension(im, levs) :: taud + real(kind=kind_phys), intent(inout), dimension(im, levs) :: pkdis +! +! multiwave oro-spectra +! locals +! + + integer, parameter :: nworo = 30 + real(kind=kind_phys), parameter :: fc_flag = 0.0 + real(kind=kind_phys), parameter :: mkzmin = 6.28e-3/50.0 + real(kind=kind_phys), parameter :: mkz2min = mkzmin* mkzmin + real(kind=kind_phys), parameter :: kedmin = 1.e-3 + real(kind=kind_phys), parameter :: kedmax = 350.,axmax=250.e-5 + real(kind=kind_phys), parameter :: rtau = 0.01 ! nonlin-OGW scale 1/10sec + real(kind=kind_phys), parameter :: Linsat2 =0.5 + real(kind=kind_phys), parameter :: kxmin = 6.28e-3/100. + real(kind=kind_phys), parameter :: kxmax = 6.28e-3/5.0 + real(kind=kind_phys), parameter :: dkx = (kxmax -kxmin)/(nworo-1) + real(kind=kind_phys), parameter :: kx_slope= -5./3. + real(kind=kind_phys), parameter :: hps =7000., rhp2 = .5/hps + real(kind=kind_phys), parameter :: cxmin=0.5, cxmin2=cxmin*cxmin + + real(kind=kind_phys) :: akx(nworo), cxoro(nworo), akx2(nworo) + real(kind=kind_phys) :: aspkx(nworo), c2f2(nworo), cdf2(nworo) + real(kind=kind_phys) :: tau_sp(nworo,levs+1), wkdis(nworo, levs+1) + real(kind=kind_phys) :: tau_kx(nworo),taub_kx(nworo) + + real(kind=kind_phys), dimension(nworo, levs+1) :: wrms, akzw + + real(kind=kind_phys) :: tauz(levs+1), rms_wind(levs+1) + real(kind=kind_phys) :: wave_act(nworo,levs+1) + + real(kind=kind_phys) :: kxw, kzw, kzw2, kzw3, kzi, dzmet, rhoint + real(kind=kind_phys) :: rayf, kturb + real(kind=kind_phys) :: uz, bv, bv2,kxsp, fcor2, cf2 + + real(kind=kind_phys) :: fdis + real(kind=kind_phys) :: wfdm, wfdt, wfim, wfit + real(kind=kind_phys) :: betadis, betam, betat, kds, cx, rhofac + real(kind=kind_phys) :: etwk, etws, tauk, cx2sat + real(kind=kind_phys) :: cdf1, tau_norm +! +! mean flow +! + real(kind=kind_phys), dimension(levs+1) :: uzi,rhoi,ktur, kalp, dzi + real(kind=kind_phys) :: belps, aelps, nhills, selps + integer :: i, j, k, isp, iw + integer :: nw, nzi, ksrc + + + taud (:, :) = 0.0 ; pkdis(:,:) = 0.0 ; taup (:,:) = 0.0 + tau_sp (:,:) = 0.0 ; wrms(:,:) = 0.0 + nw = nworo + nzi = levs+1 + + do iw = 1, nw +! !kxw = 0.25/(dxres)*iw + kxw = kxmin+(iw-1)*dkx + akx(iw) = kxw + akx2(iw) = kxw*kxw + aspkx(iw) = kxw ** (kx_slope) + tau_kx(iw) = aspkx(iw)*dkx + enddo + + tau_norm = sum(tau_kx) + tau_kx(:) = tau_kx(:)/tau_norm + + if (kdt == 1) then + write(6,771) maxval(tau_kx)*maxval(taub)*1.e3, minval(tau_kx), maxval(tau_kx) + endif +771 format( ' oro_spectral_solver ', 3(2x,F8.3)) +! +! main loop over oro-points +! + do i =1, npt + j = ipt(i) + +! +! estimate "nhills" => stochastic choices for OGWs +! + if (taub(i) > 0.) then +! +! max_kxridge =min( .5*sigma(j)/hprime(j), kmax) +! ridge-dependent dkx = (max_kxridge -kxmin)/(nw-1) +! option to make grid-box variable kx-spectra kxw = kxmin+(iw-1)*dkx +! + wave_act(1:nw, 1:levs+1) = 1.0 + ksrc = kref(i) + tauz(1:ksrc) = taub(i) + taub_kx(1:nw) = tau_kx(1:nw) * taub(i) + wkdis(:,:) = kedmin + + call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), & + & prsi(j,:), prsL(j,:), grav, con_rd, & + & del(j,:), rho(i,:), & + & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, & + & xn(i), yn(i)) + + fcor2 = (2*omega*sinlat(j))*(2*omega*sinlat(j))*fc_flag + + k = ksrc + + bv2 = bn2(i,k) + uz = uzi(k) !u1(j,ksrc)*xn(i)+v1(j,ksrc)*yn(i)! + kturb = ktur(k) + rayf = kalp(k) + rhoint = rhoi(k) + dzmet = dzi(k) + kzw = max(sqrt(bv2)/max(cxmin, uz), mkzmin) +! +! specify oro-kx spectra and related variables k=ksrc +! + do iw = 1, nw + kxw = akx(iw) + cxoro(iw) = 0.0 - uz + c2f2(iw) = fcor2/akx2(iw) + wrms(iw,k)= taub_kx(iw)/rhoint*kzw/kxw + tau_sp(iw, k) = taub_kx(iw) +! +! + if (cxoro(iw) > cxmin) then + wave_act(iw,k:levs+1) = 0. ! crit-level + else + cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) + if ( cdf2(iw) < cxmin2) then + wave_act(iw,k:levs+1) = 0. ! coriolis cut-off + else + kzw2 = max(Bv2/Cdf2(iw) - akx2(iw), mkz2min) + kzw = sqrt(kzw2) + akzw(iw,k)= kzw + wrms(iw,k)= taub_kx(iw)/rhoint * kzw/kxw + endif + endif + enddo ! nw-spectral loop +! +! defined abobe, k = ksrc: akx(nworo), cxoro(nworo), tau_sp(ksrc, nworo) +! propagate upward multiwave-spectra are filtered by dissipation & instability +! +! tau_sp(:,ksrc+1:levs+1) = tau_sp(:, ksrc) + do k= ksrc+1, levs + uz = uzi(k) + bv2 =bn2(i,k) + bv = sqrt(bv2) + rayf = kalp(k) + rhoint= rhoi(k) + dzmet = dzi(k) + rhofac = rhoi(k-1)/rhoi(k) + + do iw = 1, nworo +! + if (wave_act(iw, k-1) <= 0.0) cycle + cxoro(iw)= 0.0 - uz + if ( cxoro(iw) > cxmin) then + wave_act(iw,k:levs+1) = 0.0 ! crit-level + else + cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) + if ( cdf2(iw) < cxmin2) wave_act(iw,k:levs+1) = 0.0 + endif + if ( wave_act(iw,k) <= 0.0) cycle +! +! upward propagation +! + kzw2 = Bv2/Cdf2(iw) - akx2(iw) + + if (kzw2 < mkz2min) then + wave_act(iw,k:levs+1) = 0.0 + else +! +! upward propagation w/o reflection +! + kxw = akx(iw) + kzw = sqrt(kzw2) + akzw(iw,k) = kzw + kzw3 = kzw2*kzw + + cx = cxoro(iw) + betadis = cdf2(iw) / (Cx*Cx+c2f2(iw)) + betaM = 1.0 / (1.0+betadis) + betaT = 1.0 - BetaM + kds = wkdis(iw,k-1) + + etws = wrms(iw,k-1)*rhofac * kzw/akzw(iw,k-1) + + kturb = ktur(k)+pkdis(j,k-1) + wfiM = kturb*kzw2 +rayf + wfiT = wfiM ! do updates with Pr-numbers Kv/Kt + cdf1 = sqrt(Cdf2(iw)) + wfdM = wfiM/(kxw*Cdf1)*BetaM + wfdT = wfiT/(kxw*Cdf1)*BetaT + kzi = 2.*kzw*(wfdM+wfdT)*dzmet + Fdis = exp(-kzi) + + etwk = etws*Fdis + Cx2sat = Linsat2*Cdf2(iw) + + if (etwk > cx2sat) then + Kds = kxw*Cdf1*rhp2/kzw3 + etwk = cx2sat + wfiM = kds*kzw2 + wfdM = wfiM/(kxw*Cdf1) + kzi = 2.*kzw*(wfdm + wfdm)*dzmet + etwk = cx2sat*exp(-kzi) + endif +! if( lat(j) eq 40.5 ) then stop + wkdis(iw,k) = kds + wrms(iw,k) = etwk + tauk = etwk*kxw/kzw + tau_sp(iw,k) = tauk *rhoint + if ( tau_sp(iw,k) > tau_sp(iw,k-1)) & + tau_sp(iw,k) = tau_sp(iw,k-1) + + ENDIF ! upward + ENDDO ! spectral + +!......... do spectral sum of rms, wkdis, tau + + tauz(k) = sum( tau_sp(:,k)*wave_act(:,k) ) + rms_wind(k) = sum( wrms(:,k)*wave_act(:,k) ) + + pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k))+rms_wind(k)*rtau + + if (pkdis(j,k) > kedmax) pkdis(j,k) = kedmax + + ENDDO ! k=ksrc+1, levs + + k = ksrc + tauz(k) = sum(tau_sp(:,k)*wave_act(:,k)) + tauz(k) = tauz(k+1) ! zero momentum dep-n at k=ksrc + + pkdis(j,k) = sum(wkdis(:,k)*wave_act(:,k)) + rms_wind(k) = sum(wrms(:,k)*wave_act(:,k)) + tauz(levs+1) = tauz(levs) + taup(i, 1:levs+1) = tauz(1:levs+1) + + do k=ksrc, levs + taud(i,k) = ( tauz(k+1) - tauz(k))*grav/del(j,k) +! +! limiters can be applied to avoid "large" wave accelerations +! +! if (taud(i,k) .gt. 0)taud(i,k)=taud(i,k)*.01 +! if (abs(taud(i,k)).ge.axmax)taud(i,k)=sign(taud(i,k),axmax) + enddo + endif ! taub > 0 + enddo ! oro-points (i, j, ipt) +! + end subroutine oro_spectral_solver +!------------------------------------------------------------- +! +! define mean flow and dissipation for OGW-kx spectrum +! +!------------------------------------------------------------- + subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & + & grav, con_rd, & + & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) + use machine , only : kind_phys + use ugwp_common , only : velmin, dw2min + implicit none + + integer :: nz, nzi + real(kind=kind_phys), dimension(nz ) :: u1, v1, t1, delp, rho, pmid + real(kind=kind_phys), dimension(nz ) :: bn2 ! define at the interfaces + real(kind=kind_phys), dimension(nz+1) :: pint + real(kind=kind_phys) :: xn, yn + real(kind=kind_phys),intent(in) :: grav, con_rd +! output + + real(kind=kind_phys), dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp + +! locals + integer :: i, j, k + real(kind=kind_phys) :: ui, vi, ti, uz, vz, shr2, rdz, kamp + real(kind=kind_phys) :: zgrow, zmet, rdpm, ritur, kmol, w1 + real(kind=kind_phys) :: rgrav, rdi +! paremeters + real(kind=kind_phys), parameter :: hps = 7000., rpspa = 1.e-5 + real(kind=kind_phys), parameter :: rhps=1.0/hps + real(kind=kind_phys), parameter :: h4= 0.25/hps + real(kind=kind_phys), parameter :: rimin = 1.0/8.0, kedmin = 0.01 + real(kind=kind_phys), parameter :: lturb = 30. , uturb = 150.0 + real(kind=kind_phys), parameter :: lsc2 = lturb*lturb,usc2 = uturb*uturb + kalp(1:nzi) = 2.e-7 ! radiative damping + + rgrav = 1.0/grav + rdi = 1.0/con_rd + + do k=2, nz + rdpm = grav/(pmid(k-1)-pmid(k)) + ui = .5*(u1(k-1)+u1(k)) + vi = .5*(v1(k-1)+v1(k)) + uzi(k) = Ui*xn + Vi*yn + ti = .5*(t1(k-1)+t1(k)) + rhoi(k) = rdi*pint(k)/ti + rdz = rdpm *rhoi(k) + dzi(k) = 1./rdz + uz = u1(k)-u1(k-1) + vz = v1(k)-v1(k-1) + shr2 = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) + zmet = -hps*alog(pint(k)*rpspa) + zgrow = exp(zmet*h4) + kmol = 2.e-5*exp(zmet*rhps)+kedmin + ritur = max(bn2(k)/shr2, rimin) + kamp = sqrt(shr2)*lsc2 *zgrow + w1 = 1./(1. + 5*ritur) + ktur(k) = kamp * w1 * w1 +kmol + enddo + + k = 1 + uzi(k) = uzi(k+1) + ktur(k) = ktur(k+1) + rhoi(k) = rdi*pint(k)/t1(k+1) + dzi(k) = rgrav*delp(k)/rhoi(k) + + k = nzi + uzi(k) = uzi(k-1) + ktur(k) = ktur(k-1) + rhoi(k) = rhoi(k-1)*.5 + dzi(k) = dzi(k-1) + + end subroutine oro_meanflow + diff --git a/physics/cires_ugwpv1_triggers.F90 b/physics/cires_ugwpv1_triggers.F90 new file mode 100644 index 000000000..db95a4f87 --- /dev/null +++ b/physics/cires_ugwpv1_triggers.F90 @@ -0,0 +1,446 @@ +module cires_ugwpv1_triggers + + use machine, only: kind_phys + +contains + + +! +! +! +!>\ingroup cires_ugwp_run +!> @{ +!! +!! + subroutine slat_geos5_tamp_v0(im, tau_amp, xlatdeg, tau_gw) +!================= +! V0: GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* +!================= + implicit none + integer :: im + real(kind=kind_phys) :: tau_amp, xlatdeg(im), tau_gw(im) + real(kind=kind_phys) :: latdeg, flat_gw, tem + integer :: i + +! +! if-lat +! + do i=1, im + latdeg = abs(xlatdeg(i)) + if (latdeg < 15.3) then + tem = (latdeg-3.0) / 8.0 + flat_gw = 0.75 * exp(-tem * tem) + if (flat_gw < 1.2 .and. latdeg <= 3.0) flat_gw = 0.75 + elseif (latdeg < 31.0 .and. latdeg >= 15.3) then + flat_gw = 0.10 + elseif (latdeg < 60.0 .and. latdeg >= 31.0) then + tem = (latdeg-60.0) / 23.0 + flat_gw = 0.50 * exp(- tem * tem) + elseif (latdeg >= 60.0) then + tem = (latdeg-60.0) / 70.0 + flat_gw = 0.50 * exp(- tem * tem) + endif + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5_tamp_v0 +! + + +! + subroutine slat_geos5_tamp_v1(im, tau_amp, xlatdeg, tau_gw) +!================= +! V1: GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* +!================= + implicit none + integer :: im + real(kind=kind_phys) :: tau_amp, xlatdeg(im), tau_gw(im) + real(kind=kind_phys) :: latdeg, flat_gw, tem + integer :: i + +! +! if-lat +! + do i=1, im + latdeg = abs(xlatdeg(i)) + if (latdeg < 15.3) then + tem = (latdeg-3.0) / 8.0 + flat_gw = 0.75 * exp(-tem * tem) + if (flat_gw < 1.2 .and. latdeg <= 3.0) flat_gw = 0.75 + elseif (latdeg < 31.0 .and. latdeg >= 15.3) then + flat_gw = 0.10 + elseif (latdeg < 60.0 .and. latdeg >= 31.0) then + tem = (latdeg-60.0) / 23.0 + flat_gw = 0.50 * exp(- tem * tem) + elseif (latdeg >= 60.0) then + tem = (latdeg-60.0) / 70.0 + flat_gw = 0.50 * exp(- tem * tem) + endif + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5_tamp_v1 +! + subroutine slat_geos5_2020(im, tau_amp, xlatdeg, tau_gw) +!================================================================= +! modified for FV3GFS-127L/C96 QBO-experiments +! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) +!================================================================ + implicit none + integer :: im + real(kind=kind_phys) :: tau_amp, xlatdeg(im), tau_gw(im) + real(kind=kind_phys) :: latdeg, flat_gw, tem + real(kind=kind_phys), parameter :: fampqbo = 1.25 ! 1.5 + real(kind=kind_phys), parameter :: famp60S = 1.0 ! 1.5 + real(kind=kind_phys), parameter :: famp60N = 1.0 ! 1.0 + real(kind=kind_phys), parameter :: famp30 = 0.25 ! 0.4 + + real(kind=kind_phys), parameter :: swid15 = 12.5 + real(kind=kind_phys), parameter :: swid60S = 30.0 ! 40 + real(kind=kind_phys), parameter :: swid60N = 25.0 ! 30 + integer :: i +! +! +! + do i=1, im + + latdeg = abs(xlatdeg(i)) + if (latdeg < 15.3) then + tem = (latdeg-3.0) / swid15 + flat_gw = fampqbo * exp(-tem * tem) + if (latdeg <= 3.0) flat_gw = fampqbo + elseif (latdeg < 31.0 .and. latdeg >= 15.3) then + flat_gw = famp30 + elseif (latdeg < 60.0 .and. latdeg >= 31.0) then + tem = (latdeg-60.0) / 23.0 + flat_gw = famp60N* exp(- tem * tem) + elseif (latdeg >= 60.0) then + tem = (latdeg-60.0) /swid60N + flat_gw = famp60N * exp(- tem * tem) + endif + + if (xlatdeg(i) <= -31.0) then +! + if (latdeg < 60.0 .and. latdeg >= 31.0) then + tem = (latdeg-60.0) / 23.0 + flat_gw = famp60S * exp(- tem * tem) + endif + if (latdeg >= 60.0) then + tem = (latdeg-60.0) /swid60S + flat_gw = famp60S * exp(- tem * tem) + endif + + endif + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5_2020 + + + subroutine slat_geos5(im, xlatdeg, tau_gw) + +!================= +! +! WAM: GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* +! +!================= + implicit none + integer :: im + real(kind=kind_phys) :: xlatdeg(im) + real(kind=kind_phys) :: tau_gw(im) + real(kind=kind_phys) :: latdeg + real(kind=kind_phys), parameter :: tau_amp = 3.5e-3 ! 3.5 mPa + real(kind=kind_phys) :: trop_gw, flat_gw + integer :: i +! +! if-lat +! + trop_gw = 0.75 + do i=1, im + latdeg = xlatdeg(i) + if (-15.3 < latdeg .and. latdeg < 15.3) then + flat_gw = trop_gw*exp(-( (abs(latdeg)-3.)/8.0)**2) + if (flat_gw < 1.2 .and. abs(latdeg) <= 3.) flat_gw = trop_gw + else if (latdeg > -31. .and. latdeg <= -15.3) then + flat_gw = 0.10 + else if (latdeg < 31. .and. latdeg >= 15.3) then + flat_gw = 0.10 + else if (latdeg > -60. .and. latdeg <= -31.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) + else if (latdeg < 60. .and. latdeg >= 31.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) + else if (latdeg <= -60.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) + else if (latdeg >= 60.) then + flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) + end if + tau_gw(i) = tau_amp*flat_gw + enddo +! + end subroutine slat_geos5 + + subroutine init_nazdir(con_pi, naz, xaz, yaz) + implicit none + real(kind=kind_phys) :: con_pi + integer :: naz + real(kind=kind_phys), dimension(naz) :: xaz, yaz + integer :: idir + real(kind=kind_phys) :: phic, drad + real(kind=kind_phys) :: pi2 + pi2 = 2.0*con_pi + drad = pi2/float(naz) + if (naz.ne.4) then + do idir =1, naz + Phic = drad*(float(idir)-1.0) + xaz(idir) = cos(Phic) + yaz(idir) = sin(Phic) + enddo + else +! if (naz.eq.4) then + xaz(1) = 1.0 !E + yaz(1) = 0.0 + xaz(2) = 0.0 + yaz(2) = 1.0 !N + xaz(3) =-1.0 !W + yaz(3) = 0.0 + xaz(4) = 0.0 + yaz(4) =-1.0 !S + endif + end subroutine init_nazdir +!========================================================================= +! Below subroutine that can be activated after "testing" and extra-work" +!========================================================================= + subroutine emc_modulation(im , levs, ntke, tau_ngw, cdmb3, cdmb4, dtp, & + q_tke, dqdt_tke, del, rain) + + integer, intent(in) :: im , levs, ntke + real(kind=kind_phys), intent(in) :: cdmb3, cdmb4, dtp + real(kind=kind_phys), intent(in) :: rain(im) + real(kind=kind_phys), intent(inout) :: tau_ngw(im) + real(kind=kind_phys), intent(in), dimension(im,levs) :: q_tke, dqdt_tke, del + +! locals + + + real(kind=kind_phys) :: turb_fac, tem + real(kind=kind_phys) :: rfac, tx1, tke + + +!============ +! +! below the "EMC-proposal" in May 2019 without rigorous tests reported elsewhere +! can be eliminated due to "lack" of validations and +! in GFSv16 cdmbgwd(3) =1.0 and the next if-loop is "cosmetic" proposal +! +!============ + if (1.0-cdmb3 > 1.0e-6) then + rfac = 86400000. / dtp !??? +! +! in operations cdmbgwd(3) = 1 in GFSv16, and code below is not executed +! + if (cdmb4 > 0.0) then + do i=1,im + turb_fac = 0.0 + if (ntke > 0) then + tem = 0.0 + do k=1,(levs+levs)/3 ! ???? + tke = q_tke(i,k) + dqdt_tke(i,k) * dtp + turb_fac = turb_fac + del(i,k) * tke + tem = tem + del(i,k) + enddo + turb_fac = turb_fac / tem + endif + tx1 = cdmb4*min(10.0, max(turb_fac,rain(i)*rfac)) + tau_ngw(i) = tau_ngw(i) * max(0.1, min(5.0, tx1)) * cdmb3 !???? + enddo + endif + endif + end subroutine emc_modulation + + +!=============================================== +! +! Spontaneous GW triggers by dynamical inbalances (OKW, fronts/jets, and convection) +! not activated due to "limited" set of GFS-physics +! statein-type ( needs horizontal gradients of winds and temperature, humodity) +! +!=============================================== + subroutine get_spectra_tau_convgw & + (nw, im, levs, dcheat, scheat, precip, icld, xlatd, sinlat, coslat,taub, klev, if_src, nf_src) +! +! temporarily can put GEOS-5/MERRA-2 GW-lat dependent function +! + integer :: nw, im, levs + integer,dimension(im,3) :: icld + real(kind=kind_phys), dimension(im, levs) :: dcheat, scheat + real(kind=kind_phys), dimension(im) :: precip, xlatd, sinlat, coslat + real(kind=kind_phys), dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! +! locals + real(kind=kind_phys), parameter :: precip_max = 100. ! mm/day + real(kind=kind_phys), parameter :: tau_amp = 3.5e-3 ! 3.5 mPa + + integer :: i, k, klow, ktop, kmid + real(kind=kind_phys) :: dtot, dmax, daver +! + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + do i=1, im + klow = icld(i,1) + ktop = icld(i,2) + kmid= icld(i,3) + if (klow == -99 .and. ktop == -99) then + cycle + else + klev(i) = ktop + k = klow + klev(i) = k + dmax = abs(dcheat(i,k) + scheat(i,k)) + do k=klow+1, ktop + dtot =abs(dcheat(i,k) + scheat(i,k)) + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo +! +! klev as max( dcheat(i,k) + scheat) +! vertical width of conv-heating +! +! counts/triiger=1 & taub(i) +! + nf_src = nf_src +1 + if_src(i) = 1 + taub(i) = tau_amp* precip(i)/precip_max*coslat(i) + endif + + enddo +! +! +! + call Slat_geos5(im, xlatd, taub) + nf_src =im + do i=1, im + if_src(i) = 1 + klev(i) = 127-45 + enddo + +! with info on precip/clouds/dc_heat create Bulk +! taub(im), klev(im) +! +! print *, ' get_spectra_tau_convgw ' + end subroutine get_spectra_tau_convgw +! + subroutine get_spectra_tau_nstgw(nw, im, levs, trig_fgf, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) + integer :: nw, im, levs + real(kind=kind_phys), dimension(im, levs) :: trig_fgf +! real(kind=kind_phys), dimension(im, levs+1) :: pint + real(kind=kind_phys), dimension(im) :: xlatd, sinlat, coslat + real(kind=kind_phys), dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! locals + real(kind=kind_phys), parameter :: tlim_fgf = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent + real(kind=kind_phys), parameter :: tau_amp = 3.5e-3 ! 3.5 mPa + real(kind=kind_phys), parameter :: pmax = 750.e2, pmin = 100.e2 + integer, parameter :: klow =127-92, ktop=127-45 + integer, parameter :: kwidth = ktop-klow+1 + integer :: i, k, kex + real(kind=kind_phys) :: dtot, dmax, daver + real(kind=kind_phys) :: fnorm, tau_min + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + fnorm = 1.0 / float(kwidth) + tau_min = tau_amp*fnorm + do i=1, im +! +! only trop-c fjets so find max(trig_fgf) => klev +! use abs-values to scale tau_amp +! + + k = klow + klev(i) = k + dmax = abs(trig_fgf(i,k)) + kex = 0 + if (dmax >= tlim_fgf) kex = kex+1 + do k=klow+1, ktop + dtot = abs(trig_fgf(i,k)) + if (dtot >= tlim_fgf) kex = kex+1 + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo + + if (dmax .ge. tlim_fgf) then + nf_src = nf_src +1 + if_src(i) = 1 + taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) + endif + + enddo +! +! print *, ' get_spectra_tau_nstgw ' + call Slat_geos5(im, xlatd, taub) + nf_src =im + do i=1, im + if_src(i) = 1 + klev(i) = 127-45 ! FV3-127L + enddo +! + end subroutine get_spectra_tau_nstgw +! + subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) + integer :: nw, im, levs + real(kind=kind_phys), dimension(im, levs) :: trig_okw +! real(kind=kind_phys), dimension(im, levs+1) :: pint + real(kind=kind_phys), dimension(im) :: xlatd, sinlat, coslat + real(kind=kind_phys), dimension(im) :: taub + integer, dimension(im) :: klev, if_src + integer :: nf_src +! locals + real(kind=kind_phys), parameter :: tlim_okw = 100. ! trig_fgf > tlim_fgf, launch GWs should scale-dependent + real(kind=kind_phys), parameter :: tau_amp = 35.e-3 ! 35 mPa + real(kind=kind_phys), parameter :: pmax = 750.e2, pmin = 100.e2 + integer, parameter :: klow =127-92, ktop=127-45 ! for FV3-127L + integer, parameter :: kwidth = ktop-klow+1 + integer :: i, k, kex + real(kind=kind_phys) :: dtot, dmax, daver + real(kind=kind_phys) :: fnorm, tau_min + + nf_src = 0 + if_src(1:im) = 0 + taub(1:im) = 0.0 + fnorm = 1./float(kwidth) + tau_min = tau_amp*fnorm + print *, ' get_spectra_tau_okwgw ' + do i=1, im + k = klow + klev(i) = k + dmax = abs(trig_okw(i,k)) + kex = 0 + if (dmax >= tlim_okw) kex = kex+1 + do k=klow+1, ktop + dtot = abs(trig_okw(i,k)) + if (dtot >= tlim_fgf ) kex = kex+1 + if ( dtot > dmax) then + klev(i) = k + dmax = dtot + endif + enddo +! + if (dmax >= tlim_okw) then + nf_src = nf_src + 1 + if_src(i) = 1 + taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) + endif + + enddo + print *, ' get_spectra_tau_okwgw ' + end subroutine get_spectra_tau_okw + +end module cires_ugwpv1_triggers diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 new file mode 100644 index 000000000..252838ca1 --- /dev/null +++ b/physics/ugwpv1_gsldrag.F90 @@ -0,0 +1,671 @@ +!> \file ugwpv1_gsldrag.F90 +!! This file combines three gravity wave drag schemes under one ("ugwpv1_gsldrag") suite: +!! 1) The "V0 CIRES UGWP" scheme (cires_ugwp.F90) as implemented in the FV3GFSv16 atmosphere model, which includes: +!! a) the "traditional" EMC orograhic gravity wave drag and flow blocking scheme of gwdps.f +!! b) the v0 cires ugwp non-stationary GWD scheme +!! 2) The GSL orographic drag suite (drag_suite.F90), as implmeneted in the RAP/HRRR, which includes: +!! a) large-scale gravity wave drag and low-level flow blocking -- active at horizontal scales +!! down to ~5km (Kim and Arakawa, 1995 \cite kim_and_arakawa_1995; Kim and Doyle, 2005 \cite kim_and_doyle_2005) +!! b) small-scale gravity wave drag scheme -- active typically in stable PBL at horizontal grid resolutions down to ~1km +!! (Steeneveld et al, 2008 \cite steeneveld_et_al_2008; Tsiringakis et al, 2017 \cite tsiringakis_et_al_2017) +!! c) turbulent orographic form drag -- active at horizontal grid ersolutions down to ~1km +!! (Beljaars et al, 2004 \cite beljaars_et_al_2004) +!! 3) The "V1 CIRES UGWP" scheme developed by Valery Yudin (University of Colorado, CIRES) +!! See Valery Yudin's presentation at 2017 NGGPS PI meeting: +!! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers +!! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics +!! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. +!! Unified Formalism: +!! 1. GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets). +!! 2. GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources. +!! 3. GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing). +!! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf +!! +!! The ugwpv1_gsldrag scheme is activated by gwd_opt = 2 in the namelist. +!! The choice of schemes is activated at runtime by the following namelist options (boolean): +!! NA do_ugwp_v0 -- activates V0 CIRES UGWP scheme - both orographic and non-stationary GWD is not active (NA) +!! NA do_ugwp_v0_orog_only -- activates V0 CIRES UGWP scheme - orographic GWD only +!! do_gsl_drag_ls_bl -- activates RAP/HRRR (GSL) large-scale OGWD and blocking +!! do_gsl_drag_ss -- activates RAP/HRRR (GSL) small-scale OGWD +!! do_gsl_drag_tofd -- activates RAP/HRRR (GSL) turbulent orographic drag +!! do_ugwp_v1 -- activates V1 CIRES UGWP scheme - both orographic and non-stationary GWD +!! do_ugwp_v1_orog_only -- activates V1 CIRES UGWP scheme - orographic GWD only +!! do_ugwp_v1_w_gsldrag -- activates V1 CIRES UGWP scheme with orographic drag of GSL +!! Note that only one "large-scale" scheme can be activated at a time. +!! + +module ugwpv1_gsldrag + + use machine, only: kind_phys + use cires_ugwpv1_triggers, only: slat_geos5_2020, slat_geos5_tamp_v1 + use cires_ugwpv1_module, only: cires_ugwpv1_init, ngwflux_update, calendar_ugwp + use cires_ugwpv1_module, only: knob_ugwp_version, cires_ugwp_dealloc, tamp_mpa + use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2 + use cires_ugwpv1_oro, only: orogw_v1 +! use cires_ugwp1_sporo, only: oro_spectral_solver + + use drag_suite, only: drag_suite_run + +! use cires_ugwpv1_triggers, only: get_spectra_tau_convgw, get_spectra_tau_okw, get_spectra_tau_nstgw +! use cires_ugwp_orolm97_v1, only: gwdps_oro_v1 +! use cires_ugwp_triggers_v1, only: slat_geos5_tamp_v1 +! use cires_ugwp_solv2_v1_mod, only: cires_ugwp_solv2_v1 +! use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize +! use cires_ugwp_module_v1, only: cires_ugwp_init_v1, cires_ugwp_finalize, calendar_ugwp +! use gwdps, only: gwdps_run + + implicit none + + private + + public ugwpv1_gsldrag_init, ugwpv1_gsldrag_run, ugwpv1_gsldrag_finalize + + logical :: is_initialized = .False. + +contains + +! ------------------------------------------------------------------------ +! CCPP entry points for CIRES Unified Gravity Wave Physics (UGWP) scheme v0 +! ------------------------------------------------------------------------ +!>@brief The subroutine initializes the unified UGWP +!> \section arg_table_ugwpv1_gsldrag_init Argument Table +!! \htmlinclude ugwpv1_gsldrag_init.html +!! +! ----------------------------------------------------------------------- +! + subroutine ugwpv1_gsldrag_init ( & + me, master, nlunit, input_nml_file, logunit, & + fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, & + con_pi, con_rerth, con_p0, & + do_ugwp,do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & + do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & + do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, errmsg, errflg) + +!---- initialization of unified_ugwp + implicit none + + integer, intent (in) :: me + integer, intent (in) :: master + integer, intent (in) :: nlunit + character(len=*), intent (in) :: input_nml_file(:) + integer, intent (in) :: logunit + integer, intent(in) :: jdat(8) + integer, intent (in) :: lonr + integer, intent (in) :: levs + integer, intent (in) :: latr + real(kind=kind_phys), intent (in) :: ak(levs+1), bk(levs+1) + real(kind=kind_phys), intent (in) :: dtp + + real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth + logical, intent (in) :: do_ugwp + + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, & + do_gsl_drag_tofd, do_ugwp_v1, & + do_ugwp_v1_orog_only,do_ugwp_v1_w_gsldrag + + character(len=*), intent (in) :: fn_nml2 + !character(len=*), parameter :: fn_nml='input.nml' + + integer :: ios + logical :: exists + real :: dxsg + integer :: k + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!============================================= +! 3 cases for ORO-schemes + NGWs: +! gwd_opt => "1 and 2, 3, 22, 33' +! 1) gsldrag: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1 +! 2) CIRES-v1: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp +!============================================= + ! Test to make sure that at most only one large-scale/blocking + ! orographic drag scheme is chosen + if ( (do_ugwp_v0.and.(do_ugwp_v0_orog_only.or.do_gsl_drag_ls_bl.or. & + do_ugwp_v1.or.do_ugwp_v1_orog_only)) .or. & + (do_ugwp_v0_orog_only.and.(do_gsl_drag_ls_bl.or.do_ugwp_v1.or. & + do_ugwp_v1_orog_only)) .or. & + (do_gsl_drag_ls_bl.and.do_ugwp_v1_orog_only) ) then + + write(errmsg,'(*(a))') "Logic error: Only one large-scale& + &/blocking scheme (do_ugwp_v0,do_ugwp_v0_orog_only,& + &do_gsl_drag_ls_bl,do_ugwp_v1 or & + &do_ugwp_v1_orog_only) can be chosen" + errflg = 1 + return + + end if + + if ( do_ugwp_v0_orog_only .or. do_ugwp_v0) then + print *, ' ccpp do_ugwp_v0 active ', do_ugwp_v0 + print *, ' ccpp do_ugwp_v1_orog_only active ', do_ugwp_v0_orog_only + write(errmsg,'(*(a))') " the CIRES CCPP-suite does not & + support schemes " + errflg = 1 + return + endif + if (do_ugwp_v1_w_gsldrag .and. do_ugwp_v1_orog_only ) then + + print *, ' do_ugwp_v1_w_gsldrag ', do_ugwp_v1_w_gsldrag + print *, ' do_ugwp_v1_orog_only ', do_ugwp_v1_orog_only + print *, ' do_gsl_drag_ls_bl ',do_gsl_drag_ls_bl + write(errmsg,'(*(a))') " the CIRES CCPP-suite intend to & + support but has Logic error" + errflg = 1 + return + endif + if (is_initialized) return + + if ( do_ugwp_v1 ) then + call cires_ugwpv1_init (me, master, nlunit, logunit, jdat, con_pi, & + con_rerth, fn_nml2, lonr, latr, levs, ak, bk, & + con_p0, dtp, errmsg, errflg) + end if + + if (me == master) then + print *, ' ccpp: ugwpv1_gsldrag_init ' + + print *, ' ccpp do_ugwp_v1 flag ', do_ugwp_v1 + print *, ' ccpp do_gsl_drag_ls_bl flag ', do_gsl_drag_ls_bl + print *, ' ccpp do_gsl_drag_ss flag ' , do_gsl_drag_ss + print *, ' ccpp do_gsl_drag_tofd flag ', do_gsl_drag_tofd + + print *, ' ccpp: ugwpv1_gsldrag_init ' + endif + + is_initialized = .true. + + + end subroutine ugwpv1_gsldrag_init + + +! ----------------------------------------------------------------------- +! finalize of ugwpv1_gsldrag (_finalize) +! ----------------------------------------------------------------------- + +!>@brief The subroutine finalizes the CIRES UGWP + +!> \section arg_table_ugwpv1_gsldrag_finalize Argument Table +!! \htmlinclude ugwpv1_gsldrag_finalize.html +!! + + subroutine ugwpv1_gsldrag_finalize(errmsg, errflg) + + implicit none +! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + call cires_ugwp_dealloc + + is_initialized = .false. + + end subroutine ugwpv1_gsldrag_finalize + + +! ----------------------------------------------------------------------- +! originally from ugwp_driver_v0.f +! driver of cires_ugwp (_driver) +! ----------------------------------------------------------------------- +! driver is called after pbl & before chem-parameterizations +! ----------------------------------------------------------------------- +! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re +! ----------------------------------------------------------------------- +!>@brief These subroutines and modules execute the CIRES UGWP Version 0 +!>\defgroup ugwpv1_gsldrag_run Unified Gravity Wave Physics General Algorithm +!> @{ +!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and background dissipation is represented by the subroutine \ref fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). +!! +!! In UGWP-v0, the specification for the VMF function is adopted from the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran subroutine \ref slat_geos5_tamp describes the latitudinal shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) \cite molod_et_al_2015. It shows that the enhanced values of VMF in the equatorial region gives opportunity to simulate the QBO-like oscillations in the equatorial zonal winds and lead to more realistic simulations of the equatorial dynamics in GEOS-5 operational and MERRA-2 reanalysis products. For the first vertically extended version of FV3GFS in the stratosphere and mesosphere, this simplified function of VMF allows us to tune the model climate and to evaluate multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis products, along with temperature, ozone, and water vapor observations of current satellite missions. After delivery of the UGWP-code, the EMC group developed and tested approach to modulate the zonal mean NGW forcing by 3D-distributions of the total precipitation as a proxy for the excitation of NGWs by convection and the vertically-integrated (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification scores with updated NGW forcing, as reported elsewhere by EMC researchers, display noticeable improvements in the forecast scores produced by FV3GFS configuration extended into the mesosphere. +!! +!> \section arg_table_ugwpv1_gsldrag_run Argument Table +!! \htmlinclude ugwpv1_gsldrag_run.html +!! +!> \section gen_ugwpv1_gsldrag CIRES UGWP Scheme General Algorithm +!! @{ + subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kdt, & + ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, do_gsl_drag_ss, & + do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, & + gwd_opt, do_tofd, ldiag_ugwp, cdmbgwd, jdat, & + con_g, con_omega, con_pi, con_cp, con_rd, con_rv, con_rerth, con_fvirt, & + nmtvr, hprime, oc, theta, sigma, gamma, elvmax, clx, oa4, & + varss,oc1ss,oa4ss,ol4ss, dx, xlat, xlat_d, sinlat, coslat, area, & + rain, br1, hpbl, kpbl, slmsk, & + ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, del, tau_amf, & + dudt_ogw, dvdt_ogw, dtdt_sso, du_ogwcol, dv_ogwcol, & + dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, & + dudt_oss, dvdt_oss, du_osscol, dv_osscol, & + dudt_ofd, dvdt_ofd, du_ofdcol, dv_ofdcol, & + dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, kdis_gw, & + tau_ogw, tau_ngw, tau_oss, & + zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, dudt, dvdt, dtdt, rdxzb, & + ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw, & + lprnt, ipr, errmsg, errflg) + +! old data: jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & +! cap: dt3dt(i,k) = dt3dt(i,k) - dtdt(i,k)*dtf +! +! +!######################################################################## +! Attention New Arrays and Names must be ADDED inside +! +! a) /FV3/gfsphysics/GFS_layer/GFS_typedefs.meta +! b) /FV3/gfsphysics/GFS_layer/GFS_typedefs.F90 +! c) /FV3/gfsphysics/GFS_layer/GFS_diagnostics.F90 +!######################################################################## +![ccpp-table-properties] +! name = GFS_interstitial_type +! type = ddt +!######################################################################## +! +! + implicit none + +! Preference use (im,levs) rather than (:,:) to avoid memory-leaks +! order description control-logical +! other in-variables +! out-variables +! local-variables +! unified diagnostics inside CCPP and GFS_typedefs.F90/GFS_diagnostics.F90 +! +! +! interface variables + logical, intent(in) :: ldiag3d, lssav + logical, intent(in) :: flag_for_gwd_generic_tend + logical, intent(in) :: lprnt + + integer, intent(in) :: ipr + +! flags for choosing combination of GW drag schemes to run + + logical, intent (in) :: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd + logical, intent (in) :: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp + logical, intent (in) :: do_ugwp_v1_w_gsldrag ! combination of ORO and NGW schemes + + integer, intent(in) :: me, master, im, levs, ntrac,lonr + real(kind=kind_phys), intent(in) :: dtp, fhzero + integer, intent(in) :: kdt, jdat(8) + +! SSO parameters and variables + integer, intent(in) :: gwd_opt + integer, intent(in) :: nmtvr + real(kind=kind_phys), intent(in) :: cdmbgwd(4) ! in gsl_drag + + real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc, theta, sigma, gamma + + real(kind=kind_phys), intent(in), dimension(im) :: elvmax + real(kind=kind_phys), intent(in), dimension(im, 4) :: clx, oa4 + + real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss,dx + real(kind=kind_phys), intent(in), dimension(im, 4) :: oa4ss,ol4ss + +!===== +!ccpp-style passing constants +!===== + real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, & + con_rv, con_rerth, con_fvirt +! grids + + real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlat_d, sinlat, coslat, area + +! State vars + PBL/slmsk +rain + + real(kind=kind_phys), intent(in), dimension(im, levs) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil + real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi, phii + real(kind=kind_phys), intent(in), dimension(im, levs) :: q1 + integer, intent(in), dimension(im) :: kpbl + + real(kind=kind_phys), intent(in), dimension(im) :: rain + real(kind=kind_phys), intent(in), dimension(im) :: br1, hpbl, slmsk +! +! moved to GFS_phys_time_vary +! real(kind=kind_phys), intent(in), dimension(im) :: ddy_j1tau, ddy_j2tau +! integer, intent(in), dimension(im) :: jindx1_tau, jindx2_tau + real(kind=kind_phys), intent(in), dimension(im) :: tau_amf + +!Output (optional): + + real(kind=kind_phys), intent(out), dimension(im) :: & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol +! +! we may add later but due to launch in the upper layes ~ mPa comparing to ORO Pa*(0.1) +! du_ngwcol, dv_ngwcol + + real(kind=kind_phys), intent(out), dimension(im) :: dusfcg, dvsfcg + real(kind=kind_phys), intent(out), dimension(im) :: tau_ogw, tau_ngw, tau_oss + + real(kind=kind_phys), intent(out) , dimension(im, levs) :: & + dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & + dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd + + real(kind=kind_phys), intent(out) , dimension(im, levs) :: dudt_ngw, dvdt_ngw, kdis_ngw + real(kind=kind_phys), intent(out) , dimension(im, levs) :: dudt_gw, dvdt_gw, kdis_gw + + real(kind=kind_phys), intent(out) , dimension(im, levs) :: dtdt_sso, dtdt_ngw, dtdt_gw + + real(kind=kind_phys), intent(out) , dimension(im) :: zogw, zlwb, zobl, zngw +! +! + real(kind=kind_phys), intent(inout), dimension(im, levs) :: dudt, dvdt, dtdt + +! +! These arrays are only allocated if ldiag=.true. +! +! Version of COORDE updated by CCPP-dev for time-aver +! + real(kind=kind_phys), intent(inout), dimension(im,levs) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw + real(kind=kind_phys), intent(inout), dimension(im,levs) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw + + + + real(kind=kind_phys), intent(out), dimension(im) :: rdxzb ! for stoch phys. mtb-level + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! local variables + integer :: i, k + real(kind=kind_phys), dimension(im) :: sgh30 + real(kind=kind_phys), dimension(im, levs) :: Pdvdt, Pdudt + real(kind=kind_phys), dimension(im, levs) :: Pdtdt, Pkdis +!------------ +! +! from ugwp_driver_v0.f -> cires_ugwp_initialize.F90 -> module ugwp_wmsdis_init +! now in the namelist of cires_ugwp "knob_ugwp_tauamp" controls tamp_mpa +! +! tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 +!------------ +! real(kind=kind_phys), parameter :: tamp_mpa_v0=30.e-3 ! large flux to help "GFS-ensembles" in July 2019 + +! switches that activate impact of OGWs and NGWs + +! integer :: nmtvr_temp + + real(kind=kind_phys) :: inv_g + + real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers + real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces + + +! ugwp_v1 local variables + + integer :: y4, month, day, ddd_ugwp, curdate, curday + +! ugwp_v1 temporary (local) diagnostic variables from cires_ugwp_solv2_v1 +! diagnostics for wind and temp rms to compare with space-borne data and metrics +! in the Middle atmosphere: 20-110 km ( not active in CCPP-style, oct 2020) +! real(kind=kind_phys) :: tauabs(im,levs), wrms(im,levs), trms(im,levs) + + + ! Initialize CCPP error handling variables + + errmsg = '' + errflg = 0 + +! 1) ORO stationary GWs +! ------------------ +! +! for all oro-suites can uze geo-meters having "hpbl" +! + inv_g = 1./con_g +! +! All GW-schemes operate with Zmet =phil*inv_g, passing Zmet/Zmeti can be more robust +! + rho*dz = =delp * inv_g can be also pre-comp for all "GW-schemes" +! + zmeti = phii*inv_g + zmet = phil*inv_g + +!=============================================================== +! ORO-diag + + dudt_ogw(:,:) = 0. ; dvdt_ogw(:,:)=0. ; dudt_obl(:,:)=0. ; dvdt_obl(:,:)=0. + dudt_oss(:,:) = 0. ; dvdt_oss(:,:)=0. ; dudt_ofd(:,:)=0. ; dvdt_ofd(:,:)=0. + + dusfcg (:) = 0. ; dvsfcg(:) =0. + + du_ogwcol(:)=0. ; dv_ogwcol(:)=0. ; du_oblcol(:)=0. ; dv_oblcol(:)=0. + du_osscol(:)=0. ; dv_osscol(:)=0. ;du_ofdcol(:)=0. ; dv_ofdcol(:)=0. + +! + dudt_ngw(:,:)=0. ; dvdt_ngw(:,:)=0. ; dtdt_ngw(:,:)=0. ; kdis_ngw(:,:)=0. + +! ngw+ogw - diag + + dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; kdis_gw(:,:)=0. +! source fluxes + + tau_ogw(:)=0. ; tau_ngw(:)=0. ; tau_oss(:)=0. + +! launch layers + + zlwb(:)= 0. ; zogw(:)=0. ; zobl(:)=0. ; zngw(:)=0. +!=============================================================== +! Accumulated tendencies due to 3-SSO schemes (all ORO-physics) +! ogw + obl +oss +ofd ..... no explicit "lee wave trapping" +!=============================================================== + do k=1,levs + do i=1,im + Pdvdt(i,k) = 0.0 + Pdudt(i,k) = 0.0 + Pdtdt(i,k) = 0.0 + Pkdis(i,k) = 0.0 + enddo + enddo +! +! ------------------ +! +! Also zero all ORO diag-c arrays to avoid "special ifs and zeros" +! like old GFS-ORO gwdps_run has limited diagnostics +! +! ------------------ + + ! Run the appropriate large-scale (large-scale GWD + blocking) scheme + ! Note: In case of GSL drag_suite, this includes ss and tofd + + if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd & + .or. do_ugwp_v1_w_gsldrag) then +! +! the zero diag and tendency values assigned inside "drag_suite_run" can be skipped : +! +! dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl,dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd +! du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, du_osscol, dv_osscol, du_ofdcol dv_ofdcol +! dusfcg, dvsfcg +! gsd_diss_ht_opt =0 => Pdtdt = bl+ls +(Pdtdt=0) +! + call drag_suite_run(im,levs, Pdvdt, Pdudt, Pdtdt, & + ugrs,vgrs,tgrs,q1, & + kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & + kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & + ol4ss,theta,sigma,gamma,elvmax, & + dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & + dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & + dusfcg, dvsfcg, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & + slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & + con_fvirt,con_pi,lonr, & + cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & + errmsg,errflg) +! +! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol +! + if (kdt <= 2 .and. me == master) then + print *, ' unified drag_suite_run ', kdt + print *, ' GSL drag du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 + print *, ' GSL drag dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 + +! zero print *, ' unified drag_GSL dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 + +! if (gwd_opt == 22 .or. gwd_opt == 33) then +! print *, ' unified drag_GSL dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 +! print *, ' unified drag_GSL dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 +! print *, ' unified drag_GSL dUOGW/dt ', maxval(dudt_ogw)*86400, minval(dudt_ogw)*86400 +! print *, ' unified drag_GSL dVOGW/dt ', maxval(dvdt_ogw)*86400, minval(dvdt_ogw)*86400 +! print *, ' unified drag_GSL dUOss/dt ', maxval(dudt_oss)*86400, minval(dudt_oss)*86400 +! print *, ' unified drag_GSL dVOSS/dt ', maxval(dvdt_oss)*86400, minval(dvdt_oss)*86400 +! print *, ' unified drag_GSL dUOfd/dt ', maxval(dudt_ofd)*86400, minval(dudt_ofd)*86400 +! print *, ' unified drag_GSL dVOfd/dt ', maxval(dvdt_ofd)*86400, minval(dvdt_ofd)*86400 +! endif + endif + + else +! +! not gsldrag scheme for example "do_ugwp_v1_orog_only" +! + + if ( do_ugwp_v1_orog_only ) then +! +! for TOFD we use now "varss" of GSL-drag /not sgh30=abs(oro-oro_f)/ +! only sum of integrated ORO+GW effects (dusfcg and dvsfcg) = sum(ogw + obl + oss*0 + ofd + ngw) +! +! OROGW_V1 introduce "orchestration" between OGW-effects and Mountain Blocking +! it starts to examines options for the Scale-Aware (SA)formulation of SSO-effects +! if ( me == master .and. kdt == 1) print *, ' bf orogw_v1 nmtvr=', nmtvr, ' do_tofd=', do_tofd + + if (gwd_opt ==1 )sgh30 = 0.15*hprime ! portion of the mesoscale SSO (~[oro_unfilt -oro_filt) + if (gwd_opt >1 ) sgh30 = varss ! as in gsldrag: see drag_suite_run + + call orogw_v1 (im, levs, lonr, me, master,dtp, kdt, do_tofd, & + con_g, con_omega, con_rd, con_cp, con_rv,con_pi, & + con_rerth, con_fvirt,xlat_d, sinlat, coslat, area, & + cdmbgwd(1:2), hprime, oc, oa4, clx, theta, & + sigma, gamma, elvmax, sgh30, kpbl, ugrs, & + vgrs, tgrs, q1, prsi,del,prsl,prslk, zmeti, zmet, & + Pdvdt, Pdudt, Pdtdt, Pkdis, DUSFCg, DVSFCg,rdxzb, & + zobl, zlwb, zogw, tau_ogw, dudt_ogw, dvdt_ogw, & + dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_ofdcol, dv_ofdcol, errmsg,errflg ) +! +! orogw_v1: dusfcg = du_ogwcol + du_oblcol + du_ofdcol only 3 terms +! +! + if (kdt <= 2 .and. me == master) then + + print *, ' unified_ugwp orogw_v1 ', kdt, me, nmtvr + print *, ' unified_ugwp orogw_v1 du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 + print *, ' unified_ugwp orogw_v1 dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 + print *, ' unified_ugwp orogw_v1 dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 + print *, ' unified_ugwp orogw_v1 dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 + print *, ' unified_ugwp orogw_v1 dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 + endif + +! pdudt = 0.0*pdudt ; pdvdt = 0.0*pdvdt ; pdtdt = 0. + + end if +! +! GFS-style diag dt3dt(:.:, 1:14) +! + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then + do k=1,levs + do i=1,im + ldu3dt_ogw(i,k) = ldu3dt_ogw(i,k) + Pdudt(i,k)*dtp + ldv3dt_ogw(i,k) = ldv3dt_ogw(i,k) + Pdvdt(i,k)*dtp + ldt3dt_ogw(i,k) = ldt3dt_ogw(i,k) + Pdtdt(i,k)*dtp + enddo + enddo + endif + ENDIF ! +! + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Begin non-stationary GW schemes +! ugwp_v1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if (do_ugwp_v1) then + +!================================================================== +! call slat_geos5_tamp_v1(im, tamp_mpa, xlat_d, tau_ngw) +! +! updates of MERRA/GEOS tau_ngw for the C96-QBO FV3GFS-127L runs +!================================================================== + + call slat_geos5_2020(im, tamp_mpa, xlat_d, tau_ngw) +! if (me == master) then +! print *, ' ugwpv1 forcing ', maxval(tau_ngw), minval(tau_ngw) +! print *, ' ugwpv1 forcing tamp_mpa ', tamp_mpa +! endif + y4 = jdat(1); month = jdat(2); day = jdat(3) +! +! hour = jdat(5) +! fhour = float(hour)+float(jdat(6))/60. + float(jdat(7))/3600. +! fhour = (kdt-1)*dtp/3600. +! fhrday = fhour/24. - nint(fhour/24.) + + + call calendar_ugwp(y4, month, day, ddd_ugwp) + curdate = y4*1000 + ddd_ugwp +! + call ngwflux_update(me, master, im, levs, kdt, ddd_ugwp,curdate, & + tau_amf, xlat_d, sinlat,coslat, rain, tau_ngw) + + call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, & + tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, & + zmet, zmeti,prslk, xlat_d, sinlat, coslat, & + con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt, & + dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw) + + + if (me == master .and. kdt <= 2) then + print * + write(6,*)'FV3GFS finished fv3_ugwp_solv2_v1 ' +! write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' + print * + + print *, ' ugwp_v1 ', kdt + print *, ' ugwp_v1 du/dt ', maxval(dudt_ngw)*86400, minval(dudt_ngw)*86400 + print *, ' ugwp_v1 dv/dt ', maxval(dvdt_ngw)*86400, minval(dvdt_ngw)*86400 + print *, ' ugwp_v1 dT/dt ', maxval(dtdt_ngw)*86400, minval(dtdt_ngw)*86400 + + + endif + + + end if ! do_ugwp_v1 + +! +! GFS-style diag dt3dt(:.:, 1:14) time-averaged +! + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then + do k=1,levs + do i=1,im + ldu3dt_ngw(i,k) = ldu3dt_ngw(i,k) + dudt_ngw(i,k)*dtp + ldv3dt_ngw(i,k) = ldv3dt_ngw(i,k) + dvdt_ngw(i,k)*dtp + ldt3dt_ngw(i,k) = ldt3dt_ngw(i,k) + dtdt_ngw(i,k)*dtp + enddo + enddo + endif + +! +! get total sso-OGW + NGW +! + dudt_gw = Pdudt +dudt_ngw + dvdt_gw = Pdvdt +dvdt_ngw + dtdt_gw = Pdtdt +dtdt_ngw + kdis_gw = Pkdis +kdis_ngw +! +! add to previous phys-tendencies +! ?-accumulation of GFS ( pbl + gw =0 rf should be taken out from physics, inside FV3-dycore) + + dudt = dudt + dudt_ngw + dvdt = dvdt + dvdt_ngw + dtdt = dtdt + dtdt_ngw + + end subroutine ugwpv1_gsldrag_run +!! @} +!>@} +end module ugwpv1_gsldrag diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta new file mode 100644 index 000000000..73d717f78 --- /dev/null +++ b/physics/ugwpv1_gsldrag.meta @@ -0,0 +1,1265 @@ +[ccpp-table-properties] + name = ugwpv1_gsldrag + type = scheme + dependencies = machine.F,drag_suite.F90 + dependencies = cires_ugwpv1_module.F90,cires_ugwpv1_triggers.F90,cires_ugwpv1_initialize.F90,cires_ugwpv1_solv2.F90 + dependencies = cires_ugwpv1_sporo.F90,cires_ugwpv1_oro.F90 +######################################################################## +[ccpp-arg-table] + name = ugwpv1_gsldrag_init + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for opening namelist file + units = none + dimensions = () + type = integer + intent = in + optional = F +[input_nml_file] + standard_name = namelist_filename_for_internal_file_reads + long_name = character string to store full namelist contents + units = none + dimensions = (number_of_lines_of_namelist_filename_for_internal_file_reads) + type = character + kind = len=* + intent = in + optional = F +[logunit] + standard_name = iounit_log + long_name = fortran unit number for writing logfile + units = none + dimensions = () + type = integer + intent = in + optional = F +[fn_nml2] + standard_name = namelist_filename + long_name = namelist filename for ugwp + units = none + dimensions = () + type = character + kind = len=* + intent = in + optional = F +[jdat] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer +[lonr] + standard_name = number_of_equatorial_longitude_points + long_name = number of global points in x-dir (i) along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[latr] + standard_name = number_of_latitude_points + long_name = number of global points in y-dir (j) along the meridian + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ak] + standard_name = a_parameter_of_the_hybrid_coordinate + long_name = a parameter for sigma pressure level calculations + units = Pa + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[bk] + standard_name = b_parameter_of_the_hybrid_coordinate + long_name = b parameter for sigma pressure level calculations + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rerth] + standard_name = radius_of_earth + long_name = radius of earth + units = m + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_p0] + standard_name = standard_atmospheric_pressure + long_name = standard atmospheric pressure + units = Pa + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[do_ugwp] + standard_name = do_ugwp + long_name = flag to activate CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v0] + standard_name = do_ugwp_v0 + long_name = flag to activate ver 0 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v0_orog_only] + standard_name = do_ugwp_v0_orog_only + long_name = flag to activate ver 0 CIRES UGWP - orographic GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ls_bl] + standard_name = do_gsl_drag_ls_bl + long_name = flag to activate GSL drag suite - large-scale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ss] + standard_name = do_gsl_drag_ss + long_name = flag to activate GSL drag suite - small-scale GWD + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_tofd] + standard_name = do_gsl_drag_tofd + long_name = flag to activate GSL drag suite - turb orog form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1] + standard_name = do_ugwp_v1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1_orog_only] + standard_name = do_ugwp_v1_orog_only + long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1_w_gsldrag] + standard_name = do_ugwp_v1_w_gsldrag + long_name = flag to activate ver 1 CIRES UGWP - with OGWD of GSL + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = ugwpv1_gsldrag_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = ugwpv1_gsldrag_run + type = scheme +[me] + standard_name = mpi_rank + long_name = MPI rank of current process + units = index + dimensions = () + type = integer + intent = in + optional = F +[master] + standard_name = mpi_root + long_name = MPI rank of master process + units = index + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[lonr] + standard_name = number_of_equatorial_longitude_points + long_name = number of global points in x-dir (i) along the equator + units = count + dimensions = () + type = integer + intent = in + optional = F +[dtp] + standard_name = time_step_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fhzero] + standard_name = hours_between_clearing_of_diagnostic_buckets + long_name = hours between clearing of diagnostic buckets + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ldiag3d] + standard_name = flag_diagnostics_3D + long_name = flag for 3d diagnostic fields + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lssav] + standard_name = flag_diagnostics + long_name = logical flag for storing diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[flag_for_gwd_generic_tend] + standard_name = flag_for_generic_gravity_wave_drag_tendency + long_name = true if GFS_GWD_generic should calculate tendencies + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ls_bl] + standard_name = do_gsl_drag_ls_bl + long_name = flag to activate GSL drag suite - large-scale GWD and blocking + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_ss] + standard_name = do_gsl_drag_ss + long_name = flag to activate GSL drag suite - small-scale GWD + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_gsl_drag_tofd] + standard_name = do_gsl_drag_tofd + long_name = flag to activate GSL drag suite - turb orog form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1] + standard_name = do_ugwp_v1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1_orog_only] + standard_name = do_ugwp_v1_orog_only + long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F +[do_ugwp_v1_w_gsldrag] + standard_name = do_ugwp_v1_w_gsldrag + long_name = flag to activate ver 1 CIRES UGWP - with OGWD of GSL + units = flag + dimensions = () + type = logical + intent = in + optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[do_tofd] + standard_name = turb_oro_form_drag_flag + long_name = flag for turbulent orographic form drag + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ldiag_ugwp] + standard_name = diag_ugwp_flag + long_name = flag for CIRES UGWP Diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[cdmbgwd] + standard_name = multiplication_factors_for_mountain_blocking_and_orographic_gravity_wave_drag + long_name = multiplication factors for cdmb and gwd + units = none + dimensions = (4) + type = real + kind = kind_phys + intent = in + optional = F +[jdat] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_omega] + standard_name = angular_velocity_of_earth + long_name = angular velocity of earth + units = s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat !of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rerth] + standard_name = radius_of_earth + long_name = radius of earth + units = m + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[nmtvr] + standard_name = number_of_statistical_measures_of_subgrid_orography + long_name = number of topographic variables in GWD + units = count + dimensions = () + type = integer + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[oc] + standard_name = convexity_of_subgrid_orography + long_name = convexity of subgrid orography + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[theta] + standard_name = angle_from_east_of_maximum_subgrid_orographic_variations + long_name = angle with_respect to east of maximum subgrid orographic variations + units = degree + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sigma] + standard_name = slope_of_subgrid_orography + long_name = slope of subgrid orography + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[gamma] + standard_name = anisotropy_of_subgrid_orography + long_name = anisotropy of subgrid orography + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[elvmax] + standard_name = maximum_subgrid_orography + long_name = maximum of subgrid orography + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[clx] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height + long_name = horizontal fraction of grid box covered by subgrid orography higher than critical height + units = frac + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys + intent = in + optional = F +[oa4] + standard_name = asymmetry_of_subgrid_orography + long_name = asymmetry of subgrid orography + units = none + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys + intent = in + optional = F +[varss] + standard_name = standard_deviation_of_subgrid_orography_small_scale + long_name = standard deviation of subgrid orography small scale + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[oc1ss] + standard_name = convexity_of_subgrid_orography_small_scale + long_name = convexity of subgrid orography small scale + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[oa4ss] + standard_name = asymmetry_of_subgrid_orography_small_scale + long_name = asymmetry of subgrid orography small scale + units = none + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys + intent = in + optional = F +[ol4ss] + standard_name = fraction_of_grid_box_with_subgrid_orography_higher_than_critical_height_small_scale + long_name = horizontal fraction of grid box covered by sso higher than critical height small scale + units = frac + dimensions = (horizontal_loop_extent,4) + type = real + kind = kind_phys + intent = in + optional = F +[dx] + standard_name = cell_size + long_name = size of the grid cell + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = grid latitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sinlat] + standard_name = sine_of_latitude + long_name = sine of the grid latitude + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of the grid latitude + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[rain] + standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total rain at this time step + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[br1] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ugrs] + standard_name = x_wind + long_name = zonal wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vgrs] + standard_name = y_wind + long_name = meridional wind + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tgrs] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity + long_name = mid-layer specific humidity of water vapor + units = kg kg-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = air pressure difference between midlayers + units = Pa + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tau_amf] + standard_name = ngw_abs_momentum_flux + long_name = ngw_absolute_momentum_flux + units = various + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_ogw] + standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = x momentum tendency from meso scale ogw + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvdt_ogw] + standard_name = y_momentum_tendency_from_meso_scale_ogw + long_name = y momentum tendency from meso scale ogw + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtdt_sso] + standard_name = tendency_of_air_temperature_due_to_sso + long_name = air temperature tendency due to subgrid-scale orography + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[du_ogwcol] + standard_name = integrated_x_momentum_flux_from_meso_scale_ogw + long_name = integrated x momentum flux from meso scale ogw + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dv_ogwcol] + standard_name = integrated_y_momentum_flux_from_meso_scale_ogw + long_name = integrated y momentum flux from meso scale ogw + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_obl] + standard_name = x_momentum_tendency_from_blocking_drag_vy + long_name = x momentum tendency from blocking drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvdt_obl] + standard_name = y_momentum_tendency_from_blocking_drag_vy + long_name = y momentum tendency from blocking drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[du_oblcol] + standard_name = integrated_x_momentum_flux_from_blocking_drag_vy + long_name = integrated x momentum flux from blocking drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dv_oblcol] + standard_name = integrated_y_momentum_flux_from_blocking_drag_vy + long_name = integrated y momentum flux from blocking drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_oss] + standard_name = x_momentum_tendency_from_small_scale_gwd_vy + long_name = x momentum tendency from small scale gwd + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvdt_oss] + standard_name = y_momentum_tendency_from_small_scale_gwd_vy + long_name = y momentum tendency from small scale gwd + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[du_osscol] + standard_name = integrated_x_momentum_flux_from_small_scale_gwd_vy + long_name = integrated x momentum flux from small scale gwd + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dv_osscol] + standard_name = integrated_y_momentum_flux_from_small_scale_gwd_vy + long_name = integrated y momentum flux from small scale gwd + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_ofd] + standard_name = x_momentum_tendency_from_form_drag_vy + long_name = x momentum tendency from form drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvdt_ofd] + standard_name = y_momentum_tendency_from_form_drag_vy + long_name = y momentum tendency from form drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[du_ofdcol] + standard_name = integrated_x_momentum_flux_from_form_drag_vy + long_name = integrated x momentum flux from form drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dv_ofdcol] + standard_name = integrated_y_momentum_flux_from_form_drag_vy + long_name = integrated y momentum flux from form drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_ngw] + standard_name = tendency_of_x_wind_due_to_ngw + long_name = zonal wind tendency due to non-stationary GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvdt_ngw] + standard_name = tendency_of_y_wind_due_to_ngw + long_name = meridional wind tendency due to non-stationary GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtdt_ngw] + standard_name = tendency_of_air_temperature_due_to_ngw + long_name = air temperature tendency due to non-stationary GWs + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kdis_ngw] + standard_name = eddy_mixing_due_to_ngw + long_name = eddy mixing due to non-stationary GWs + units = m2 s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dudt_gw] + standard_name = tendency_of_x_wind_due_to_allgw + long_name = zonal wind tendency due to all GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvdt_gw] + standard_name = tendency_of_y_wind_due_to_allgw + long_name = meridional wind tendency due to all GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtdt_gw] + standard_name = tendency_of_air_temperature_due_to_allgw + long_name = air temperature tendency due to all GWs + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kdis_gw] + standard_name = eddy_mixing_due_to_allgw + long_name = eddy mixing due to all GWs + units = m2 s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tau_ogw] + standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = momentum flux or stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[tau_ngw] + standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave + long_name = momentum flux or stress due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[tau_oss] + standard_name = instantaneous_momentum_flux_due_to_sso + long_name = momentum flux or stress due to SSO including OBL-OSS-OFD + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[zogw] + standard_name = height_of_launch_level_of_orographic_gravity_wave + long_name = height of launch level of orographic gravity waves + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[zlwb] + standard_name = height_of_low_level_wave_breaking + long_name = height of low level wave breaking for OGWs + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[zobl] + standard_name = height_of_mountain_blocking_v1 + long_name = height of mountain blocking drag_v1 + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[zngw] + standard_name = height_of_launch_level_of_nonsta_gravity_wave + long_name = height of launch level of non-stationary GWs + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dusfcg] + standard_name = instantaneous_x_stress_due_to_gravity_wave_drag + long_name = zonal surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfcg] + standard_name = instantaneous_y_stress_due_to_gravity_wave_drag + long_name = meridional surface stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F + intent = out + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rdxzb] + standard_name = level_of_dividing_streamline + long_name = level of the dividing streamline + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[ldu3dt_ogw] + standard_name = cumulative_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in x wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldv3dt_ogw] + standard_name = cumulative_change_in_y_wind_due_to_orographic_gravity_wave_drag + long_name = cumulative change in y wind due to orographic gravity wave drag + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldt3dt_ogw] + standard_name = cumulative_change_in_temperature_due_to_orographic_gravity_wave_drag + long_name = cumulative change in temperature due to orographic gravity wave drag + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldu3dt_ngw] + standard_name = cumulative_change_in_x_wind_due_to_convective_gravity_wave_drag + long_name = cumulative change in x wind due to convective gravity wave drag + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldv3dt_ngw] + standard_name = cumulative_change_in_y_wind_due_to_convective_gravity_wave_drag + long_name = cumulative change in y wind due to convective gravity wave drag + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ldt3dt_ngw] + standard_name = cumulative_change_in_temperature_due_to_convective_gravity_wave_drag + long_name = cumulative change in temperature due to convective gravity wave drag + units = K + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lprnt] + standard_name = flag_print + long_name = control flag for diagnostic print out + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + + diff --git a/physics/ugwpv1_gsldrag_post.F90 b/physics/ugwpv1_gsldrag_post.F90 new file mode 100644 index 000000000..1d8813f65 --- /dev/null +++ b/physics/ugwpv1_gsldrag_post.F90 @@ -0,0 +1,107 @@ +!> \file ugwpv1_gsldrag_post.F90 +!! This file contains +module ugwpv1_gsldrag_post + +contains + +!>\defgroup ugwpv1_gsldrag_post ugwpv1_gsldrag Scheme Post +!! @{ + + subroutine ugwpv1_gsldrag_post_init () + end subroutine ugwpv1_gsldrag_post_init + +!>@brief The subroutine initializes the unified UGWP + +!> \section arg_table_ugwpv1_gsldrag_post_run Argument Table +!! \htmlinclude ugwpv1_gsldrag_post_run.html +!! + + + + subroutine ugwpv1_gsldrag_post_run ( im, levs, & + ldiag_ugwp, dtf, & + dudt_gw, dvdt_gw, dtdt_gw, du_ofdcol, du_oblcol, tau_ogw, & + tau_ngw, zobl, zlwb, zogw, dudt_obl, dudt_ofd, dudt_ogw, & + tot_zmtb, tot_zlwb, tot_zogw, & + tot_tofd, tot_mtb, tot_ogw, tot_ngw, & + du3dt_mtb,du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw, & + dtdt, dudt, dvdt, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! Interface variables + integer, intent(in) :: im, levs + real(kind=kind_phys), intent(in) :: dtf + logical, intent(in) :: ldiag_ugwp !< flag for CIRES UGWP Diagnostics + + real(kind=kind_phys), intent(in), dimension(im) :: zobl, zlwb, zogw + real(kind=kind_phys), intent(in), dimension(im) :: du_ofdcol, tau_ogw, du_oblcol, tau_ngw + real(kind=kind_phys), intent(inout), dimension(im) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw + real(kind=kind_phys), intent(inout), dimension(im) :: tot_zmtb, tot_zlwb, tot_zogw + + real(kind=kind_phys), intent(in), dimension(im,levs) :: dtdt_gw, dudt_gw, dvdt_gw + real(kind=kind_phys), intent(in), dimension(im,levs) :: dudt_obl, dudt_ogw, dudt_ofd + real(kind=kind_phys), intent(inout), dimension(im,levs) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + + real(kind=kind_phys), intent(inout), dimension(im,levs) :: dtdt, dudt, dvdt + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +! +! post creates the "time-averaged" diagnostics" +! + + if (ldiag_ugwp) then + tot_zmtb = tot_zmtb + dtf *zobl + tot_zlwb = tot_zlwb + dtf *zlwb + tot_zogw = tot_zogw + dtf *zogw + + tot_tofd = tot_tofd + dtf *du_ofdcol + tot_mtb = tot_mtb + dtf *du_oblcol + tot_ogw = tot_ogw + dtf *tau_ogw + tot_ngw = tot_ngw + dtf *tau_ngw + + du3dt_mtb = du3dt_mtb + dtf *dudt_obl + du3dt_tms = du3dt_tms + dtf *dudt_ofd + du3dt_ogw = du3dt_ogw + dtf *dudt_ogw + du3dt_ngw = du3dt_ngw + dtf *dudt_gw + dv3dt_ngw = dv3dt_ngw + dtf *dvdt_gw + endif + +!===================================================================== +! Updates inside the ugwpv1_gsldrag.F90 +! +! dtdt = dtdt + dtdt_gw +! dudt = dudt + dudt_gw +! dvdt = dvdt + dvdt_gw +! +! "post" may also create the "time-averaged" diagnostics" +! +! if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then +! do k=1,levs +! do i=1,im +! ldu3dt_ngw(i,k) = ldu3dt_ngw(i,k) + dudt_ngw(i,k)*dtf +! ldv3dt_ngw(i,k) = ldv3dt_ngw(i,k) + dvdt_ngw(i,k)*dtf +! ldt3dt_ngw(i,k) = ldt3dt_ngw(i,k) + dtdt_ngw(i,k)*dtf +! +! ldu3dt_ogw(i,k) = ldu3dt_ogw(i,k) + dudt_ogw(i,k)*dtf +! ldv3dt_ogw(i,k) = ldv3dt_ogw(i,k) + dvdt_ogw(i,k)*dtf +! ldt3dt_ogw(i,k) = ldt3dt_ogw(i,k) + dtdt_ogw(i,k)*dtf +! enddo +! enddo +! endif +! +!===================================================================== + end subroutine ugwpv1_gsldrag_post_run + + subroutine ugwpv1_gsldrag_post_finalize () + end subroutine ugwpv1_gsldrag_post_finalize + +!! @} +end module ugwpv1_gsldrag_post diff --git a/physics/ugwpv1_gsldrag_post.meta b/physics/ugwpv1_gsldrag_post.meta new file mode 100644 index 000000000..9ed76d6e8 --- /dev/null +++ b/physics/ugwpv1_gsldrag_post.meta @@ -0,0 +1,321 @@ +[ccpp-table-properties] + name = ugwpv1_gsldrag_post + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = ugwpv1_gsldrag_post_init + type = scheme + +######################################################################## +[ccpp-arg-table] + name = ugwpv1_gsldrag_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ldiag_ugwp] + standard_name = diag_ugwp_flag + long_name = flag for CIRES UGWP Diagnostics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dudt_gw] + standard_name = tendency_of_x_wind_due_to_allgw + long_name = zonal wind tendency due to all GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dvdt_gw] + standard_name = tendency_of_y_wind_due_to_allgw + long_name = meridional wind tendency due to all GWs + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dtdt_gw] + standard_name = tendency_of_air_temperature_due_to_allgw + long_name = air temperature tendency due to all GWs + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[du_oblcol] + standard_name = integrated_x_momentum_flux_from_blocking_drag_vy + long_name = integrated x momentum flux from blocking drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[du_ofdcol] + standard_name = integrated_x_momentum_flux_from_form_drag_vy + long_name = integrated x momentum flux from form drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tau_ogw] + standard_name = instantaneous_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = momentum flux or stress due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tau_ngw] + standard_name = instantaneous_momentum_flux_due_to_nonstationary_gravity_wave + long_name = momentum flux or stress due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[zobl] + standard_name = height_of_mountain_blocking_v1 + long_name = height of mountain blocking drag_v1 + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[zlwb] + standard_name = height_of_low_level_wave_breaking + long_name = height of low level wave breaking for OGWs + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[zogw] + standard_name = height_of_launch_level_of_orographic_gravity_wave + long_name = height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_obl] + standard_name = x_momentum_tendency_from_blocking_drag_vy + long_name = x momentum tendency from blocking drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_ofd] + standard_name = x_momentum_tendency_from_form_drag_vy + long_name = x momentum tendency from form drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dudt_ogw] + standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = x momentum tendency from meso scale ogw + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tot_zmtb] + standard_name = time_integral_of_height_of_mountain_blocking + long_name = time integral of height of mountain blocking drag + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_zlwb] + standard_name = time_integral_of_height_of_low_level_wave_breaking + long_name = time integral of height of drag due to low level wave breaking + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_zogw] + standard_name = time_integral_of_height_of_launch_level_of_orographic_gravity_wave + long_name = time integral of height of launch level of orographic gravity wave + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_tofd] + standard_name = time_integral_of_momentum_flux_due_to_turbulent_orographic_form_drag + long_name = time integral of momentum flux due to TOFD + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_mtb] + standard_name = time_integral_of_momentum_flux_due_to_mountain_blocking_drag + long_name = time integral of momentum flux due to mountain blocking drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_ogw] + standard_name = time_integral_of_momentum_flux_due_to_orographic_gravity_wave_drag + long_name = time integral of momentum flux due to orographic gravity wave drag + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tot_ngw] + standard_name = time_integral_of_momentum_flux_due_to_nonstationary_gravity_wave + long_name = time integral of momentum flux due to nonstationary gravity waves + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_mtb] + standard_name = time_integral_of_change_in_x_wind_due_to_mountain_blocking_drag + long_name = time integral of change in x wind due to mountain blocking drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ogw] + standard_name = time_integral_of_change_in_x_wind_due_to_orographic_gravity_wave_drag + long_name = time integral of change in x wind due to orographic gw drag + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_tms] + standard_name = time_integral_of_change_in_x_wind_due_to_turbulent_orographic_form_drag + long_name = time integral of change in x wind due to TOFD + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du3dt_ngw] + standard_name = time_integral_of_change_in_x_wind_due_to_nonstationary_gravity_wave + long_name = time integral of change in x wind due to NGW + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dv3dt_ngw] + standard_name = time_integral_of_change_in_y_wind_due_to_nonstationary_gravity_wave + long_name = time integral of change in y wind due to NGW + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dtdt] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = air temperature tendency due to model physics + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dudt] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = zonal wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dvdt] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = meridional wind tendency due to model physics + units = m s-2 + dimensions = (horizontal_loop_extent,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = ugwpv1_gsldrag_post_finalize + type = scheme + diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 5c0604f86..220acb42c 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -244,8 +244,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, integer, intent(in) :: gwd_opt integer, intent(in), dimension(im) :: kpbl real(kind=kind_phys), intent(in), dimension(im) :: oro, oro_uf, hprime, oc, theta, sigma, gamma - real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss,dx - real(kind=kind_phys), intent(in), dimension(im,4) :: oa4ss,ol4ss + real(kind=kind_phys), intent(in), dimension(im) :: varss,oc1ss, dx + +!vay-nov 2020 + real(kind=kind_phys), intent(in), dimension(im,4) :: oa4ss,ol4ss + logical, intent(in) :: flag_for_gwd_generic_tend ! elvmax is intent(in) for CIRES UGWP, but intent(inout) for GFS GWDPS real(kind=kind_phys), intent(inout), dimension(im) :: elvmax @@ -315,12 +318,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), dimension(im) :: sgh30 real(kind=kind_phys), dimension(im, levs) :: Pdvdt, Pdudt real(kind=kind_phys), dimension(im, levs) :: Pdtdt, Pkdis - real(kind=kind_phys), dimension(im, levs) :: ed_dudt, ed_dvdt, ed_dtdt - ! from ugwp_driver_v0.f -> cires_ugwp_initialize.F90 -> module ugwp_wmsdis_init + real(kind=kind_phys), parameter :: tamp_mpa=30.e-3 ! switches that activate impact of OGWs and NGWs (WL* how to deal with them? *WL) real(kind=kind_phys), parameter :: pogw=1., pngw=1., pked=1. - real(kind=kind_phys), parameter :: fw1_tau=1.0 + integer :: nmtvr_temp real(kind=kind_phys), dimension(:,:), allocatable :: tke @@ -331,23 +333,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces - - ! ugwp_v1 local variables - integer :: y4, month, day, ddd_ugwp, curdate, curday - integer :: hour - real(kind=kind_phys) :: hcurdate, hcurday, fhour, fhrday - integer :: kdtrest - integer :: curday_ugwp - integer :: curday_save=20150101 - logical :: first_qbo=.true. - real :: hcurday_save =20150101.00 - save first_qbo, curday_save, hcurday_save - - - ! ugwp_v1 temporary (local) diagnostic variables from cires_ugwp_solv2_v1 - real(kind=kind_phys) :: tauabs(im,levs), wrms(im,levs), trms(im,levs) - - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -388,7 +373,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, sgh30 = abs(oro - oro_uf) ! w/o orographic effects else - sgh30 = 0. + sgh30 = varss endif inv_g = 1./con_g @@ -543,26 +528,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. endif -#if 0 - !============================================================================= - ! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving - ! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" - !============================================================================= - ! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies - !------------------------------------------------------------------------------ - do k=1,levs - do i=1,im - ed_dudt(i,k) = 0.0 ; ed_dvdt(i,k) = 0.0 ; ed_dtdt(i,k) = 0.0 - enddo - enddo - - call edmix_ugwp_v0(im, levs, dtp, tgrs, ugrs, vgrs, q1, & - del, prsl, prsi, phil, prslk, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & - ed_dudt, ed_dvdt, ed_dtdt, me, master, kdt) - gw_dtdt = gw_dtdt*(1.-pked) + ed_dtdt*pked - gw_dvdt = gw_dvdt*(1.-pked) + ed_dvdt*pked - gw_dudt = gw_dudt*(1.-pked) + ed_dudt*pked -#endif if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then do k=1,levs @@ -577,160 +542,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, end if ! do_ugwp_v0 - ! - ! ugwp_v1 non-stationary GW drag - ! - if (do_ugwp_v1) then - -! -------- -! 2) non-stationary GWs with GEOS-5/MERRA GW-forcing -! ---------------------------------------------- -!-------- -! GMAO GEOS-5/MERRA GW-forcing lat-dep -!-------- - call slat_geos5_tamp_v1(im, tamp_mpa, xlat_d, tau_ngw) - - y4 = jdat(1); month = jdat(2); day = jdat(3) ; hour = jdat(5) - - ! fhour = float(hour)+float(jdat(6))/60. + float(jdat(7))/3600. - fhour = (kdt-1)*dtp/3600. - fhrday = fhour/24. - nint(fhour/24.) - fhour = fhrday*24. - - call calendar_ugwp(y4, month, day, ddd_ugwp) - curdate = y4*1000 + ddd_ugwp - curday = y4*10000 + month*100 + day - hcurdate = float(curdate) + fhrday - hcurday = float(curday) + fhrday -! - if (mod(fhour,fhzero) == 0 .or. first_qbo) then - - ! call tau_limb_advance(me, master, im, levs, ddd_ugwp, curdate, & - ! j1_tau, j2_tau, ddy_j1tau, ddy_j2tau, tau_sat, kdt ) - - if (first_qbo) kdtrest = kdt - first_qbo = .false. - curday_save = curday - hcurday_save= hcurday - endif - - ! tau_ngw = fw1_tau*tau_ngw + tau_sat*(1.-fw1_tau) - -! goto 111 -! if (mod(fhour,fhzero) == 0 .or. first_qbo) then - -! call tau_qbo_advance(me, master, im, levs, ddd_ugwp, curdate, & -! j1_tau, j2_tau, ddy_j1tau, ddy_j2tau, j1_qbo, j2_qbo, & -! ddy_j1qbo, ddy_j2qbo, tau_sat, tau_qbo, uqbo, ax_qbo, kdt ) - - -! if (me == master) then -! print *, ' curday_save first_qbo ', curday, curday_save, kdt -! print *, ' hcurdays ', hcurdate, float(hour)/24. -! print *, jdat(5), jdat(6), jdat(7), (kdt-1)*dtp/3600., ' calendar ' -!! print *, ' curday curday_ugwp first_qbo ', hcurday, first_qbo -!! print *, ' vay_tau-limb U' , maxval(uqbo), minval(uqbo) -!! print *, ' vay_tau-limb TS' , maxval(tau_sat), minval(tau_sat) -!! print *, ' vay_tau-limb TQ' , maxval(tau_qbo), minval(tau_qbo) -! endif - - -! if (first_qbo) kdtrest = kdt -! first_qbo = .false. -! curday_save = curday -! hcurday_save= hcurday -! endif - - - - -! if (mod(kdt, 720) == 0 .and. me == master ) then -! print *, ' vay_qbo_U' , maxval(uqbo), minval(uqbo) , kdt -! endif - -! wqbo = dtp/taurel -! do k =1, levs -!! sdexpz = wqbo*vert_qbo(k) -! sdexpz = 0.25*vert_qbo(k) -! do i=1, im -!! if (dexpy(i) > 0.0) then -! dforc = 0.25 -!! ugrs(i,k) = ugrs(i,k)*(1.-dforc) + dforc*uqbo(i,levs+1-k) -!! tgrs(i,k) = tgrs(i,k)*(1.-dforc) + dforc*tqbo(i,levs+1-k) -!! endif -! enddo -! enddo - -! 111 continue - - - call cires_ugwp_solv2_v1(im, levs, dtp, & - tgrs, ugrs, vgrs, q1, prsl, prsi, & - zmet, zmeti,prslk, xlat_d, sinlat, coslat, & - con_g, con_cp, con_rd, con_rv, con_omega, & - con_pi, con_fvirt, & - gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & - tauabs, wrms, trms, tau_ngw, me, master, kdt) - - if (me == master .and. kdt < 2) then - print * - write(6,*)'FV3GFS finished fv3_ugwp_solv2_v1 in ugwp_driver_v0 ' - write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' - print * - endif - - do k=1,levs - do i=1,im - gw_dtdt(i,k) = pngw*gw_dtdt(i,k) + pogw*Pdtdt(i,k) - gw_dudt(i,k) = pngw*gw_dudt(i,k) + pogw*Pdudt(i,k) - !+(uqbo(i,levs+1-k)-ugrs(i,k))/21600. - gw_dvdt(i,k) = pngw*gw_dvdt(i,k) + pogw*Pdvdt(i,k) - gw_kdis(i,k) = pngw*gw_kdis(i,k) ! + pogw*Pkdis(i,k) - enddo - enddo - - - - - if (pogw == 0.0) then -! zmtb = 0.; zogw =0. - tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 - du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 - endif - -! return - -!============================================================================= -! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving -! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" -!============================================================================= -! -! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies -!------------------------------------------------------------------------------ - -! ed_dudt(:,:) = 0.0 ; ed_dvdt(:,:) = 0.0 ; ed_dtdt(:,:) = 0.0 - - - -! call edmix_ugwp_v1(im, levs, dtp, & -! tgrs, ugrs, vgrs, q1, del, & -! prsl, prsi, phil, prslk, & -! gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & -! ed_dudt, ed_dvdt, ed_dTdt, -! me, master, kdt ) - -! do k=1,levs -! do i=1,im -! gw_dtdt(i,k) = gw_dtdt(i,k) + ed_dtdt(i,k)*pked -! gw_dvdt(i,k) = gw_dvdt(i,k) + ed_dvdt(i,k)*pked -! gw_dudt(i,k) = gw_dudt(i,k) + ed_dudt(i,k)*pked -! enddo -! enddo - - - end if ! do_ugwp_v1 - - end subroutine unified_ugwp_run !! @} !>@} From 9ebf28b79f34517647d63d63acfda5dd9ba47441 Mon Sep 17 00:00:00 2001 From: "valery.yudin" Date: Mon, 11 Jan 2021 03:24:22 -0500 Subject: [PATCH 179/274] physics/cires_tauamf_data.F90 ugwp-data --- physics/cires_tauamf_data.F90 | 256 ++++++++++++++++++++++++++++++++++ 1 file changed, 256 insertions(+) create mode 100644 physics/cires_tauamf_data.F90 diff --git a/physics/cires_tauamf_data.F90 b/physics/cires_tauamf_data.F90 new file mode 100644 index 000000000..5a0296d4c --- /dev/null +++ b/physics/cires_tauamf_data.F90 @@ -0,0 +1,256 @@ +module cires_tauamf_data + + use machine, only: kind_phys +!........................................................................................... +! tabulated GW-sources: GRACILE/Ern et al., 2018 and/or Resolved GWs from C384-Annual run +!........................................................................................... +implicit none + + integer :: ntau_d1y, ntau_d2t + real(kind=kind_phys), allocatable :: ugwp_taulat(:) + real(kind=kind_phys), allocatable :: tau_limb(:,:), days_limb(:) + logical :: flag_alloctau = .false. + character(len=255):: ugwp_taufile = 'ugwp_limb_tau.nc' + + public :: read_tau_amf, cires_indx_ugwp, tau_amf_interp + +contains + + subroutine read_tau_amf(me, master, errmsg, errflg) + + use netcdf + integer, intent(in) :: me, master + integer :: ncid, iernc, vid, dimid, status + integer :: k + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! Tabulated sources +! + + iernc=NF90_OPEN(trim(ugwp_taufile), nf90_nowrite, ncid) + + if(iernc.ne.0) then + write(errmsg,'(*(a))') "read_tau_amf: cannot open file_limb_tab data-file ", & + trim(ugwp_taufile) + print *, 'cannot open ugwp-v1 tau-file=',trim(ugwp_taufile) + errflg = 1 + return + else + + + status = nf90_inq_dimid(ncid, "lat", DimID) +! if (status /= nf90_noerr) call handle_err(status) +! + status = nf90_inquire_dimension(ncid, DimID, len =ntau_d1y ) + + status = nf90_inq_dimid(ncid, "days", DimID) + status = nf90_inquire_dimension(ncid, DimID, len =ntau_d2t ) + + if (me == master) print *, ntau_d1y, ntau_d2t, ' dimd of tau_ngw ugwp-v1 ' + if (ntau_d2t .le. 0 .or. ntau_d1y .le. 0) then + print *, 'ugwp-v1 tau-file=', trim(ugwp_taufile) + print *, ' ugwp-v1: ', 'ntau_d2t=',ntau_d2t, 'ntau_d2t=',ntau_d1y + stop + endif + + if (.not.allocated(ugwp_taulat)) allocate (ugwp_taulat(ntau_d1y )) + if (.not.allocated(days_limb)) allocate (days_limb(ntau_d2t)) + if (.not.allocated(tau_limb)) allocate (tau_limb(ntau_d1y, ntau_d2t )) + + iernc=nf90_inq_varid( ncid, 'DAYS', vid ) + iernc= nf90_get_var( ncid, vid, days_limb) + iernc=nf90_inq_varid( ncid, 'LATS', vid ) + iernc= nf90_get_var( ncid, vid, ugwp_taulat) + iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) + iernc= nf90_get_var( ncid, vid, tau_limb) + + iernc=nf90_close(ncid) + + endif + + end subroutine read_tau_amf + + subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j2tau) + + use machine, only: kind_phys + + implicit none +! +! + integer, intent(in) :: npts, me, master + real(kind=kind_phys) , dimension(npts), intent(in) :: dlat + + integer, dimension(npts), intent(inout) :: j1_tau, j2_tau + real(kind=kind_phys) , dimension(npts), intent(inout) :: w1_j1tau, w2_j2tau + +!locals + + integer :: i,j, j1, j2 + + + +! +! weights for tau_limb w1_j1tau, w2_j2tau +! + + + if (me == master) then + print * + print *, ' ugwp_tabulated files input ' +! print *, ' ugwp_taulat ', ugwp_taulat +! print *, ' days ', days_limb + print *, ' TAU-ugwp ', maxval(tau_limb)*1.e3, minval(tau_limb)*1.e3 + print * + endif +! + do j=1,npts + j2_tau(j) = ntau_d1y + do i=1,ntau_d1y + if (dlat(j) < ugwp_taulat(i)) then + j2_tau(j) = i + exit + endif + enddo + + + j2_tau(j) = min(j2_tau(j),ntau_d1y) + j1_tau(j) = max(j2_tau(j)-1,1) + + if (j1_tau(j) /= j2_tau(j) ) then + w2_j2tau(j) = (dlat(j) - ugwp_taulat(j1_tau(j))) & + / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) + + else + w2_j2tau(j) = 1.0 + endif + w1_j1tau(j) = 1.0 - w2_j2tau(j) + + enddo + + return + + if (me == master ) then + +223 format( 2x, 'vay-limb', I4, 5(2x, F10.3)) + print *, 'ugwp-v1 indx_ugwp ', size(dlat), ' npts ', npts + do j=1,npts + j1 = j1_tau(j) + j2 = j2_tau(j) + write(6,223) j, ugwp_taulat(j1), dlat(j), ugwp_taulat(j2), w2_j2tau(j), w1_j1tau(j) + enddo + print * + + endif + end subroutine cires_indx_ugwp + + subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, ddy_j2, tau_ddd) + + use machine, only: kind_phys + implicit none + +!input + integer, intent(in) :: me, master + integer, intent(in) :: im, idate(4) + real(kind=kind_phys), intent(in) :: fhour + + real(kind=kind_phys), intent(in), dimension(im) :: ddy_j1, ddy_j2 + integer , intent(in), dimension(im) :: j1_tau,j2_tau +!ouput + real(kind=kind_phys), dimension(im) :: tau_ddd +!locals + + integer :: i, j1, j2, it1, it2 , iday + integer :: ddd + real(kind=kind_phys) :: tx1, tx2, w1, w2, fddd +! +! define day of year ddd ..... from the old-fashioned "GFS-style" +! having idate[4] ??? +! + call gfs_idate_calendar(idate, fhour, ddd, fddd) + + it1 = 2 + do iday=1, ntau_d2t + if (fddd .lt. days_limb(iday) ) then + it2 = iday + exit + endif + enddo + + it2 = min(it2,ntau_d2t) + it1 = max(it2-1,1) + if (it2 > ntau_d2t ) then + print *, ' Error in time-interpolation for tau_amf_interp ' + print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t + print *, ' Error in time-interpolation see cires_tauamf_data.F90 ' + stop + endif + + w2 = (fddd-days_limb(it1))/(days_limb(it2)-days_limb(it1)) + w1 = 1.0-w2 + + do i=1, im + j1 = j1_tau(i) + j2 = j2_tau(i) + tx1 = tau_limb(j1, it1)*ddy_j1(i)+tau_limb(j2, it1)*ddy_j2(i) + tx2 = tau_limb(j1, it2)*ddy_j1(i)+tau_limb(j2, it2)*ddy_j2(i) + tau_ddd(i) = tx1*w1 + w2*tx2 + enddo + +! if(me == master) then +! print *, ' tau_amf_interp : ', fddd, ddd , ' DOY ' +! print *, ' tau_amf_maxmin : ' , maxval(tau_ddd)*1.e3, minval(tau_ddd)*1.e3 +! endif + + end subroutine tau_amf_interp + + subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) + + use machine, only: kind_phys + implicit none +! input + integer, intent(in) :: idate(4) + real(kind=kind_phys), intent(in) :: fhour +!out + integer, intent(out) :: ddd + real(kind=kind_phys), intent(out) :: fddd +! +!locals +! + real(kind=kind_phys) :: rinc(5), rjday + integer :: jdow, jdoy, jday + real(4) :: rinc4(5) + integer :: w3kindreal, w3kindint + + integer :: iw3jdn + integer :: jd1, jddd + + integer idat(8),jdat(8) + + + idat(1:8) = 0 + idat(1) = idate(4) + idat(2) = idate(2) + idat(3) = idate(3) + idat(5) = idate(1) + rinc(1:5) = 0. + rinc(2) = fhour +! get jdat + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4 = rinc + call w3movdat(rinc4, idat,jdat) + else + call w3movdat(rinc, idat,jdat) + endif + +!! jdate(8)- date and time (yr, mo, day, [tz], hr, min, sec) + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow, ddd, jday) + fddd = float(ddd) + jdat(5) / 24. + + end subroutine gfs_idate_calendar + +end module cires_tauamf_data From dc7f9542684d05290641d7533b16ece7632edf29 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 16 Jan 2021 05:48:44 -0700 Subject: [PATCH 180/274] Bugfixes in physics/shinhongvdif.F90 and physics/ysuvdif.F90: use assumed sizes for 3D tendency arrays --- physics/shinhongvdif.F90 | 2 +- physics/ysuvdif.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index 4032f1828..e0b775f1b 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -131,7 +131,7 @@ subroutine shinhongvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & ttnp real(kind=kind_phys), dimension(im, km, ntrac ) , & intent(inout) :: qtnp - real(kind=kind_phys), dimension(im,km) , & + real(kind=kind_phys), dimension(:,:) , & intent(inout) :: du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL ! 2D in integer, dimension(im) , & diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index 75c0b31d3..aa2980992 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -88,7 +88,7 @@ subroutine ysuvdif_run(im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & intent(inout) :: utnp,vtnp,ttnp real(kind=kind_phys), dimension( im,km,ntrac ) , & intent(inout) :: qtnp - real(kind=kind_phys), dimension(im,km) , & + real(kind=kind_phys), dimension(:,:) , & intent(inout) :: du3dt_PBL, dv3dt_PBL, dt3dt_PBL, dq3dt_PBL, do3dt_PBL ! !--------------------------------------------------------------------------------- From e7cd3069417df6e9b51cca1a38e5c6ab3aeccceb Mon Sep 17 00:00:00 2001 From: Michael Toy Date: Sun, 17 Jan 2021 01:38:41 +0000 Subject: [PATCH 181/274] Added new logical flag do_ugwp_v0_nst_only which allows non-stationary drag from ugwp_v0 to be run with GSL drag suite --- physics/unified_ugwp.F90 | 47 ++++++++++++++++++++++++++++----------- physics/unified_ugwp.meta | 24 ++++++++++++++++++++ 2 files changed, 58 insertions(+), 13 deletions(-) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 5c0604f86..a07e85202 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -25,6 +25,7 @@ !! The choice of schemes is activated at runtime by the following namelist options (boolean): !! do_ugwp_v0 -- activates V0 CIRES UGWP scheme - both orographic and non-stationary GWD !! do_ugwp_v0_orog_only -- activates V0 CIRES UGWP scheme - orographic GWD only +!! do_ugwp_v0_nst_only -- activates V0 CIRES UGWP scheme - non-stationary GWD only !! do_gsl_drag_ls_bl -- activates RAP/HRRR (GSL) large-scale GWD and blocking !! do_gsl_drag_ss -- activates RAP/HRRR (GSL) small-scale GWD !! do_gsl_drag_tofd -- activates RAP/HRRR (GSL) turbulent orographic drag @@ -75,9 +76,9 @@ module unified_ugwp subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, & - do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & - do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & - do_ugwp_v1_orog_only, errmsg, errflg) + do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + do_ugwp_v1, do_ugwp_v1_orog_only, errmsg, errflg) !---- initialization of unified_ugwp implicit none @@ -98,6 +99,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth logical, intent (in) :: do_ugwp logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & + do_ugwp_v0_nst_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, & do_gsl_drag_tofd, do_ugwp_v1, & do_ugwp_v1_orog_only @@ -136,11 +138,23 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & end if + ! Test to make sure that if ugwp_v0 non-stationary-only is selected that + ! ugwp_v1 is not also selected + if ( do_ugwp_v0_nst_only .and. (do_ugwp_v1.or.do_ugwp_v1_orog_only) ) then + + write(errmsg,'(*(a))') "Logic error: do_ugwp_v0_nst_only can only be & + &selected if both do_ugwp_v1 and do_ugwp_v1_orog_only are not & + &selected" + errflg = 1 + return + + end if + if (is_initialized) return - if ( do_ugwp_v0 ) then + if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) then ! if (do_ugwp .or. cdmbgwd(3) > 0.0) then (deactivate effect of do_ugwp) if (cdmbgwd(3) > 0.0) then call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & @@ -148,7 +162,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) else write(errmsg,'(*(a))') "Logic error: cires_ugwp_mod_init called but & - &do_ugwp_v0 is true and cdmbgwd(3) <= 0" + &do_ugwp_v0 or do_ugwp_v0_nst_only is true and cdmbgwd(3) <= 0" errflg = 1 return end if @@ -177,11 +191,13 @@ end subroutine unified_ugwp_init !! \htmlinclude unified_ugwp_finalize.html !! - subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v1,errmsg, errflg) + subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v0_nst_only, & + do_ugwp_v1,errmsg, errflg) implicit none ! - logical, intent (in) :: do_ugwp_v0, do_ugwp_v1 + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_nst_only, & + do_ugwp_v1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -191,7 +207,7 @@ subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v1,errmsg, errflg) if (.not.is_initialized) return - if ( do_ugwp_v0 ) call cires_ugwp_mod_finalize() + if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) call cires_ugwp_mod_finalize() if ( do_ugwp_v1 ) call cires_ugwp_finalize() @@ -234,8 +250,8 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & ldiag3d, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & - do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & - do_ugwp_v1_orog_only, gwd_opt, errmsg, errflg) + do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + do_ugwp_v1, do_ugwp_v1_orog_only, gwd_opt, errmsg, errflg) implicit none @@ -303,6 +319,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ! flags for choosing combination of GW drag schemes to run logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & + do_ugwp_v0_nst_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, & do_gsl_drag_tofd, do_ugwp_v1, & do_ugwp_v1_orog_only @@ -408,7 +425,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, end if - if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then + if ( do_ugwp_v0.or.do_ugwp_v0_orog_only.or.do_ugwp_v0_nst_only ) then do k=1,levs do i=1,im @@ -419,6 +436,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, enddo enddo + end if + + if ( do_ugwp_v0.or.do_ugwp_v0_orog_only ) then + if (cdmbgwd(1) > 0.0 .or. cdmbgwd(2) > 0.0) then ! Override nmtvr with nmtvr_temp = 14 for passing into gwdps_run if necessary @@ -466,7 +487,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ! ! ugwp_v0 non-stationary GW drag ! - if (do_ugwp_v0) then + if (do_ugwp_v0.or.do_ugwp_v0_nst_only) then if (cdmbgwd(3) > 0.0) then @@ -574,7 +595,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, enddo endif - end if ! do_ugwp_v0 + end if ! do_ugwp_v0.or.do_ugwp_v0_nst_only ! diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 675a68edd..f60bdc038 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -207,6 +207,14 @@ type = logical intent = in optional = F +[do_ugwp_v0_nst_only] + standard_name = do_ugwp_v0_nst_only + long_name = flag to activate ver 0 CIRES UGWP - non-stationary GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F [do_gsl_drag_ls_bl] standard_name = do_gsl_drag_ls_bl long_name = flag to activate GSL drag suite - large-scale GWD and blocking @@ -277,6 +285,14 @@ type = logical intent = in optional = F +[do_ugwp_v0_nst_only] + standard_name = do_ugwp_v0_nst_only + long_name = flag to activate ver 0 CIRES UGWP - non-stationary GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F [do_ugwp_v1] standard_name = do_ugwp_v1 long_name = flag to activate ver 1 CIRES UGWP @@ -1293,6 +1309,14 @@ type = logical intent = in optional = F +[do_ugwp_v0_nst_only] + standard_name = do_ugwp_v0_nst_only + long_name = flag to activate ver 0 CIRES UGWP - non-stationary GWD only + units = flag + dimensions = () + type = logical + intent = in + optional = F [do_gsl_drag_ls_bl] standard_name = do_gsl_drag_ls_bl long_name = flag to activate GSL drag suite - large-scale GWD and blocking From 0dfdd8d2c804ca3557cd5da23add23e916729e54 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 16 Jan 2021 20:05:58 -0700 Subject: [PATCH 182/274] Remove Diag%cldcov from physics/GFS_debug.F90, comment out other unused variables --- physics/GFS_debug.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index cbb1765f0..e3742a145 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -648,10 +648,9 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, do n=1,size(Diag%dq3dt(1,1,:)) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dq3dt_n ', Diag%dq3dt(:,:,n)) end do - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cldcov ', Diag%cldcov) + !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) + !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) + !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) end if if(Model%lradar) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%refl_10cm ', Diag%refl_10cm) From 8463f3ad8fa38cf0b944fcd8a48194b75f0e8222 Mon Sep 17 00:00:00 2001 From: "valery.yudin" Date: Wed, 20 Jan 2021 13:42:28 -0500 Subject: [PATCH 183/274] new GFS_phys_time_vary.fv3.F90; and new ugwp_common instead physcons --- physics/GFS_phys_time_vary.fv3.F90 | 50 +- physics/GFS_phys_time_vary.fv3.meta | 95 ++- physics/cires_tauamf_data.F90 | 63 +- physics/cires_ugwpv1_initialize.F90 | 253 ++++--- physics/cires_ugwpv1_module.F90 | 74 +- physics/cires_ugwpv1_oro.F90 | 1017 +++++++++++---------------- physics/cires_ugwpv1_solv2.F90 | 64 +- physics/cires_ugwpv1_sporo.F90 | 56 +- physics/cires_ugwpv1_triggers.F90 | 82 +-- physics/ugwpv1_gsldrag.F90 | 274 +++++--- physics/ugwpv1_gsldrag.meta | 128 ++-- 11 files changed, 1004 insertions(+), 1152 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 8f0bc50d9..04f191fdf 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -28,6 +28,9 @@ module GFS_phys_time_vary use iccninterp, only : read_cidata, setindxci, ciinterpol use gcycle_mod, only : gcycle + + use cires_tauamf_data, only: cires_indx_ugwp, read_tau_amf, tau_amf_interp + use cires_tauamf_data, only: tau_limb, days_limb, ugwp_taulat #if 0 !--- variables needed for calculating 'sncovr' @@ -58,6 +61,7 @@ subroutine GFS_phys_time_vary_init ( jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & + do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & nthrds, errmsg, errflg) implicit none @@ -77,6 +81,10 @@ subroutine GFS_phys_time_vary_init ( integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) + + logical, intent(in) :: do_ugwp_v1 + real(kind_phys), intent(inout) :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(inout) :: jindx1_tau(:), jindx2_tau(:) integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg @@ -100,6 +108,7 @@ subroutine GFS_phys_time_vary_init ( !$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & !$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & !$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & +!$OMP shared (do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau) & !$OMP private (ix,i,j) !$OMP sections @@ -176,7 +185,11 @@ subroutine GFS_phys_time_vary_init ( ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif - +!$OMP section +!> - Call tau_amf dats for ugwp_v1 + if (do_ugwp_v1) then + call read_tau_amf(me, master, errmsg, errflg) + endif !$OMP end sections ! Need an OpenMP barrier here (implicit in "end sections") @@ -211,7 +224,12 @@ subroutine GFS_phys_time_vary_init ( jindx2_ci, ddy_ci, xlon_d, & iindx1_ci, iindx2_ci, ddx_ci) endif - +!$OMP section +!> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs + if (do_ugwp_v1) then + call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & + ddy_j1tau, ddy_j2tau) + endif !$OMP section !--- initial calculation of maps local ix -> global i and j ix = 0 @@ -273,7 +291,8 @@ subroutine GFS_phys_time_vary_timestep_init ( lakefrac, min_seaice, min_lakeice, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, & tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & - cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, errmsg, errflg) + cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, & + do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) implicit none @@ -297,11 +316,19 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in) :: prsl(:,:) integer, intent(in) :: seed0 real(kind_phys), intent(inout) :: rann(:,:) + + logical, intent(in) :: do_ugwp_v1 + integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) + real(kind_phys), intent(inout) :: tau_amf(:) + ! For gcycle only integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil integer, intent(in) :: lsoil_lsm, kice, ialb, isot, ivegsrc character(len=*), intent(in) :: input_nml_file(:) + logical, intent(in) :: use_ufo, nst_anl, frac_grid + real(kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice, & xlat_d(:), xlon_d(:) real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), smois(:,:), sh2o(:,:), & @@ -310,7 +337,7 @@ subroutine GFS_phys_time_vary_timestep_init ( facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:), & zorli(:), zorll(:), zorlo(:), weasd(:), slope(:), snoalb(:), & canopy(:), vfrac(:), vtype(:), stype(:), shdmin(:), shdmax(:), & - snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) + snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -404,7 +431,13 @@ subroutine GFS_phys_time_vary_timestep_init ( iindx2_ci, ddx_ci, & levs, prsl, in_nm, ccn_nm) endif - + +!> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that resolve GW-activ + if (do_ugwp_v1) then + call tau_amf_interp(me, master, im, idate,fhour, & + jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf) + endif + !> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs if (nscyc > 0) then if (mod(kdt,nscyc) == 1) THEN @@ -479,7 +512,12 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (allocated(ciplin) ) deallocate(ciplin) if (allocated(ccnin) ) deallocate(ccnin) if (allocated(ci_pres) ) deallocate(ci_pres) - + + ! Deallocate UGWP-input arrays + if (allocated (ugwp_taulat)) deallocate(ugwp_taulat) + if (allocated (tau_limb)) deallocate (tau_limb) + if (allocated (days_limb)) deallocate(days_limb) + is_initialized = .false. end subroutine GFS_phys_time_vary_finalize diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 7ae6b4948..e20920686 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F + dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90 ######################################################################## [ccpp-arg-table] @@ -315,6 +315,48 @@ type = integer intent = in optional = F +[do_ugwp_v1] + standard_name = do_ugwp_v1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[jindx1_tau] + standard_name = index_interp_weight1_taungw + long_name = index1 for weight1 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = inout + optional = F +[jindx2_tau] + standard_name = index_interp_weight2_taungw + long_name = index2 for weight2 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = inout + optional = F +[ddy_j1tau] + standard_name = interp_weight1_taungw + long_name = interpolation weight1 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = real + intent = inout + kind = kind_phys + optional = F +[ddy_j2tau] + standard_name = interp_weight2_taungw + long_name = interpolation weight2 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = real + intent = inout + kind = kind_phys + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1335,6 +1377,57 @@ kind = kind_phys intent = inout optional = F +[do_ugwp_v1] + standard_name = do_ugwp_v1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[jindx1_tau] + standard_name = index_interp_weight1_taungw + long_name = index1 for weight1 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[jindx2_tau] + standard_name = index_interp_weight2_taungw + long_name = index2 for weight2 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = integer + intent = in + optional = F +[ddy_j1tau] + standard_name = interp_weight1_taungw + long_name = interpolation weight1 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = real + intent = in + kind = kind_phys + optional = F +[ddy_j2tau] + standard_name = interp_weight2_taungw + long_name = interpolation weight2 for tau NGWs + units = none + dimensions = (horizontal_loop_extent) + type = real + intent = in + kind = kind_phys + optional = F +[tau_amf] + standard_name = ngw_abs_momentum_flux + long_name = ngw_absolute_momentum_flux + units = various + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cires_tauamf_data.F90 b/physics/cires_tauamf_data.F90 index 5a0296d4c..e0d43e74e 100644 --- a/physics/cires_tauamf_data.F90 +++ b/physics/cires_tauamf_data.F90 @@ -2,7 +2,7 @@ module cires_tauamf_data use machine, only: kind_phys !........................................................................................... -! tabulated GW-sources: GRACILE/Ern et al., 2018 and/or Resolved GWs from C384-Annual run +! tabulated GW-sources: GRACILE/Ern et al., 2018 and/or Resolved GWs from C384-Annual run !........................................................................................... implicit none @@ -25,7 +25,6 @@ subroutine read_tau_amf(me, master, errmsg, errflg) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg -! Tabulated sources ! iernc=NF90_OPEN(trim(ugwp_taufile), nf90_nowrite, ncid) @@ -76,8 +75,7 @@ subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j use machine, only: kind_phys implicit none -! -! + integer, intent(in) :: npts, me, master real(kind=kind_phys) , dimension(npts), intent(in) :: dlat @@ -86,23 +84,7 @@ subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j !locals - integer :: i,j, j1, j2 - - - -! -! weights for tau_limb w1_j1tau, w2_j2tau -! - - - if (me == master) then - print * - print *, ' ugwp_tabulated files input ' -! print *, ' ugwp_taulat ', ugwp_taulat -! print *, ' days ', days_limb - print *, ' TAU-ugwp ', maxval(tau_limb)*1.e3, minval(tau_limb)*1.e3 - print * - endif + integer :: i,j, j1, j2 ! do j=1,npts j2_tau(j) = ntau_d1y @@ -119,33 +101,16 @@ subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j if (j1_tau(j) /= j2_tau(j) ) then w2_j2tau(j) = (dlat(j) - ugwp_taulat(j1_tau(j))) & - / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) - + / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) else w2_j2tau(j) = 1.0 endif w1_j1tau(j) = 1.0 - w2_j2tau(j) - enddo - return - - if (me == master ) then - -223 format( 2x, 'vay-limb', I4, 5(2x, F10.3)) - print *, 'ugwp-v1 indx_ugwp ', size(dlat), ' npts ', npts - do j=1,npts - j1 = j1_tau(j) - j2 = j2_tau(j) - write(6,223) j, ugwp_taulat(j1), dlat(j), ugwp_taulat(j2), w2_j2tau(j), w1_j1tau(j) - enddo - print * - - endif end subroutine cires_indx_ugwp - subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, ddy_j2, tau_ddd) - + subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, ddy_j2, tau_ddd) use machine, only: kind_phys implicit none @@ -165,7 +130,6 @@ subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, d real(kind=kind_phys) :: tx1, tx2, w1, w2, fddd ! ! define day of year ddd ..... from the old-fashioned "GFS-style" -! having idate[4] ??? ! call gfs_idate_calendar(idate, fhour, ddd, fddd) @@ -196,12 +160,7 @@ subroutine tau_amf_interp(me, master, im, idate, fhour, j1_tau,j2_tau, ddy_j1, d tx2 = tau_limb(j1, it2)*ddy_j1(i)+tau_limb(j2, it2)*ddy_j2(i) tau_ddd(i) = tx1*w1 + w2*tx2 enddo - -! if(me == master) then -! print *, ' tau_amf_interp : ', fddd, ddd , ' DOY ' -! print *, ' tau_amf_maxmin : ' , maxval(tau_ddd)*1.e3, minval(tau_ddd)*1.e3 -! endif - + end subroutine tau_amf_interp subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) @@ -235,22 +194,20 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd) idat(5) = idate(1) rinc(1:5) = 0. rinc(2) = fhour -! get jdat +! call w3kind(w3kindreal,w3kindint) if(w3kindreal==4) then rinc4 = rinc call w3movdat(rinc4, idat,jdat) else call w3movdat(rinc, idat,jdat) - endif - -!! jdate(8)- date and time (yr, mo, day, [tz], hr, min, sec) + endif +! jdate(8)- date and time (yr, mo, day, [tz], hr, min, sec) jdow = 0 jdoy = 0 jday = 0 call w3doxdat(jdat,jdow, ddd, jday) - fddd = float(ddd) + jdat(5) / 24. - + fddd = float(ddd) + jdat(5) / 24. end subroutine gfs_idate_calendar end module cires_tauamf_data diff --git a/physics/cires_ugwpv1_initialize.F90 b/physics/cires_ugwpv1_initialize.F90 index 1050da194..ad39def17 100644 --- a/physics/cires_ugwpv1_initialize.F90 +++ b/physics/cires_ugwpv1_initialize.F90 @@ -13,41 +13,83 @@ module ugwp_common ! use machine, only : kind_phys -! use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & -! rv => con_rv, cpd => con_cp, fv => con_fvirt,& -! arad => con_rerth + implicit none - - real(kind=kind_phys), parameter :: grav =9.81, cpd = 1004. - real(kind=kind_phys), parameter :: rd = 287.0 , rv =461.5 - real(kind=kind_phys), parameter :: grav2 = grav + grav - real(kind=kind_phys), parameter :: rgrav = 1.0/grav, rgrav2= rgrav*rgrav + + real(kind=kind_phys) :: pi, pi2, pih, rad_to_deg, deg_to_rad + real(kind=kind_phys) :: arad, p0s + real(kind=kind_phys) :: grav, grav2, rgrav, rgrav2 + real(kind=kind_phys) :: cpd, rd, rv, fv + real(kind=kind_phys) :: rdi, rcpd, rcpd2 + + real(kind=kind_phys) :: gor, gr2, grcp, gocp, rcpdl, grav2cpd + real(kind=kind_phys) :: bnv2min, bnv2max + real(kind=kind_phys) :: dw2min, velmin, minvel + real(kind=kind_phys) :: omega1, omega2, omega3 + real(kind=kind_phys) :: hpscale, rhp, rhp2, rh4, rhp4, khp, hpskm + real(kind=kind_phys) :: mkzmin, mkz2min, mkzmax, mkz2max, cdmin + real(kind=kind_phys) :: rcpdt - real(kind=kind_phys), parameter :: fv = rv/rd - 1.0 - real(kind=kind_phys), parameter :: rdi = 1.0 / rd, rcpd = 1./cpd, rcpd2 = 0.5/cpd - real(kind=kind_phys), parameter :: gor = grav/rd - real(kind=kind_phys), parameter :: gr2 = grav*gor - real(kind=kind_phys), parameter :: grcp = grav*rcpd, gocp = grcp - real(kind=kind_phys), parameter :: rcpdl = cpd*rgrav ! 1/[g/cp] == cp/g - real(kind=kind_phys), parameter :: grav2cpd = grav*grcp ! g*(g/cp)= g^2/cp - - real(kind=kind_phys), parameter :: pi = 4.*atan(1.0), pi2 = 2.*pi, pih = .5*pi - real(kind=kind_phys), parameter :: rad_to_deg=180.0/pi, deg_to_rad=pi/180.0 - - real(kind=kind_phys), parameter :: arad = 6370.e3 +! real(kind=kind_phys), parameter :: grav2 = grav + grav +! real(kind=kind_phys), parameter :: rgrav = 1.0/grav, rgrav2= rgrav*rgrav +! real(kind=kind_phys), parameter :: rdi = 1.0 / rd, rcpd = 1./cpd, rcpd2 = 0.5/cpd +! real(kind=kind_phys), parameter :: gor = grav/rd, rcpdt = 1./(cp*dtp) + +! real(kind=kind_phys), parameter :: gr2 = grav*gor +! real(kind=kind_phys), parameter :: grcp = grav*rcpd, gocp = grcp +! real(kind=kind_phys), parameter :: rcpdl = cpd*rgrav ! 1/[g/cp] == cp/g +! real(kind=kind_phys), parameter :: grav2cpd = grav*grcp ! g*(g/cp)= g^2/cp +! real(kind=kind_phys), parameter :: pi2 = 2.*pi, pih = .5*pi +! real(kind=kind_phys), parameter :: rad_to_deg=180.0/pi, deg_to_rad=pi/180.0 ! - real(kind=kind_phys), parameter :: bnv2min = (pi2/1800.)*(pi2/1800.) - real(kind=kind_phys), parameter :: bnv2max = (pi2/30.)*(pi2/30.) - - real(kind=kind_phys), parameter :: dw2min=1.0, velmin=sqrt(dw2min), minvel = 0.5 - real(kind=kind_phys), parameter :: omega1 = pi2/86400. - real(kind=kind_phys), parameter :: omega2 = 2.*omega1, omega3 = 3.*omega1 - real(kind=kind_phys), parameter :: hpscale= 7000., rhp=1./hpscale, rhp2=.5*rhp, rh4 = 0.25*rhp - real(kind=kind_phys), parameter :: mkzmin = pi2/80.0e3, mkz2min = mkzmin*mkzmin - real(kind=kind_phys), parameter :: mkzmax = pi2/500., mkz2max = mkzmax*mkzmax - real(kind=kind_phys), parameter :: cdmin = 2.e-2/mkzmax +! real(kind=kind_phys), parameter :: bnv2min = (pi2/1800.)*(pi2/1800.) +! real(kind=kind_phys), parameter :: bnv2max = (pi2/30.)*(pi2/30.) +! real(kind=kind_phys), parameter :: dw2min=1.0, velmin=sqrt(dw2min), minvel = 0.5 +! real(kind=kind_phys), parameter :: omega1 = pi2/86400., omega2 = 2.*omega1, omega3 = 3.*omega1 +! +! real(kind=kind_phys), parameter :: hpscale= 7000., rhp=1./hpscale, rhp2=.5*rhp, rh4 = 0.25*rhp +! real(kind=kind_phys), parameter :: mkzmin = pi2/80.0e3, mkz2min = mkzmin*mkzmin +! real(kind=kind_phys), parameter :: mkzmax = pi2/500., mkz2max = mkzmax*mkzmax +! real(kind=kind_phys), parameter :: cdmin = 2.e-2/mkzmax +! real(kind=kind_phys), parameter :: pi = 4.*atan(1.0), +! real(kind=kind_phys), parameter :: grav =9.81, cpd = 1004. +! real(kind=kind_phys), parameter :: rd = 287.0 , rv =461.5 +! real(kind=kind_phys), parameter :: fv = rv/rd - 1.0 +! real(kind=kind_phys), parameter :: arad = 6370.e3 end module ugwp_common + + subroutine init_nazdir(naz, xaz, yaz) + + use machine, only : kind_phys + use ugwp_common, only : pi2 + + implicit none + + integer :: naz + real(kind=kind_phys), dimension(naz) :: xaz, yaz + integer :: idir + real(kind=kind_phys) :: phic, drad + + drad = pi2/float(naz) + if (naz.ne.4) then + do idir =1, naz + Phic = drad*(float(idir)-1.0) + xaz(idir) = cos(Phic) + yaz(idir) = sin(Phic) + enddo + else +! if (naz.eq.4) then + xaz(1) = 1.0 !E + yaz(1) = 0.0 + xaz(2) = 0.0 + yaz(2) = 1.0 !N + xaz(3) =-1.0 !W + yaz(3) = 0.0 + xaz(4) = 0.0 + yaz(4) =-1.0 !S + endif + end subroutine init_nazdir ! ! !=================================================== @@ -55,21 +97,14 @@ end module ugwp_common !Part-1 init => wave dissipation + RFriction ! !=================================================== - subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & - me, master) -! -! ccpp-damn con_pi !!! -! -!non-ccpp subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) -!non-ccpp use ugwp_common, only : pih - + subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) +! use machine , only : kind_phys - + use ugwp_common, only : pih, pi implicit none integer , intent(in) :: me, master integer , intent(in) :: levs - real(kind=kind_phys), intent(in) :: con_pi real(kind=kind_phys), intent(in) :: zkm(levs), pmb(levs) ! in km-Pa real(kind=kind_phys), intent(out), dimension(levs+1) :: kvg, ktg, krad, kion ! @@ -94,15 +129,11 @@ subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & real(kind=kind_phys), parameter :: zdrag = 100. real(kind=kind_phys), parameter :: zgrow = 50. ! - real(kind=kind_phys) :: vumol, mumol, keddy, ion_drag + real(kind=kind_phys) :: vumol, mumol, keddy, ion_drag real(kind=kind_phys) :: rf_fv3, rtau_fv3, ptop, pih_dlog ! real(kind=kind_phys) :: ae1 ,ae2 ! -! ccpp con_pi -! - real(kind=kind_phys) :: pih - pih = 0.5*con_pi ptop = pmb(levs) rtau_fv3 = 1./86400./tau_alp @@ -141,14 +172,14 @@ subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & kvg(k) = kvg(k-1) ktg(k) = ktg(k-1) - if (me == master) then - write(6, * ) ' zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) ... init_global_gwdis' - do k=1, levs, 1 - write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k), pmb(k) - enddo - endif -! - 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) +! if (me == master) then +! write(6, * ) ' zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) ... init_global_gwdis' +! do k=1, levs, 1 +! write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k), pmb(k) +! enddo +! endif +! +! 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) end subroutine init_global_gwdis ! @@ -161,7 +192,7 @@ end subroutine init_global_gwdis ! !========================================================================= module ugwp_oro_init - use machine , only : kind_phys + use machine , only : kind_phys use ugwp_common, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi use ugwp_common, only : mkzmin, mkz2min implicit none @@ -182,6 +213,7 @@ module ugwp_oro_init character(len=8) :: strver = 'gfs_2018' character(len=8) :: strbase = 'gfs_2018' + real(kind=kind_phys), parameter :: rimin=-10., ric=0.25 real(kind=kind_phys), parameter :: frmax=10., frc =1.0, frmin =0.01 @@ -190,9 +222,10 @@ module ugwp_oro_init real(kind=kind_phys), parameter :: efmin=0.5, efmax=10.0 real(kind=kind_phys), parameter :: rlolev=50000.0 - integer,parameter :: mdir = 8 - real(kind=kind_phys), parameter :: fdir=.5*mdir/pi - + integer, parameter :: mdir = 8 + real(kind=kind_phys), parameter :: fdir=mdir/(8.*atan(1.0)) + real(kind=kind_phys), parameter :: zpgeo=2.*atan(1.0) + integer nwdir(mdir) data nwdir/6,7,5,8,2,3,1,4/ save nwdir @@ -202,14 +235,14 @@ module ugwp_oro_init real(kind=kind_phys), parameter :: fcrit_gfs = 0.7, fcrit_v1 = 0.7 real(kind=kind_phys), parameter :: fcrit_mtb = 0.7 - real(kind=kind_phys), parameter :: zbr_pi = (1.0/2.0)*pi - real(kind=kind_phys), parameter :: zbr_ifs = 0.5*pi + real(kind=kind_phys), parameter :: zbr_pi = zpgeo + real(kind=kind_phys), parameter :: zbr_ifs = zpgeo ! real(kind=kind_phys), parameter :: kxoro=6.28e-3/200. ! real(kind=kind_phys), parameter :: coro = 0.0 - integer,parameter :: nridge=2 + integer,parameter :: nridge=2 real(kind=kind_phys), parameter :: sigma_std=1./100., gamm_std=1.0 real(kind=kind_phys) :: cdmb ! scale factors for mtb @@ -291,8 +324,10 @@ end module ugwp_oro_init ! !========================================================================= module ugwp_conv_init + use machine , only : kind_phys - use cires_ugwpv1_triggers, only :init_nazdir + + implicit none real(kind=kind_phys) :: eff_con ! scale factors for conv GWs integer :: nwcon ! number of waves @@ -313,17 +348,9 @@ module ugwp_conv_init real(kind=kind_phys), allocatable :: xaz_conv(:), yaz_conv(:) contains ! - subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & - con_pi, arad, lonr, kxw) -! -! non-ccpp with use ugwp_common -! -! subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & -! lonr, kxw) + subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) ! -! use ugwp_common, only : pi2, arad - - + use ugwp_common, only : pi2, arad implicit none @@ -333,7 +360,6 @@ subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & ! ! ccpp ! - real(kind=kind_phys) :: con_pi, arad real(kind=kind_phys) :: kxw, effac real(kind=kind_phys) :: work1 = 0.5 @@ -345,7 +371,7 @@ subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & nstcon = nstoch eff_con = effac - con_dlength = 2.0*con_pi*arad/float(lonr) + con_dlength = pi2*arad/float(lonr) ! ! allocate & define spectra in "selected direction": "dc" "ch(nwaves)" ! @@ -370,7 +396,7 @@ subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & snorm = sum(spf_conv) spf_conv = spf_conv/snorm*1.5 - call init_nazdir(con_pi, nazdir, xaz_conv, yaz_conv) + call init_nazdir(nazdir, xaz_conv, yaz_conv) end subroutine init_conv_gws @@ -383,7 +409,8 @@ end module ugwp_conv_init module ugwp_fjet_init use machine , only : kind_phys - use cires_ugwpv1_triggers, only :init_nazdir + + implicit none real(kind=kind_phys) :: eff_fj ! scale factors for conv GWs @@ -401,18 +428,14 @@ module ugwp_fjet_init real(kind=kind_phys), allocatable :: xaz_fjet(:), yaz_fjet(:) contains - subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, & - con_pi, lonr, kxw) -! non-ccpp -! -! subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) -! use ugwp_common, only : pi2, arad + subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac,lonr, kxw) + + use ugwp_common, only : pi2, arad implicit none integer :: nwaves, nazdir, nstoch integer :: lonr - real(kind=kind_phys) :: con_pi real(kind=kind_phys) :: kxw, effac , chk integer :: k @@ -433,7 +456,7 @@ subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, & ch_fjet(k) = chk spf_fjet(k) = 1.0 enddo - call init_nazdir(con_pi, nazdir, xaz_fjet, yaz_fjet) + call init_nazdir(nazdir, xaz_fjet, yaz_fjet) end subroutine init_fjet_gws @@ -444,8 +467,8 @@ end module ugwp_fjet_init ! module ugwp_okw_init !========================================================================= - use machine , only : kind_phys - use cires_ugwpv1_triggers, only :init_nazdir + use machine , only : kind_phys + implicit none real(kind=kind_phys) :: eff_okw ! scale factors for conv GWs @@ -463,17 +486,15 @@ module ugwp_okw_init contains ! - subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, & - con_pi, lonr, kxw) + -! subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) -! use ugwp_common, only : pi2, arad + subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) + use ugwp_common, only : pi2, arad implicit none integer :: nwaves, nazdir, nstoch integer :: lonr - real(kind=kind_phys) :: con_pi real(kind=kind_phys) :: kxw, effac , chk integer :: k @@ -493,10 +514,8 @@ subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, & ch_okwp(k) = chk spf_okwp(k) = 1. enddo - - call init_nazdir(con_pi, nazdir, xaz_okwp, yaz_okwp) -! non-ccpp -! call init_nazdir(nazdir, xaz_okwp, yaz_okwp) + + call init_nazdir(nazdir, xaz_okwp, yaz_okwp) ! end subroutine init_okw_gws @@ -557,10 +576,11 @@ end module ugwp_lsatdis_init ! ! module ugwp_wmsdis_init + use machine , only : kind_phys use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, omega2 use ugwp_common, only : bnv2max, bnv2min, minvel - use ugwp_common, only : mkzmin, mkz2min, mkzmax, mkz2max, cdmin + use ugwp_common, only : mkzmin, mkz2min, mkzmax, mkz2max, ucrit => cdmin implicit none @@ -569,7 +589,7 @@ module ugwp_wmsdis_init real(kind=kind_phys), parameter :: gptwo=2.0 - real(kind=kind_phys) , parameter :: bnfix = pi2/300., bnfix2= bnfix * bnfix + real(kind=kind_phys) , parameter :: bnfix = 6.28/300., bnfix2= bnfix * bnfix real(kind=kind_phys) , parameter :: bnfix4 = bnfix2 * bnfix2 real(kind=kind_phys) , parameter :: bnfix3 = bnfix2 * bnfix ! @@ -577,7 +597,6 @@ module ugwp_wmsdis_init ! integer , parameter :: iazidim=4 ! number of azimuths integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum - real(kind=kind_phys) , parameter :: ucrit=cdmin real(kind=kind_phys) , parameter :: zcimin = 2.5 real(kind=kind_phys) , parameter :: zcimax = 125.0 @@ -684,13 +703,13 @@ subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, allocate ( zcosang(nazd), zsinang(nazd) ) allocate (lzmet(nwav), czmet(nwav), mkzmet(nwav), dczmet(nwav), dmkz(nwav) ) - if (me == master) then - print *, 'ugwp_v1/v0: init_gw_wmsdis_control ' +! if (me == master) then +! print *, 'ugwp_v1/v0: init_gw_wmsdis_control ' ! - print *, 'ugwp_v1/v0: WMS_DIS launch layer ', ilaunch - print *, 'ugwp_v1/v0: WMS_DIS tot_mflux in mpa', tamp_mpa*1000. - print *, 'ugwp_v1/v0: WMS_DIS lhmet in km ' , lhmet*1.e-3 - endif +! print *, 'ugwp_v1/v0: WMS_DIS launch layer ', ilaunch +! print *, 'ugwp_v1/v0: WMS_DIS tot_mflux in mpa', tamp_mpa*1000. +! print *, 'ugwp_v1/v0: WMS_DIS lhmet in km ' , lhmet*1.e-3 +! endif zpexp = gptwo * 0.5 ! gptwo=2 , zpexp = 1. @@ -763,13 +782,16 @@ subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, enddo zdx = (zci(nwav)-zci(1))/ real(nwav-1) - do inc=1, nwav + do inc=1, nwav zdci(inc) = zdx - enddo + enddo - cstar = bnfix/zms - rcstar = 1./cstar - + cstar = bnfix/zms + rcstar = 1./cstar + ENDIF ! if (version == 1) then + + RETURN +!=================== Diag prints after return ==================== if (me == master) then print * print *, 'ugwp_v0: zcimin=' , zcimin @@ -788,15 +810,16 @@ subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, print * nslope3=nslope+3.0 - do inc=1, nwav - zcin =zci(inc)*rcstar - fpc = rcstar*(zcin*zcin)/(1.+ zcin**nslope3) - fpc_dc = fpc * zdci(inc) - write(6,111) inc, zci(inc), zdci(inc),ucrit, fpc, fpc_dc, 6.28e-3/bnfix*zci(inc) - enddo + do inc=1, nwav + zcin =zci(inc)*rcstar + fpc = rcstar*(zcin*zcin)/(1.+ zcin**nslope3) + fpc_dc = fpc * zdci(inc) + write(6,111) inc, zci(inc), zdci(inc),ucrit, fpc, fpc_dc, 6.28e-3/bnfix*zci(inc) + enddo endif - ENDIF ! if (version == 1) then + + 111 format( 'wms-zci', i4, 7 (3x, F8.3)) end subroutine initsolv_wmsdis diff --git a/physics/cires_ugwpv1_module.F90 b/physics/cires_ugwpv1_module.F90 index eb740c7eb..13b7752a5 100644 --- a/physics/cires_ugwpv1_module.F90 +++ b/physics/cires_ugwpv1_module.F90 @@ -10,7 +10,7 @@ module cires_ugwpv1_module ! ! use machine, only : kind_phys - use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4 + use ugwp_common, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, rhp4, khp, hpskm use ugwp_wmsdis_init, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar use ugwp_wmsdis_init, only : tau_min, tamp_mpa @@ -22,6 +22,7 @@ module cires_ugwpv1_module logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver integer, parameter :: idebug_gwrms=0 ! control for diag computaions pw wind-temp GW-rms and MF fluxs logical, parameter :: do_adjoro = .false. + real(kind=kind_phys), parameter :: max_kdis = 450. ! 400 m2/s real(kind=kind_phys), parameter :: max_axyz = 450.e-5 ! 400 m/s/day real(kind=kind_phys), parameter :: max_eps = max_kdis*4.e-4 ! max_kdis*BN2 @@ -39,15 +40,8 @@ module cires_ugwpv1_module real(kind=kind_phys), parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw real(kind=kind_phys), parameter :: iPr_turb =1./3., iPr_mol =1.95 - - real(kind=kind_phys), parameter :: hps = hpscale - real(kind=kind_phys), parameter :: hpskm = hps/1000. -! - real(kind=kind_phys), parameter :: rhp1=1./hps, rh2=0.5*rhp1, rhp4 = rh2*rh2 - real(kind=kind_phys), parameter :: khp = 0.287*rhp1 ! R/Cp/Hp - real(kind=kind_phys), parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model - real(kind=kind_phys), parameter :: linsat = 1.00 + real(kind=kind_phys), parameter :: linsat = 1.00 real(kind=kind_phys), parameter :: linsat2 = linsat*linsat real(kind=kind_phys), parameter :: ricrit = 0.25 @@ -75,41 +69,26 @@ module cires_ugwpv1_module real(kind=kind_phys) :: knob_ugwp_taumin = 0.25e-3 real(kind=kind_phys) :: knob_ugwp_tauamp = 7.75e-3 ! range from 30.e-3 to 3.e-3 ( space-borne values) real(kind=kind_phys) :: knob_ugwp_lhmet = 200.e3 ! 200 km + logical :: knob_ugwp_tlimb = .true. character(len=8) :: knob_ugwp_orosolv='pss-1986' - real(kind=kind_phys) :: kxw = pi2/200.e3 ! single horizontal wavenumber of ugwp schemes -! -! tune-ups for qbo -! -! real(kind=kind_phys) :: knob_ugwp_qbolev = 500.e2 ! fixed pressure layer in Pa for "launch" of conv-GWs -! real(kind=kind_phys) :: knob_ugwp_qbosin = 1.86 ! semiannual cycle of tau_qbo_src in radians -! real(kind=kind_phys) :: knob_ugwp_qbotav = 2.285e-3 ! additional to "climate" for QBO-sg forcing -! real(kind=kind_phys) :: knob_ugwp_qboamp = 1.191e-3 ! additional to "climate" QBO -! real(kind=kind_phys) :: knob_ugwp_qbotau = 10. ! relaxation time scale in days -! real(kind=kind_phys) :: knob_ugwp_qbolat = 15. ! qbo-domain for extra-forcing -! real(kind=kind_phys) :: knob_ugwp_qbowid = 7.5 ! qbo-attenuation for extra-forcing -! character(len=250) :: knob_ugwp_qbofile='qbo_zmf_2009_2018.nc'! -! character(len=250) :: knob_ugwp_amffile='mern_zmf_amf_12month.nc' -! character(len=255) :: file_limb_tab='ugwp_limb_tau.nc' -! integer, parameter :: ny_tab=73, nt_tab=14 -! real(kind=kind_phys), parameter :: rdy_tab = 1./2.5, rdd_tab = 1./30. -! integer :: nqbo_d1y, nqbo_d2z, nqbo_d3t - + real(kind=kind_phys) :: kxw = 6.28/200.e3 ! single horizontal wavenumber of ugwp schemes +! integer :: ugwp_azdir integer :: ugwp_stoch integer :: ugwp_src integer :: ugwp_nws + real(kind=kind_phys) :: ugwp_effac - ! integer :: launch_level = 55 ! namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & knob_ugwp_stoch, knob_ugwp_effac,knob_ugwp_doaxyz, knob_ugwp_doheat, knob_ugwp_dokdis, & knob_ugwp_ndx4lh, knob_ugwp_version, knob_ugwp_palaunch, knob_ugwp_nslope, knob_ugwp_lzmax, & - knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & + knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & knob_ugwp_tlimb, knob_ugwp_orosolv ! @@ -119,17 +98,11 @@ module cires_ugwpv1_module real(kind=kind_phys), allocatable :: kvg(:), ktg(:), krad(:), kion(:) real(kind=kind_phys), allocatable :: zkm(:), pmb(:) real(kind=kind_phys), allocatable :: rfdis(:), rfdist(:) - integer :: levs_rf +! +! RF-not active now +! + integer :: levs_rf real(kind=kind_phys) :: pa_rf, tau_rf -!........................................................................................... -! tabulated GW-sources: GRACILE/Ern et al., 2018 and/or Resolved GWs from C384-Annual run -!........................................................................................... - -! integer :: ntau_d1y, ntau_d2t -! real(kind=kind_phys), allocatable :: ugwp_taulat(:) -! real(kind=kind_phys), allocatable :: tau_limb(:,:), days_limb(:) -! logical :: flag_alloctau = .false. -! character(len=255):: ugwp_taufile = 'ugwp_limb_tau.nc' ! ! simple modulation of tau_ngw by the total rain/precip strength ! @@ -300,11 +273,10 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & print *, 'cires_ugwpv1 klev_ngw =', launch_level, nint(pmb(launch_level)) endif ! -! Part-1 :init_global_gwdis again "damn"-con_pi -! call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) +! Part-1 :init_global_gwdis again "damn"-con_p ! - call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & - me, master) + call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion, me, master) + ! ! Part-2 :init_SOURCES_gws ! @@ -321,30 +293,30 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & IF (do_physb_gwsrcs) THEN - if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init_modv1 ' +! if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init_modv1 ' if (knob_ugwp_wvspec(4) > 0) then ! okw call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & knob_ugwp_stoch(4), knob_ugwp_effac(4), & - con_pi, lonr, kxw ) - if (me == master) print *, ' init_okw_gws ' + lonr, kxw ) +! if (me == master) print *, ' init_okw_gws ' endif if (knob_ugwp_wvspec(3) > 0) then ! fronts call init_fjet_gws(knob_ugwp_wvspec(3), knob_ugwp_azdir(3), & knob_ugwp_stoch(3), knob_ugwp_effac(3), & - con_pi, lonr, kxw ) - if (me == master) print *, ' init_fjet_gws ' + lonr, kxw ) +! if (me == master) print *, ' init_fjet_gws ' endif if (knob_ugwp_wvspec(2) > 0) then ! conv : con_pi, con_rerth, call init_conv_gws(knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & knob_ugwp_stoch(2), knob_ugwp_effac(2), & - con_pi, con_rerth, lonr, kxw ) - if (me == master) & - print *, ' init_convective GWs ', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) + lonr, kxw ) +! if (me == master) & +! print *, ' init_convective GWs ', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) endif diff --git a/physics/cires_ugwpv1_oro.F90 b/physics/cires_ugwpv1_oro.F90 index 6913b4c0e..46191f404 100644 --- a/physics/cires_ugwpv1_oro.F90 +++ b/physics/cires_ugwpv1_oro.F90 @@ -3,7 +3,6 @@ module cires_ugwpv1_oro contains subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & - grav, con_omega, rd, cpd, rv, pi, arad, fv, & xlatd, sinlat, coslat, sparea, & cdmbgwd, hprime, oc, oa4, clx4, theta, sigmad, & gammad, elvmaxd, sgh30, kpbl, & @@ -13,18 +12,6 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_ofdcol, dv_ofdcol, errmsg,errflg ) - -! call orogw_v1 (im, levs, lonr, me, master,dtp, kdt, do_tofd, & -! con_g, con_omega, con_rd, con_cp, con_rv,con_pi, con_rerth, con_fvirt, & -! xlat_d, sinlat, coslat, area, & -! cdmbgwd(1:2), hprime, oc, oa4, clx, theta, & -! sigma, gamma, elvmax, varss, kpbl, & -! ugrs, vgrs, tgrs, q1, prsi,del,prsl,prslk, zmeti, zmet, & -! Pdvdt, Pdudt, Pdtdt, Pkdis, DUSFCg, DVSFCg,rdxzb, & -! zobl, zlwb, zogw, tau_ogw, dudt_ogw, dvdt_ogw, & -! dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, & -! du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & -! du_ofdcol, dv_ofdcol, errmsg,errflg ) !--------------------------------------------------------------------------- ! ugwp_v1: orogw_v1 following recent updates of Lott & Miller 1997 @@ -42,19 +29,21 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & ! cdmbgwd(1) = 1 for all resolutions, number of hills control SA-effects ! cdmbgwd(2) = 1 ...............number of hills control SA-effects ! -! (c) cleff = pi2/(nk*dx) lheff = nk*dx (nk = 6,4,2, 1) +! (c) cleff = pi2/(nk*dx) lheff = nk*dx (nk = 6,4,2, 1) ! alternative lheff = min( dogw=hprime/sigma*gamma, dx) ! we still not use the "broad spectral solver" ! -! (d) hefff = (nsig * hprime -znlk)/nsig, orchestrating MB and OGW +! (d) hefff = (nsig * hprime -znlk)/nsig, orchestrating MB and OGW ! -! (e) for linsat-solver "eddy" damping Ked = Ked * Nhills, scale-aware -! amplification of the momentum deposition for low-res simulations +! (e) for linsat-solver the total "eddy" damping Ked = Ked * Nhills, +! scale-aware amplification of the momentum deposition for low-res runs !---------------------------------------- use machine , only : kind_phys - use ugwp_common, only : dw2min, velmin - + use ugwp_common, only : dw2min, velmin, grav, omega1, rd, cpd, rv, pi, arad, fv + use ugwp_common, only : rcpdt, grav2, rgrav, rcpd, rcpd2 + use ugwp_common, only : rad_to_deg, deg_to_rad, pi2, pih, rdi, gor, grcp, gocp, gr2, bnv2min + use ugwp_oro_init, only : rimin, ric, efmin, efmax, & hpmax, hpmin, sigfaci => sigfac, & dpmin, minwnd, hminmt, hncrit, & @@ -65,8 +54,6 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & n_tofd, ze_tofd, ztop_tofd use cires_ugwpv1_module, only : kxw, max_kdis, max_axyz - -! use cires_ugwpv1_sporo, only : oro_spectral_solver !---------------------------------------- implicit none @@ -103,9 +90,7 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & real(kind=kind_phys), intent(in) :: hprime(im), oc(im), oa4(im,4), & clx4(im,4), theta(im), & sigmad(im), gammad(im), elvmaxd(im) - - real(kind=kind_phys), intent(in) :: grav, con_omega, rd, cpd, rv, pi, arad, fv - +! real(kind=kind_phys), intent(in) :: sgh30(im) real(kind=kind_phys), intent(in), dimension(im,km) :: & @@ -134,17 +119,6 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! -!--------------------------------------------------------------------- -! # of permissible sub-grid orography hills for "any" resolution < 25 -! correction for "elliptical" hills based on shilmin-area =sgrid/25 -! 4.*gamma*b_ell*b_ell >= shilmin -! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min -! gamma_min = 1/4*shilmin/sso_min/sso_min -!23.01.2019: cdmb = 4.*192/768_c192=1 x 0.5 -! 192: cdmbgwd = 0.5, 2.5 -! cleff = 2.5*0.5e-5 * sqrt(192./768.) => lh_eff = 1004. km -! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective OGW-lin -!--------------------------------------------------------------------- ! ! locals vars for SSO ! @@ -208,14 +182,14 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & real(kind=kind_phys) :: scork, rscor, hd, fro, sira real(kind=kind_phys) :: dtaux, dtauy, zmetp, zmetk - real(kind=kind_phys) :: grav2, rcpdt, windik, wdir + real(kind=kind_phys) :: windik, wdir real(kind=kind_phys) :: sigmin, dxres,sigres,hdxres, cdmb4, mtbridge real(kind=kind_phys) :: kxridge, inv_b2eff, zw1, zw2 real(kind=kind_phys) :: belps, aelps, nhills, selps - real(kind=kind_phys) :: rgrav, rcpd, rcpd2, rad_to_deg, deg_to_rad - real(kind=kind_phys) :: pi2, pi2h, rdi, gor, grcp, gocp, gr2, bnv2min +! real(kind=kind_phys) :: rgrav, rcpd, rcpd2, rad_to_deg, deg_to_rad +! real(kind=kind_phys) :: pi2, pih, rdi, gor, grcp, gocp, gr2, bnv2min real(kind=kind_phys) :: cleff_max ! resolution-aware max-wn real(kind=kind_phys) :: nonh_fact ! non-hydroststic factor 1.-(kx/kz_hh)**2 @@ -253,8 +227,7 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & !---- for lm and gwd calculation points ! ccpp-gwdps.f PARAMETER (hpmax=2400.0, hpmin=1.0) parameter (elvmax > hminmt=50.) - npt = 0 - + npt = 0 do i = 1,im if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then npt = npt + 1 @@ -262,38 +235,18 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & endif enddo - if (npt == 0) then - + if (npt == 0) then ! print *, 'orogw_v1 npt = 0 elvmax ', maxval(elvmaxd), hminmt -! print *, 'orogw_v1 npt = 0 hprime ', maxval(hprime), hpmin - +! print *, 'orogw_v1 npt = 0 hprime ', maxval(hprime), hpmin return ! no ogw/mbl calculation done endif -!=========================== -! scalars from phys-contants added by "CCPP-team" -! by rejecting to use "ugwp_common" -!=========================== - rcpdt = 1.0 / (cpd*dtp) - grav2 = grav + grav -! - rgrav = 1.0/grav - rcpd = 1.0/cpd - rcpd2 = 0.5/cpd - rad_to_deg=180.0/pi - deg_to_rad=pi/180.0 - pi2 = 2.*pi - pi2h = 0.5*pi - rdi = 1.0/rd - gor = grav/rd - grcp = grav*rcpd - gocp = grcp - gr2 = grav*gor - bnv2min = (pi2/1800.)*(pi2/1800.) ! tau_BV_max = 30 min ! -!=========================== -! Start -! -! initialize gamma and sigma -! + + +!================================= +! Start if npt >= 1 +! initialize gamma and sigma for +! performing the QC of SSO inputs +!================================= gamma(:) = gammad(:) sigma(:) = sigmad(:) ! @@ -314,16 +267,14 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & ! sigma-degined as tan(angle) = h/2: L/2= h/L sigmin = hpmin/hdxres ! min-slope Hmin= 2*hpmin, dxres=Lmax - - - if ( kdt == -1 .and. me == master) then - print *, ' orogw_v1 scale2 ', cdmbgwd(2) - print *, ' orogw_v1 imx ', imx - print *, ' orogw_v1 gam_min ', gammin - print *, ' orogw_v1 sso_min ', sso_min - print *, ' orogw_v1 gam_min ', gammin - print *, ' orogw_v1 npt number of GRID-cells with hills ', npt - endif +! if ( kdt == 1 .and. me == master) then +! print *, ' orogw_v1 scale2 ', cdmbgwd(2) +! print *, ' orogw_v1 imx ', imx +! print *, ' orogw_v1 gam_min ', gammin +! print *, ' orogw_v1 sso_min ', sso_min +! print *, ' orogw_v1 gam_min ', gammin +! print *, ' orogw_v1 npt number of GRID-cells with hills ', npt +! endif !============================================================ ! Purpose to adjust oro-specification on the fly @@ -332,7 +283,7 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & ! width_mount_a = hprime/sigma < dxres cannot access dxres ! width_mount_b = width_mount_a * gamma ! -! Sellipse= pi a*b = (width_mount_a)^2 *gamma <= Sarea +! Sellipse= pi * a*b = (width_mount_a)^2 *gamma <= Sarea ! Limiters on "elongated" hills gamma= a/b < gam_min ! Limiters on "longest" hills (b, a) <= sqrt(area) ! @@ -362,7 +313,7 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & if (do_adjoro ) then ! -! more adjustments "lengths", gamma and sigma, valid assuminng H=2*hprime H/2 = hprime +! more adjustments "lengths", gamma and sigma, assuminng H_hill=2*hprime ! if (hprime(i) > hdxres*sigres) sigres= hprime(i)/dxres aelps = min( hprime(i)/sigres, hdxres) @@ -388,47 +339,45 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & gamma(i) = min(aelps/belps, 1.0) endif !aelps < sso_min - endif ! ============== (do_adjoro ) + endif ! if (do_adjoro ) - selps = belps*belps*gamma(i)*pi ! area of the elliptical hill - + selps = belps*belps*gamma(i)*pi ! area of the elliptical hill nhills = min(nhilmax, sparea(i)/selps) arhills(j) = max(nhills, 1.0) ! if (kdt==1 ) write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, belps*1.e-3, sigma(i),gamma(i) - +! 333 format( ' nhil: ', i6, 4(2x, f9.3), 2(2x, e9.3)) enddo - 333 format( ' nhil: ', i6, 4(2x, f9.3), 2(2x, e9.3)) + !======================================================================= ! mtb-blocking : LM-1997; Zadra et al. 2004 ;metoffice dec 2010 H Wells !======================================================================= - do i=1,npt - khtop(i) = 2 - idxzb(i) = 0 - enddo + do i=1,npt + khtop(i) = 2 + idxzb(i) = 0 + izlow(i) = 1 + enddo - do k=1,km - do i=1,im + do k=1,km + do i=1,im db(i,k) = 0.0 ang(i,k) = 0.0 uds(i,k) = 0.0 - enddo + enddo enddo kmm1 = km - 1 ; kmm2 = km - 2 ; kmll = kmm1 - lcap = km ; lcapp1 = lcap + 1 - + lcap = km ; lcapp1 = lcap + 1 cdmb4 = 0.25*cdmb do i = 1, npt j = ipt(i) + elvmax(j) = min( sigfac * hprime(j), hncrit) ! -!gfsv15/16: ELVMAX(J) = min (ELVMAX(J) + sigfac * hprime(j), hncrit=8000.) Max-level of SSO-HILL -! - elvmax(j) = min ( sigfac * hprime(j), hncrit) - izlow(i) = 1 ! surface-level +!gfsv15/16: ELVMAX(J) = min (ELVMAX(J) + sigfac * hprime(j), hncrit=8000.) +! SSO-effects from the surface to "ELVMAX" =4*hprime + ELVMAX enddo @@ -444,193 +393,148 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & do k = 1, kmm1 - do i = 1, npt - j = ipt(i) - - ztoph = sigfac * hprime(j) - zlowh = sigfacs* hprime(j) - zmetp = zmet(j,k+1) - zmetk = zmet(j,k) + do i = 1, npt + j = ipt(i) + ztoph = sigfac * hprime(j) + zlowh = sigfacs* hprime(j) + zmetp = zmet(j,k+1) + zmetk = zmet(j,k) ! ! GFSv15/16: izlow=1 ! elvmax(j)=elvmaxd(J) + sig*hp: if (( elvmax(j) <= zmetp) .and. (elvmax(j).ge.zmetk) ) khtop(i) = max(khtop(i), k+1 ) ! - if (( ztoph <= zmetp) .and. (ztoph >= zmetk) ) khtop(i) = max(khtop(i), k+1 ) - if (zlowh <= zmetp .and. zlowh >= zmetk) izlow(i) = max(izlow(i),k) - - enddo + if (( ztoph <= zmetp) .and. (ztoph >= zmetk) ) khtop(i) = max(khtop(i), k+1 ) + if (zlowh <= zmetp .and. zlowh >= zmetk) izlow(i) = max(izlow(i),k) + enddo enddo ! do k = 1,km - do i =1,npt - j = ipt(i) - vtj(i,k) = t1(j,k) * (1.+fv*q1(j,k)) - vtk(i,k) = vtj(i,k) / prslk(j,k) - ro(i,k) = rdi * prsl(j,k) / vtj(i,k) ! density mid-levels - taup(i,k) = 0.0 - enddo + do i =1,npt + j = ipt(i) + vtj(i,k) = t1(j,k) * (1.+fv*q1(j,k)) + vtk(i,k) = vtj(i,k) / prslk(j,k) + ro(i,k) = rdi * prsl(j,k) / vtj(i,k) ! density mid + taup(i,k) = 0.0 + enddo enddo ! ! perform ri_n or ri_mf computation for both OGW and OBL -! +!23456 do k = 1,kmm1 - do i =1,npt - j = ipt(i) - rdz = 1. / (zmet(j,k+1) - zmet(j,k)) - tem1 = u1(j,k) - u1(j,k+1) - tem2 = v1(j,k) - v1(j,k+1) - dw2 = tem1*tem1 + tem2*tem2 - shr2 = max(dw2,dw2min) * rdz * rdz - bvf2 = grav2 * rdz * (vtk(i,k+1)-vtk(i,k))/ (vtk(i,k+1)+vtk(i,k)) + do i =1,npt + j = ipt(i) + rdz = 1. / (zmet(j,k+1) - zmet(j,k)) + tem1 = u1(j,k) - u1(j,k+1) + tem2 = v1(j,k) - v1(j,k+1) + dw2 = tem1*tem1 + tem2*tem2 + shr2 = max(dw2,dw2min) * rdz * rdz + bvf2 = grav2 * rdz * (vtk(i,k+1)-vtk(i,k))/ (vtk(i,k+1)+vtk(i,k)) - bnv2(i,k+1) = max( bvf2, bnv2min ) - ri_n(i,k+1) = bnv2(i,k)/shr2 ! richardson number consistent with bnv2 -! -! place here computation for "ktur" and ogw-dissipation for the spectral ORO-scheme + bnv2(i,k+1) = max( bvf2, bnv2min ) + ri_n(i,k+1) = bnv2(i,k)/shr2 ! richardson number consistent with bnv2 +! having ri_n +! we may place here computation for "ktur" and ogw-dissipation for the spectral ORO-scheme ! - enddo + enddo enddo k = 1 +!23456 do i = 1, npt bnv2(i,k) = bnv2(i,k+1) enddo ! ! level khtop => zmet(j,k) < sigfac * hprime(j) < zmet(j,k+1) -! +!23456 do i = 1, npt - j = ipt(i) - k_zlow = izlow(i) - if (k_zlow == khtop(i)) k_zlow = 1 - delks(i) = 1.0 / (prsi(j,k_zlow) - prsi(j,khtop(i))) -! delks1(i) = 1.0 /(prsl(j,k_zlow) - prsl(j,khtop(i))) - ubar (i) = 0.0 - vbar (i) = 0.0 - roll (i) = 0.0 - pe (i) = 0.0 - ek (i) = 0.0 - bnv2bar(i) = 0.0 + j = ipt(i) + k_zlow = izlow(i) + if (k_zlow == khtop(i)) k_zlow = 1 + delks(i) = 1.0 / (prsi(j,k_zlow) - prsi(j,khtop(i))) +! delks1(i) = 1.0 /(prsl(j,k_zlow) - prsl(j,khtop(i))) + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + pe (i) = 0.0 + ek (i) = 0.0 + bnv2bar(i) = 0.0 ! ! computation of the mean flow char zlow < z < ztop =sigfac*hprime -! - do k = k_zlow, khtop(i)-1 - rdelks = del(j,k) * delks(i) - ubar(i) = ubar(i) + rdelks * u1(j,k) - vbar(i) = vbar(i) + rdelks * v1(j,k) - roll(i) = roll(i) + rdelks * ro(i,k) - bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks - enddo +!23456 + do k = k_zlow, khtop(i)-1 + rdelks = del(j,k) * delks(i) + ubar(i) = ubar(i) + rdelks * u1(j,k) + vbar(i) = vbar(i) + rdelks * v1(j,k) + roll(i) = roll(i) + rdelks * ro(i,k) + bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks + enddo enddo -! +!23456 do i = 1, npt - j = ipt(i) + j = ipt(i) ! ! integrate from ztoph = sigfac*hprime down to zblk if exists ! find ph_blk, dz_blk as introduced in LM-97 and ifs -! - ph_blk =0. - do k = khtop(i), 1, -1 - - phiang = atan2(v1(j,k),u1(j,k)) - phiang = theta(j)*rad_to_deg - phiang - - if ( phiang > pi2h ) phiang = phiang - pi - if ( phiang < -pi2h ) phiang = phiang + pi - ang(i,k) = phiang - uds(i,k) = max(sqrt(u1(j,k)*u1(j,k) + v1(j,k)*v1(j,k)), velmin) -! - if (idxzb(i) == 0 ) then - dz_blk = zmeti(j,k+1) - zmeti(j,k) - pe(i) = pe(i) + bnv2(i,k) *( elvmax(j) - zmet(j,k) ) * dz_blk - - up(i) = max(uds(i,k) * cos(ang(i,k)), velmin) - ek(i) = 0.5 * up(i) * up(i) - - ph_blk = ph_blk + dz_blk*sqrt(bnv2(i,k))/up(i) +!23456 + ph_blk =0. + do k = khtop(i), 1, -1 + phiang = atan2(v1(j,k),u1(j,k)) + phiang = theta(j)*rad_to_deg - phiang + if ( phiang > pih ) phiang = phiang - pi + if ( phiang < -pih ) phiang = phiang + pi + ang(i,k) = phiang + uds(i,k) = max(sqrt(u1(j,k)*u1(j,k) + v1(j,k)*v1(j,k)), velmin) +!23456 + if (idxzb(i) == 0 ) then + dz_blk = zmeti(j,k+1) - zmeti(j,k) + pe(i) = pe(i) + bnv2(i,k) *( elvmax(j) - zmet(j,k) ) * dz_blk + up(i) = max(uds(i,k) * cos(ang(i,k)), velmin) + ek(i) = 0.5 * up(i) * up(i) + ph_blk = ph_blk + dz_blk*sqrt(bnv2(i,k))/up(i) ! --- dividing stream lime is found when pe =exceeds ek. oper-l gfs ! if ( pe(i) >= ek(i) ) then -! --- LM97 - if ( ph_blk >= fcrit_v1 ) then - idxzb(i) = k - zobl (j) = zmet(j, k) - rdxzb(j) = real(k, kind=kind_phys) - endif - - endif - enddo -! -! fcrit_v1/fr_flow -! - goto 788 -! -! alternative expression for blocking: -! zobl = max(heff*(1. -fcrit_v1/fr_Flow), 0) -! -! - - bnv = sqrt( bnv2bar(i) ) - heff = 2.*min(hprime(j),hpmax) - zw2 = ubar(i)*ubar(i)+vbar(i)*vbar(i) - ulow(i) = sqrt(max(zw2,dw2min)) - fr = heff*bnv/ulow(i) - zw1 = max(heff*(1. -fcrit_v1/fr), 0.0) - zw2 = zmet(j,2) - - if (fr > fcrit_v1 .and. zw1 > zw2 ) then - do k=2, kmm1 - zmetp = zmet(j,k+1) - zmetk = zmet(j,k) - if (zw1 <= zmetp .and. zw1 >= zmetk) exit - enddo - idxzb(i) = k - zobl (j) = zmet(j, k) - endif -788 continue +! --- LM97/IFS + if(ph_blk >= fcrit_v1 ) then + idxzb(i) = k + zobl (j) = zmet(j, k) + rdxzb(j) = real(k, kind=kind_phys) + endif +!23456 + endif + enddo ! ! --- the drag for the blocked flow ! - if ( idxzb(i) > 0 ) then + if ( idxzb(i) > 0 ) then ! ! (4.16)-ifs description ! gam2 = gamma(j)*gamma(j) bgam = 1.0 - 0.18*gamma(j) - 0.04*gam2 - cgam = 0.48*gamma(j) + 0.30*gam2 - - do k = idxzb(i)-1, 1, -1 -! -! empirical height dep-nt "blocking" length from LM-1997 + cgam = 0.48*gamma(j) + 0.30*gam2 + do k = idxzb(i)-1, 1, -1 +!23456 +! empirical height dep-nt "blocking" length from LM-1997/IFS ! - zlen = sqrt( (zobl(j)-zmet(j,k) )/(zmet(j,k ) + hprime(j)) ) -! -! - tem = cos(ang(i,k)) - cosang2 = tem * tem - sinang2 = 1.0 - cosang2 -! -! cos =1 sin =0 => 1/r= gam zr = 2.-gam -! cos =0 sin =1 => 1/r= 1/gam zr = 2.- 1/gam -! - rdem = cosang2 + gam2 * sinang2 - rnom = cosang2*gam2 + sinang2 + zlen = sqrt( (zobl(j)-zmet(j,k) )/(zmet(j,k ) + hprime(j)) ) + tem = cos(ang(i,k)) + cosang2 = tem * tem + sinang2 = 1.0 - cosang2 + rdem = cosang2 + gam2 * sinang2 + rnom = cosang2*gam2 + sinang2 ! ! metoffice dec 2010 ! correction of H. Wells & A. Zadra for the -! aspect ratio of the hill seen by mean flow -! (1/r , r-inverse below: 2-r) - - rdem = max(rdem, 1.e-6) - r = sqrt(rnom/rdem) - zr = max( 2. - r, 0. ) - sigres = max(sigmin, sigma(j)) - - mtbridge = zr * sigres*zlen / hprime(j) -! (4.15)-ifs -! dbtmp = cdmb4 * mtbridge * & -! & max(cos(ang(i,k)), gamma(j)*sin(ang(i,k))) -! (4.16)-ifs - dbtmp = cdmb4*mtbridge*(bgam* cosang2 +cgam* sinang2) +! aspect ratio of the elliptical hill seen by mean flow +! + rdem = max(rdem, 1.e-6) + r = sqrt(rnom/rdem) + zr = max( 2. - r, 0. ) + sigres = max(sigmin, sigma(j)) + mtbridge = zr * sigres*zlen / hprime(j) +! dbtmp = cdmb4*mtbridge*max(cos(ang(i,k)), gamma(j)*sin(ang(i,k))) ! (4.15)-ifs + dbtmp = cdmb4*mtbridge*(bgam* cosang2 +cgam * sinang2) ! (4.16)-ifs ! ! linear damping due to OBL [1/sec]=[U/L_block_orthogonal] ! more accurate along 2-axes of ellipse, here zr-factor is based on Phillips' analytics @@ -638,13 +542,13 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & db(i,k)= dbtmp * uds(i,k) ! if (db(i,k) > dbmax) print *, ' db > dbmax ', 1./db(i,k)/3600., uds(i,k) db(i,k)= min(db(i,k), dbmax) - enddo -! - endif + enddo +!23456 + endif enddo !............................. !............................. -! end mtn blocking section +! finish the mtn blocking !............................. !............................. ! @@ -657,78 +561,72 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & iwk(1:npt) = 2 ! ! in meto/UK-scheme: -! k_mtb = max(k_zmtb, k_n*hprime/2] to reduce diurnal variations taub_ogw -! +! k_mtb = max(k_zmtb, k_n*hprime/2] to reduce diurnal variations in taub_ogw +!23456 do k=3,kmpbl - do i=1,npt - j = ipt(i) - tem = (prsi(j,1) - prsi(j,k)) - if (tem < dpmin) iwk(i) = k ! dpmin=50 mb from the surface - enddo + do i=1,npt + j = ipt(i) + tem = (prsi(j,1) - prsi(j,k)) + if (tem < dpmin) iwk(i) = k ! dpmin=50 mb from the surface + enddo enddo -! -! iwk - adhoc criteria to select ghe ogw-launch level between -! level ~0.4-0.5 km from surface or/and HPBL-top -! -! in all UGWP-schemes: zogw > zobl -! in ugwp-v1: we consider option for htop ~ (2-3)*hprime > zmtb -! the top hill can be inside PBL.... if kref = khtop +! +! in all cires-UGWP-schemes: zogw > zobl +! in ugwp-v1: we consider option for htop ~ (2-3)*hprime > zmtb +! the top of hill can be inside the PBL.... if kref = khtop ! kbps = 1 kmps = km k_mtb = 1 - +!23456 do i=1,npt - j = ipt(i) - k_mtb = max(1, idxzb(i)) + j = ipt(i) + k_mtb = max(1, idxzb(i)) ! WRF/GSL: kogw = max(kpbl, ktop=2*var) - kref(i) = max(iwk(i), kpbl(j)+1 ) ! reference level pbl or smt-else...Zogw= sigfac*Hprime - kref(i) = max(kref(i), khtop(i) ) ! khtop => sigfac*hprime -! -! zogw > zobl -! - if (kref(i) <= k_mtb) kref(i) = k_mtb + 1 ! layer above blocking - kbps = max(kbps, kref(i)) - kmps = min(kmps, kref(i)) -! - delks(i) = 1.0 / (prsi(j,k_mtb) - prsi(j,kref(i))) - ubar (i) = 0.0 - vbar (i) = 0.0 - roll (i) = 0.0 - bnv2bar(i)= 0.0 + kref(i) = max(iwk(i), kpbl(j)+1 ) ! reference level pbl or smt-else...Zogw= sigfac*Hprime + kref(i) = max(kref(i), khtop(i) ) ! khtop => sigfac*hprime +!zogw > zobl + if (kref(i) <= k_mtb) kref(i) = k_mtb + 1 ! OGW-layer above the blocking height + kbps = max(kbps, kref(i)) + kmps = min(kmps, kref(i)) +! + delks(i) = 1.0 / (prsi(j,k_mtb) - prsi(j,kref(i))) + ubar (i) = 0.0 + vbar (i) = 0.0 + roll (i) = 0.0 + bnv2bar(i)= 0.0 enddo +!23456===================== ! -! -!====================== we estimate MF-parameters from k= k_mtb to [kref~kpbl] > k_mtb +!= we estimate MF-parameters from k= k_mtb to [kref~kpbl] > k_mtb !computation of the mean flow for zobl < z < ztop =sigfac*hprime inb GSL ztop =max(hpbl, ztop) -!===================== - do i = 1,npt +!23456===================== + do i = 1,npt k_mtb = max(1, idxzb(i)) - do k = k_mtb,kbps !kbps = max(kref) kref = (kpbl+1, khtop) - if (k < kref(i)) then - j = ipt(i) - rdelks = del(j,k) * delks(i) - ubar(i) = ubar(i) + rdelks * u1(j,k) ! mean u below kref - vbar(i) = vbar(i) + rdelks * v1(j,k) ! mean v below kref - roll(i) = roll(i) + rdelks * ro(i,k) ! mean ro below kref - bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks - endif - enddo + do k = k_mtb,kbps !kbps = max(kref) kref = (kpbl+1, khtop) + if(k < kref(i)) then + j = ipt(i) + rdelks = del(j,k) * delks(i) + ubar(i) = ubar(i) + rdelks * u1(j,k) + vbar(i) = vbar(i) + rdelks * v1(j,k) + roll(i) = roll(i) + rdelks * ro(i,k) + bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks + endif + enddo enddo ! ! orographic asymmetry parameters (oa), and (clx) [Kim & Arakawa Kim & Doyle] -! +!23456 do i = 1,npt - j = ipt(i) - wdir = atan2(ubar(i),vbar(i)) + pi ! not sure about "+pi" due to "nwdir"-Kim OA/CLX-processing - idir = mod(nint(fdir*wdir),mdir) + 1 - nwd = nwdir(idir) - oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(j,mod(nwd-1,4)+1) - - clx(i) = clx4(j,mod(nwd-1,4)+1) ! number of "effective" hills in the grid-box KA-95/KD-05 + j = ipt(i) + wdir = atan2(ubar(i),vbar(i)) + pi + idir = mod(nint(fdir*wdir),mdir) + 1 + nwd = nwdir(idir) + oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(j,mod(nwd-1,4)+1) + clx(i) = clx4(j,mod(nwd-1,4)+1) ! number of "effective" hills (?) in the grid-box KA-95/KD-05 ! -!GSLdrag ->identical to above +!GSL-drag ->identical to above ! ! wdir = atan2(ubar(i),vbar(i)) + pi ! idir = mod(nint(fdir*wdir),mdir) + 1 @@ -736,23 +634,22 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & ! oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(i,mod(nwd-1,4)+1) ! ol(i) = ol4(i,mod(nwd-1,4)+1) ! - dtfac(i) = 1.0 - icrilv(i) = .false. ! initialize critical level control Logic - - ulow(i) = max(sqrt(ubar(i)*ubar(i)+vbar(i)*vbar(i)),velmin) - xn(i) = ubar(i) / ulow(i) - yn(i) = vbar(i) / ulow(i) + dtfac(i) = 1.0 + icrilv(i) = .false. ! initialize critical level control Logic + ulow(i) = max(sqrt(ubar(i)*ubar(i)+vbar(i)*vbar(i)),velmin) + xn(i) = ubar(i) / ulow(i) + yn(i) = vbar(i) / ulow(i) + enddo +!23456 + do k = 1, kmm1 + do i = 1,npt + j = ipt(i) + velco(i,k) = 0.5 * ((u1(j,k)+u1(j,k+1))*xn(i)+ (v1(j,k)+v1(j,k+1))*yn(i)) enddo -! - do k = 1, kmm1 - do i = 1,npt - j = ipt(i) - velco(i,k) = 0.5 * ((u1(j,k)+u1(j,k+1))*xn(i)+ (v1(j,k)+v1(j,k+1))*yn(i)) - enddo enddo - do i = 1,npt - velco(i,km) = velco(i,kmm1) + do i = 1,npt + velco(i,km) = velco(i,kmm1) enddo ! !------------------------------------------------------------------------ @@ -772,94 +669,73 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & ! ! taub_oro as in KA-95/KD-05 GSL & EMC includes ALL waves (POGWs, Lee-rotors, etc...) ! here taub represents mainly OGWs with nonh_fact = 1. -(kx/kz)**2 -! LLWB for Lee-rotors (downslope dynamics and flow-splitting ) is not considered -! +! LLWB for Lee-rotors (downslope dynamics and flow-splitting ) is not considered +!23456 do i = 1,npt - j = ipt(i) - bnv = sqrt( bnv2bar(i) ) - heff = min(hprime(j),hpmax) - - if( zobl(j) > 0.) heff = max(sigfac*heff-zobl(j), 0.)/sigfac - - if (heff <= 0) cycle - zw1 = ulow(i)/bnv - hsat = fcrit_v1 *zw1 - heff = min(heff, hsat) ! similar hsat-limit in CAM as found in Dec 2020 - - fr = heff/zw1 ! Fr-GSL = Fr * OD -> gamma - - fr = min(fr, frmax) - fr2 = fr*fr - zw2 = fr2 *oc(j) ! oc-values from 0 to 10 (GSL => 100) - ! Fr-funct = zw2/(zw2+cg) -! + j = ipt(i) + bnv = sqrt( bnv2bar(i) ) + heff = min(hprime(j),hpmax) + if( zobl(j) > 0.) heff = max(sigfac*heff-zobl(j), 0.)/sigfac + if (heff <= 0) cycle + zw1 = ulow(i)/bnv + hsat = fcrit_v1 *zw1 + heff = min(heff, hsat) + fr = heff/zw1 + fr = min(fr, frmax) + fr2 = fr*fr + zw2 = fr2 *oc(j) ! oc-values from 0 to 10 (GSL => 100) +! ! [Kim & Doyle, 2005] ! - efact = (oa(i) + 2.) ** (ceofrc*fr) ! enhnancement factor due to the resonance ampification/downstream - efact = min( max(efact,efmin), efmax ) - gfobnv = efact* gmax /(zw2 + cg) ! withoutt "multiplication" on =zw2 + efact = (oa(i) + 2.) ** (ceofrc*fr) ! enhnancement factor due to the resonance ampification/downstream + efact = min( max(efact,efmin), efmax ) + gfobnv = efact* gmax /(zw2 + cg) ! withoutt "multiplication" on =zw2 ! -! !cleff_max(C768 = 6.28/(12.5 km/5.)) ..... +! ! cleff_max(C768 = 6.28/(12.5 km/5.)) ..... ! xlinv(i) = min(coefm * cleff, cleff_max) ! - mkd05_hills(i) = (1. + clx(i)) ** (oa(i)+1.) ! ex-coefm (1-2) of eff-hills with "some" anizoropy as in KD-2005 - - - xlinv(i) = min(cleff * mkd05_hills(i), cleff_max) - - taub_kd05(i) = roll(i)*xlinv(i) *(gfobnv *zw2)* (zw1 * ulow(i)* ulow(i)) + mkd05_hills(i) = (1. + clx(i)) ** (oa(i)+1.) ! ex-coefm (1-2) of eff-hills with "some" anizoropy as in KD-2005 + xlinv(i) = min(cleff * mkd05_hills(i), cleff_max) + taub_kd05(i) = roll(i)*xlinv(i) *(gfobnv *zw2)* (zw1 * ulow(i)* ulow(i)) ! ! old: tem = fr2*oc(j) ; gfobnv = gmax * tem / ((tem + cg)*bnv(i)) ! kx =or max(kxridge, inv_b2eff) ! 6.28/lx ..0.5*sigma(j)/heff = 1./lridge ! - sigres = sigma(j) - inv_b2eff = pi*sigres/heff ! pi2/(2b) - kxridge = pi /ahdxres(i) ! pi2/(2*dx) - xlingfs = max(inv_b2eff, kxridge) -! -! xlinv(i) = max(xlingfs, xlinv(i) ) - - nonh_fact = 1. - xlinv(i)*zw1 * xlinv(i)*zw1 ! 1- (kx/kz)^2 - - if ( nonh_fact <= 0.) cycle ! non-hydrostatic trapping kx = kz = N/U + sigres = sigma(j) + inv_b2eff = pi*sigres/heff ! pi2/(2b) + kxridge = pi /ahdxres(i) ! pi2/(2*dx) + xlingfs = max(inv_b2eff, kxridge) + nonh_fact = 1. - xlinv(i)*zw1 * xlinv(i)*zw1 ! 1- (kx/kz)^2 +!23456 + if (nonh_fact <= 0.) cycle ! non-hydrostatic trapping kx = kz = N/U ! - taulin(i) = xlinv(i)*roll(i)*bnv*ulow(i)*heff*heff * nonh_fact - tausat(i) = xlinv(i)*roll(i)* zw1*ulow(i)*ulow(i) *fcrit2 * nonh_fact + taulin(i) = xlinv(i)*roll(i)*bnv*ulow(i)*heff*heff * nonh_fact + tausat(i) = xlinv(i)*roll(i)* zw1*ulow(i)*ulow(i) *fcrit2 * nonh_fact ! -! taulin(i) = xlinv(i)*roll(i)*ulow(i)**3/bnv *fr2 => -! fr2 = (bnv*heff/Ulow)**2 + non-hydrostatic trapping effects Fr2_nh = Fr2 - kx2*heff^2 -! - if ( fr > fcrit_v1 ) then -! - frnd = fr/fcrit_v1 - fr_func = frnorm* frnd*frnd/(afr + frnd ** nfr) - taub(i) = tausat(i) *max(fr_func, max_frf) ! nonlinear flux tau0...xlinv(i) - else - taub(i) = taulin(i) ! linear flux for fr <= fcrit_v1 - endif - xlinv(i) = .5*xlinv(i) ! 1/2 rhoint-factor in Ri-solver of PSS-1986 -! - k = max(1, kref(i)-1) - tem = max(velco(i,k)*velco(i,k), dw2min) - scor(i) = bnv2(i,k) / tem ! scorer parameter below kref level Bn2/U2= kz^2 -! -! diagnostics for zogw, tau_ogw -! - zogw(j) = zmeti(j, kref(i) ) - tau_ogw(j) = taub(i) - -! if (kdt == 1) then -! print *, ' tau =', nint(taub(i)*1.e3), ' tkd05 =', nint(taub_kd05(i)*1.e3), 'Fr=', Fr -! print *, ' zogw=', nint(zogw(j)), ' zobl=', nint(zobl(j)) ! nint(mkd05_hills(i)), nint(arhills(i)) -! endif - +! taulin(i) = xlinv(i)*roll(i)*ulow(i)**3/bnv *fr2 => +! fr2 = (bnv*heff/Ulow)**2 + non-hydrostatic trapping effects Fr2_nh = Fr2 - kx2*heff^2 +!23456 + if(fr > fcrit_v1 ) then + frnd = fr/fcrit_v1 + fr_func = frnorm* frnd*frnd/(afr + frnd ** nfr) + taub(i) = tausat(i) *max(fr_func, max_frf) ! nonlinear flux tau0...xlinv(i) + else + taub(i) = taulin(i) ! linear flux for fr <= fcrit_v1 + endif + xlinv(i) = .5*xlinv(i) ! 1/2 rhoint-factor in Ri-solver of PSS-1986 + k = max(1, kref(i)-1) + tem = max(velco(i,k)*velco(i,k), dw2min) + scor(i) = bnv2(i,k) / tem ! scorer parameter below kref level Bn2/U2= kz^2 + zogw(j) = zmeti(j, kref(i) ) + tau_ogw(j) = taub(i) +!23456 enddo ! !----set up bottom values of stress ! - do i = 1,npt + do i = 1,npt taup(i, 1:kref(i) ) = taub(i) - enddo + enddo !====================================================== ! ! Having : taub(i)/tau_ogw(j) => solve for OGW-effects @@ -868,107 +744,85 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & if (strsolver == 'pss-1986') then !====================================================== -! v0-gfs orogw-solver of palmer et al 1986 -"pss-1986" -! modified by KD05 with the expression (11):below k=kref ??? +! v0-gfs orogw-solver of Palmer et al 1986 -"pss-1986" +! modified by KD05 with the emp.expression (11):below k=kref ??? ! tau(k+1) = tau(k)*Scorer(K+1)/Scorer(K) -! -! in v1-orogw linsatdis of "wam-2017" -! with llwb-mechanism for -! rotational/non-hydrostat ogws important for +! in v1-orogw linsatdis of "wam-2017" for +! rotational/non-hydrostat ogws; important for ! highres-fv3gfs with dx < 10 km -!====================================================== - - do k = kmps, kmm1 ! vertical level loop from min(kref) - kp1 = k + 1 - - do i = 1, npt - if (k >= kref(i)) then - icrilv(i) = icrilv(i) .or. ( ri_n(i,k) < ric).or. (velco(i,k) <= 0. ) - endif - enddo +!23456====================================================== + do k = kmps, kmm1 ! vertical level loop from min(kref) + kp1 = k + 1 + do i = 1, npt + if (k >= kref(i)) then + icrilv(i) = icrilv(i) .or. ( ri_n(i,k) < ric).or. (velco(i,k) <= 0. ) + endif + enddo ! - do i = 1,npt - if (k >= kref(i)) then - if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) then - zw1 = max(velco(i,k), velmin) - temv = 1.0 / zw1 + do i = 1,npt + if (k >= kref(i)) then + if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) then + zw1 = max(velco(i,k), velmin) + temv = 1.0 / zw1 !=============== -! Condition for levels below kref(i): k+1 < kref(i)) ??? see KD05 expression (11) for LLWB ??? only OA >0 +! Condition for levels below kref(i): k+1 < kref(i)) ??? see KD05 expression (11) for LLWB only OA >0 ! k >= kref(i) and .... k+1 0. .and. kp1 < kref(i)) then - scork = bnv2(i,k) * temv * temv - rscor = min(1.0, scork / scor(i)) - scor(i) = scork - else - rscor = 1. - endif + if (oa(i) > 0. .and. kp1 < kref(i)) then + scork = bnv2(i,k) * temv * temv + rscor = min(1.0, scork / scor(i)) + scor(i) = scork + else + rscor = 1. + endif !=============== - brvf = sqrt(bnv2(i,k)) ! brent-vaisala frequency interface -! xlinv(i)*0.5 - tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k)) *brvf* zw1 - - hd = sqrt(taup(i,k) / tem1) - fro = brvf * hd * temv + brvf = sqrt(bnv2(i,k)) ! brent-vaisala frequency interface + tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k)) *brvf* zw1 + hd = sqrt(taup(i,k) / tem1) + fro = brvf * hd * temv ! ! rim is the "wave"-richardson number byPalmer,Shutts & Swinbank 1986 , PSS-1986 ! - tem2 = sqrt(ri_n(i,k)) - tem = 1. + tem2 * fro - ri_gw = ri_n(i,k) * (1.0-fro) / (tem * tem) -! -! check Ri-stability to employ the 'dynamical saturation hypothesis' PSS-1986 -! assuming co-existence of Dyn-Ins and Conv-Ins -! - if (ri_gw <= ric .and.(oa(i) <= 0. .or. kp1 >= kref(i) )) then - temc = 2.0 + 1.0 / tem2 - hd = zw1 * (2.*sqrt(temc)-temc) / brvf - taup(i,kp1) = tem1 * hd * hd - else - - taup(i,kp1) = taup(i,k) * rscor - endif + tem2 = sqrt(ri_n(i,k)) + tem = 1. + tem2 * fro + ri_gw = ri_n(i,k) * (1.0-fro) / (tem * tem) +! +! check Ri-stability to employ the 'dynamical criterion' of PSS-1986 +! assuming co-existence of simultaneous Dyn-Ins and Conv-Ins +! cos(GW_phase) =1 and sin(GW_phase)=-1 +!23456 + if (ri_gw <= ric .and.(oa(i) <= 0. .or. kp1 >= kref(i) )) then + temc = 2.0 + 1.0 / tem2 + hd = zw1 * (2.*sqrt(temc)-temc) / brvf + taup(i,kp1) = tem1 * hd * hd + else + taup(i,kp1) = taup(i,k) * rscor + endif ! - taup(i,kp1) = min(taup(i,kp1), taup(i,k)) - endif ! if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) - endif ! k >= kref(i)) - enddo ! oro-points - enddo ! do k = kmps, kmm1 vertical level loop -! + taup(i,kp1) = min(taup(i,kp1), taup(i,k)) + endif ! if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) + endif ! k >= kref(i)) + enddo ! oro-points + enddo ! do k = kmps, kmm1 vertical level loop +!23456 ! zero momentum deposition at the top model layer: taup(k+1) = taup(k) ! taup(1:npt,km+1) = taup(1:npt,km) ! ! calculate wave acc-n: - (grav)*d(tau)/d(p) = taud -! - do k = 1,km - do i = 1,npt - zw1 = grav*(taup(i,k+1) - taup(i,k))/del(ipt(i),k) -!====================================================================================== -! we estimated "impact" of the single sub-grid hill, we have "arhills" in the grid-box -! 2-estimations of "nhills": 1) geometry-arhills and 2) KDO5 mkd05_hills -! for OBL we used: 1) nhills=Grid_Area/Hill_area -! nhills = max(mkd05_hills(i), arhills(i)) -! Trapped "Lee" downslope wave regimes are not properly modelled: vertical shear +NH/Nonlin -! tau(z) = const => tau(z)/m2(z) = const (empirical mesoscale) -! -! Apply dU/dt-limiter -! +!23456 + do k = 1,km + do i = 1,npt + zw1 = grav*(taup(i,k+1) - taup(i,k))/del(ipt(i),k) !====================================================================================== -! zw1 = zw1 * arhills(i) ! simple scale-awareness nhills=Grid_Area/Hill_area -! apply limiters for OGW tendency +! zw1 = zw1 * arhills(i) ! simple scale-awareness nhills=Grid_Area/Hil +! apply limiters for OGW tendency !====================================================================================== - if (abs(zw1) > max_axyz ) then - zw1 = sign(max_axyz, zw1) -! if (kdt <=2 ) then -! print *, ' Hdudt ', nint(max_axyz*1.e5), nint(zw2*1.e5) -! print *, ' Hdudt ', xn(i), yn(i) -! endif - endif - taud(i,k)= zw1 - enddo - enddo - + if (abs(zw1) > max_axyz ) zw1 = sign(max_axyz, zw1) + taud(i,k)= zw1 + enddo + enddo +!23456 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ !------if the gravity wave drag would force a critical line in the !------layers below sigma=rlolev during the next deltim timestep, @@ -977,168 +831,140 @@ subroutine orogw_v1 (im, km, imx, me, master, dtp, kdt, do_tofd, & ! by limiting "ax = dtfac*ax" due to possible llwb around kref and 500 mb ! critical line [v - ax*dtp = 0.] is smt like "llwb" for stationary ogws !2019: this option limits sensitivity of taux/tauy to variations in "taub" -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - do k = 1,kmm1 - do i = 1,npt - - if (k >= kref(i) .and. prsi(ipt(i),k) >= rlolev) then - - if(taud(i,k) /= 0.) then - tem = dtp * taud(i,k) ! tem = du/dt-oro*dt => U/dU vs 1 - dtfac(i) = min(dtfac(i),abs(velco(i,k)/tem)) ! reduce Ax= Ax*(1, or U/dU <=1) -! dtfac(i) = 1.0 - endif - endif - enddo - enddo +!23456~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + do k = 1,kmm1 + do i = 1,npt + if (k >= kref(i) .and. prsi(ipt(i),k) >= rlolev .and. taud(i,k) /= 0.) then + tem = dtp * taud(i,k) + dtfac(i) = min(dtfac(i),abs(velco(i,k)/tem)) ! reduce Ax= Ax*(1, or U/dU <=1) +!default : dtfac(i) = 1.0 + endif + enddo + enddo ! -!--------- orogw-solver of gfs PSS-1986 is performed - +!--------- orogw-solver of gfs PSS-1986 is performed else - -!----------- orogw-solver of wam2017 out : taup, taud, pkdis - - dtfac(:) = 1.0 - - call oro_spectral_solver(im, km, npt, ipt, kref, kdt, me, master, & - dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsl, & - grav, con_omega, rd, & +!----------orogw-solver of wam2017 out : taup, taud, pkdis + + call oro_spectral_solver(im, km, npt, ipt, kref, kdt, me, master, & + dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsl, & + grav, omega1, rd, & del, sigma, hprime, gamma, theta, sinlat, xlatd, taup, taud, pkdis) - endif ! oro_linsat - linsatdis-solver for stationary OGWs + endif ! oro_linsat - linsatdis-solver for stationary OGWs ! !---- above orogw-solver of wam2017------------ ! ! tofd as in Beljaars-2004 IFS sep-scale ~5km ! CESM ~ 6km (TMS + OGW/OBL) -! sgh30 = varss of GSL (?) +! sgh30 = varss of GSL ! ---------------------------------------------- - - if( do_tofd ) then -! -! can scale varss(j) by adjusting filterd oro_turb spectra -! a1-coeff by (Lx_flt_cXXX/Lx_c768)^1.9 -! -! klow = 6.28/10km of Beljaars_etal_2004 and kflt^n1 -! kflt = 6.28/18km -! if ( kdt == 1 .and. me == 0) then -! print *, 'ugwp-v1 do_tofd from surface to ', ztop_tofd -! endif - - do i = 1,npt - j = ipt(i) - zpbl = zmet( j, kpbl(j) ) - - sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of ls-sso - ! GSL-2/limits a) 250 m ; b) var_maxfd =150m - zsurf = zmeti(j,1) - - do k=1,km - zpm(k) = zmet(j,k) - up1(k) = u1(j,k) - vp1(k) = v1(j,k) - enddo +!23456 + if( do_tofd ) then + do i = 1,npt + j = ipt(i) + zpbl = zmet( j, kpbl(j) ) + sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of ls-sso GSL-2/limits a) 250 m ; b) var_maxfd =150m + zsurf = zmeti(j,1) + do k=1,km + zpm(k) = zmet(j,k) + up1(k) = u1(j,k) + vp1(k) = v1(j,k) + enddo - call ugwp_tofd1d(km, cpd, dtp, sigflt, zsurf, zpbl, & - up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) + call ugwp_tofd1d(km, cpd, dtp, sigflt, zsurf, zpbl, & + up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) - do k=1,km - dudt_ofd(j,k) = utofd1(k) - dvdt_ofd(j,k) = vtofd1(k) + do k=1,km + dudt_ofd(j,k) = utofd1(k) + dvdt_ofd(j,k) = vtofd1(k) ! ! add tofd to gw-tendencies ! - pdvdt(j,k) = pdvdt(j,k) + utofd1(k) - pdudt(j,k) = pdudt(j,k) + vtofd1(k) - pdtdt(j,k) = pdtdt(j,k) + epstofd1(k) - enddo -!2018-diag - du_ofdcol(j) = sum( utofd1(1:km)* del(j,1:km)) - dv_ofdcol(j) = sum( vtofd1(1:km)* del(j,1:km)) + pdvdt(j,k) = pdvdt(j,k) + utofd1(k) + pdudt(j,k) = pdudt(j,k) + vtofd1(k) + pdtdt(j,k) = pdtdt(j,k) + epstofd1(k) + enddo + du_ofdcol(j) = sum( utofd1(1:km)* del(j,1:km)) + dv_ofdcol(j) = sum( vtofd1(1:km)* del(j,1:km)) - dusfc(j) = dusfc(j) + du_ofdcol(j) - dvsfc(j) = dvsfc(j) + dv_ofdcol(j) - enddo + dusfc(j) = dusfc(j) + du_ofdcol(j) + dvsfc(j) = dvsfc(j) + dv_ofdcol(j) + enddo endif ! do_tofd - +!23456 !-------------------------------------------- ! combine oro-drag effects MB +TOFD + OGWs + diag-3d !-------------------------------------------- -! - +!234546 do k = 1,km - do i = 1,npt - j = ipt(i) -! - eng0 = 0.5*(u1(j,k)*u1(j,k)+v1(j,k)*v1(j,k)) -! - if ( k < idxzb(i) .and. idxzb(i) /= 0 ) then + do i = 1,npt + j = ipt(i) + eng0 = 0.5*(u1(j,k)*u1(j,k)+v1(j,k)*v1(j,k)) + if ( k < idxzb(i) .and. idxzb(i) /= 0 ) then ! -! if blocking layers -- no ogws +! if blocking layers -- no ogw effects ! - dbim = db(i,k) / (1.+db(i,k)*dtp) - - dudt_obl(j,k) = -dbim * u1(j,k) - dvdt_obl(j,k) = -dbim * v1(j,k) + dbim = db(i,k) / (1.+db(i,k)*dtp) + dudt_obl(j,k) = -dbim * u1(j,k) + dvdt_obl(j,k) = -dbim * v1(j,k) - pdvdt(j,k) = dudt_obl(j,k) +pdvdt(j,k) - pdudt(j,k) = dvdt_obl(j,k) +pdudt(j,k) -!2018-diag - du_oblcol(j) = du_oblcol(j) + dudt_obl(j,k)* del(j,k) - dv_oblcol(j) = dv_oblcol(j) + dvdt_obl(j,k)* del(j,k) - - dusfc(j) = dusfc(j) + du_oblcol(j) - dvsfc(j) = dvsfc(j) + dv_oblcol(j) - - else + pdvdt(j,k) = dudt_obl(j,k) +pdvdt(j,k) + pdudt(j,k) = dvdt_obl(j,k) +pdudt(j,k) + du_oblcol(j) = du_oblcol(j) + dudt_obl(j,k)* del(j,k) + dv_oblcol(j) = dv_oblcol(j) + dvdt_obl(j,k)* del(j,k) + dusfc(j) = dusfc(j) + du_oblcol(j) + dvsfc(j) = dvsfc(j) + dv_oblcol(j) +!23456 + else ! ! ogw-s above blocking height ! - taud(i,k) = taud(i,k) * dtfac(i) - dtaux = taud(i,k) * xn(i) - dtauy = taud(i,k) * yn(i) + taud(i,k) = taud(i,k) * dtfac(i) + dtaux = taud(i,k) * xn(i) + dtauy = taud(i,k) * yn(i) ! - dudt_ogw(j,k) = dtaux - dvdt_ogw(j,k) = dtauy + dudt_ogw(j,k) = dtaux + dvdt_ogw(j,k) = dtauy ! - pdvdt(j,k) = dtauy +pdvdt(j,k) - pdudt(j,k) = dtaux +pdudt(j,k) + pdvdt(j,k) = dtauy +pdvdt(j,k) + pdudt(j,k) = dtaux +pdudt(j,k) ! - du_ogwcol(j) = du_ogwcol(j) + dtaux * del(j,k) - dv_ogwcol(j) = dv_ogwcol(j) + dtauy * del(j,k) + du_ogwcol(j) = du_ogwcol(j) + dtaux * del(j,k) + dv_ogwcol(j) = dv_ogwcol(j) + dtauy * del(j,k) ! - dusfc(j) = dusfc(j) + du_ogwcol(j) - dvsfc(j) = dvsfc(j) + dv_ogwcol(j) - endif + dusfc(j) = dusfc(j) + du_ogwcol(j) + dvsfc(j) = dvsfc(j) + dv_ogwcol(j) + endif +!23456 !============ ! local energy deposition sso-heat due to loss of kinetic energy !============ - unew = u1(j,k) + pdudt(j,k)*dtp ! pdudt(j,k)*dtp - vnew = v1(j,k) + pdvdt(j,k)*dtp ! pdvdt(j,k)*dtp - eng1 = 0.5*(unew*unew + vnew*vnew) - pdtdt(j,k) = max(eng0-eng1,0.)*rcpdt + pdtdt(j,k) - - enddo + unew = u1(j,k) + pdudt(j,k)*dtp ! pdudt(j,k)*dtp + vnew = v1(j,k) + pdvdt(j,k)*dtp ! pdvdt(j,k)*dtp + eng1 = 0.5*(unew*unew + vnew*vnew) + pdtdt(j,k) = max(eng0-eng1,0.)*rcpdt + pdtdt(j,k) + enddo enddo ! dusfc w/o tofd sign as in the era-i, merra and cfsr +!23456 do i = 1,npt - j = ipt(i) - dusfc(j) = -rgrav * dusfc(j) - dvsfc(j) = -rgrav * dvsfc(j) + j = ipt(i) + dusfc(j) = -rgrav * dusfc(j) + dvsfc(j) = -rgrav * dvsfc(j) du_ogwcol(j) = -rgrav *du_ogwcol (j) dv_ogwcol(j) = -rgrav *dv_ogwcol (j) du_oblcol(j) = -rgrav *du_oblcol (j) dv_oblcol(j) = -rgrav *dv_oblcol (j) - tau_ogw(j) = -rgrav * tau_ogw(j) - du_ofdcol(j) = -rgrav * du_ofdcol(j) - dv_ofdcol(j) = -rgrav * du_ofdcol(j) + du_ofdcol(j) = -rgrav * du_ofdcol(j) + dv_ofdcol(j) = -rgrav * du_ofdcol(j) enddo - return + return -!============ debug ------------------------------------------------ +!============ print/debug after the RETURN statenemt -------------------------------- if (kdt <= 2 .and. me == 0) then print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me ! @@ -1185,12 +1011,12 @@ end subroutine orogw_v1 subroutine ugwp_tofd1d(levs, con_cp, dtp, sigflt, zsurf, zpbl, u, v, & zmid, utofd, vtofd, epstofd, krf_tofd) - use machine , only : kind_phys - use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd + use machine , only : kind_phys + use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd ! ! adding the implicit tendency estimate ! - implicit none + implicit none integer, intent(in) :: levs real(kind_phys), intent(in) :: con_cp real(kind_phys), intent(in) :: dtp @@ -1198,16 +1024,15 @@ subroutine ugwp_tofd1d(levs, con_cp, dtp, sigflt, zsurf, zpbl, u, v, & real(kind_phys), intent(in), dimension(levs) :: u, v, zmid real(kind_phys), intent(in) :: sigflt, zpbl, zsurf - real(kind_phys), intent(out), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd - - + real(kind_phys), intent(out), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd ! ! locals ! integer :: i, k real(kind=kind_phys) :: rcpd2, tofd_mag, tofd_zdep - real(kind_phys) :: unew, vnew, eknew - real(kind=kind_phys), parameter :: sghmax = 5. ! dz(1)/5= 25/5 m dz-of the first layer + real(kind_phys) :: unew, vnew, eknew + + real(kind=kind_phys), parameter :: sghmax = 5. ! dz(1)/5= 25/5 m dz-of the first layer real(kind=kind_phys), parameter :: tend_imp = 1. @@ -1222,10 +1047,10 @@ subroutine ugwp_tofd1d(levs, con_cp, dtp, sigflt, zsurf, zpbl, u, v, & ! H_efold = min(H_efold,1500.) rzdec = 1.0/zdec - sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! 25 meters dz-of the first layer - tofd_mag = const_tofd * a12_tofd * sgh2 ! * scale_res + sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! dz ~25m of the first layer in FV3GFS-127L + tofd_mag = const_tofd * a12_tofd * sgh2 ! * scale_res -! GSL-scheme: varmax_fd, beta_fd ,250. +! GSL-darg scheme: varmax_fd, beta_fd ,250. ! var_temp = MIN(varss,varmax_fd) + MAX(0., 0.1*(varss-varmax_fd)) ! var_temp = MIN(var_temp, 250.) ! var_temp = var_temp * var_temp @@ -1257,7 +1082,7 @@ subroutine ugwp_tofd1d(levs, con_cp, dtp, sigflt, zsurf, zpbl, u, v, & krf = umag * tofd_mag * tofd_zdep if (tend_imp == 1.) then - krf = krf/(1.+krf*dtp) + krf = krf/(1.+krf*dtp) endif utofd(k) = -krf*u(k) diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/cires_ugwpv1_solv2.F90 index ad8f8090d..07330cf8b 100644 --- a/physics/cires_ugwpv1_solv2.F90 +++ b/physics/cires_ugwpv1_solv2.F90 @@ -10,16 +10,10 @@ module cires_ugwpv1_solv2 ! reflected GWs treated as waves with "negligible" flux, ! they are out of given column !--------------------------------------------------- -! call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, & -! tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, & -! zmet, zmeti,prslk, xlat_d, sinlat, coslat, & -! con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt, & -! dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw) subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & tau_ngw, tm , um, vm, qm, prsl, prsi, zmet, zmeti, prslk, & xlatd, sinlat, coslat, & - con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt, & pdudt, pdvdt, pdtdt, dked, zngw) ! !-------------------------------------------------------------------------------- @@ -56,8 +50,6 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! implicit none ! - real(kind=kind_phys), intent(in) :: con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt - real(kind=kind_phys), parameter :: zsp_gw = 106.5e3 ! sponge for GWs above the model top real(kind=kind_phys), parameter :: linsat2 = 1.0, dturb_max = 100.0 integer, parameter :: ener_norm =0 @@ -201,23 +193,22 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & iPr_max = max(1.0, iPr_ktgw) gipr = grav* Ipr_ktgw ! -! test for input fields -! - if (mpi_id == master .and. kdt < -2) then - print *, im, levs, dtp, kdt, ' vay-solv2-v1' - print *, minval(tm), maxval(tm), ' min-max-tm ' - print *, minval(vm), maxval(vm), ' min-max-vm ' - print *, minval(um), maxval(um), ' min-max-um ' - print *, minval(qm), maxval(qm), ' min-max-qm ' - print *, minval(prsl), maxval(prsl), ' min-max-Pmid ' - print *, minval(prsi), maxval(prsi), ' min-max-Pint ' - print *, minval(zmet), maxval(zmet), ' min-max-Zmid ' - print *, minval(zmeti), maxval(zmeti), ' min-max-Zint ' - print *, minval(prslk), maxval(prslk), ' min-max-Exner ' - print *, minval(tau_ngw), maxval(tau_ngw), ' min-max-taungw ' - print *, tau_min, ' tau_min ', tamp_mpa, ' tamp_mpa ' +! test for input fields +! if (mpi_id == master .and. kdt < -2) then +! print *, im, levs, dtp, kdt, ' vay-solv2-v1' +! print *, minval(tm), maxval(tm), ' min-max-tm ' +! print *, minval(vm), maxval(vm), ' min-max-vm ' +! print *, minval(um), maxval(um), ' min-max-um ' +! print *, minval(qm), maxval(qm), ' min-max-qm ' +! print *, minval(prsl), maxval(prsl), ' min-max-Pmid ' +! print *, minval(prsi), maxval(prsi), ' min-max-Pint ' +! print *, minval(zmet), maxval(zmet), ' min-max-Zmid ' +! print *, minval(zmeti), maxval(zmeti), ' min-max-Zint ' +! print *, minval(prslk), maxval(prslk), ' min-max-Exner ' +! print *, minval(tau_ngw), maxval(tau_ngw), ' min-max-taungw ' +! print *, tau_min, ' tau_min ', tamp_mpa, ' tamp_mpa ' ! - endif +! endif if (idebug_gwrms == 1) then tauabs=0.0; wrms =0.0 ; trms =0.0 @@ -234,7 +225,9 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & km1 = ksrc - 1 kp1 = ksrc + 1 ktop= levs+1 - suprf(ktop) = kion(levs) + + suprf(ktop) = kion(levs) + do k=1,levs suprf(k) = kion(k) ! approximate 1-st order damping with Fast super-RF of FV3 pdvdt(:,k) = 0.0 @@ -246,8 +239,7 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & !----------------------------------------------------------- ! column-based j=1,im pjysics with 1D-arrays !----------------------------------------------------------- - DO j=1, im - + DO j=1, im jl =j tx1 = omega2 * sinlat(j) *rv_kxw cf1 = abs(tx1) @@ -302,26 +294,26 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! interface mean flow parameters launch -> levs+1 ! --------------------------------------------- do jk= km1,levs - tvc = atm(jk) * (1. +fv*aqm(jk)) - tvm = atm(jk-1) * (1. +fv*aqm(jk-1)) + tvc = atm(jk)*(1. +fv*aqm(jk)) + tvm = atm(jk-1)*(1. +fv*aqm(jk-1)) ptc = tvc/ prslk(jl, jk) ptm = tvm/prslk(jl,jk-1) ! - zthm = 2.0 / (tvc+tvm) + zthm = 2.0/(tvc+tvm) rhp_wam = zthm*gor !interface - uint(jk) = 0.5 *(aum(jk-1)+aum(jk)) - vint(jk) = 0.5 *(avm(jk-1)+avm(jk)) - tint(jk) = 0.5 *(tvc+tvm) + uint(jk) = 0.5*(aum(jk-1)+aum(jk)) + vint(jk) = 0.5*(avm(jk-1)+avm(jk)) + tint(jk) = 0.5*(tvc+tvm) rhomid(jk) = aprsl(jk)*rdi/atm(jk) rhoint(jk) = aprsi(jk)*rdi*zthm ! rho = p/(RTv) zdelp = dz_meti(jk) ! >0 ...... dz-meters v_zmet(jk) = 2.*zdelp ! 2*kzi*[Z_int(k+1)-Z_int(k)] zdelm = 1./dz_met(jk) ! 1/dz ...... 1/meters ! -! bvf2 = grav2 * zdelm * (ptc-ptm)/ (ptc + ptm) ! N2=[g/PT]*(dPT/dz) +! bvf2 = grav2*zdelm*(ptc-ptm)/(ptc + ptm) ! N2=[g/PT]*(dPT/dz) ! - bn2(jk) = grav2cpd*zthm * (1.0+rcpdl*(tvc-tvm)*zdelm) + bn2(jk) = grav2cpd*zthm*(1.0+rcpdl*(tvc-tvm)*zdelm) bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) bn(jk) = sqrt(bn2(jk)) @@ -1015,7 +1007,7 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! RETURN -!================================= +!================================= diag print after "return" ====================== if (kdt ==1 .and. mpi_id == master) then ! print *, ' ugwpv1: nazd-nw-ilaunch=', nazd, nwav,ilaunch, maxval(kvg), ' kvg ' diff --git a/physics/cires_ugwpv1_sporo.F90 b/physics/cires_ugwpv1_sporo.F90 index 98eca419e..c840b49d8 100644 --- a/physics/cires_ugwpv1_sporo.F90 +++ b/physics/cires_ugwpv1_sporo.F90 @@ -1,10 +1,11 @@ subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, & dtp,dxres, taub, u1, v1, t1, xn, yn, bn2, rho, prsi, prsL, & - grav, omega, con_rd, del, sigma, hprime, gamma, theta, & + del, sigma, hprime, gamma, theta, & sinlat, xlatd, taup, taud, pkdis) ! - USE MACHINE , ONLY : kind_phys + use machine , only : kind_phys + use ugwp_common, only : grav, omega2, rd ! implicit none @@ -24,7 +25,6 @@ subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, & real(kind=kind_phys), intent(in), dimension(im, levs) :: & u1, v1, t1, bn2, rho, prsl, del - real(kind=kind_phys), intent(in) :: grav, omega, con_rd real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi ! @@ -44,7 +44,7 @@ subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, & real(kind=kind_phys), parameter :: mkz2min = mkzmin* mkzmin real(kind=kind_phys), parameter :: kedmin = 1.e-3 real(kind=kind_phys), parameter :: kedmax = 350.,axmax=250.e-5 - real(kind=kind_phys), parameter :: rtau = 0.01 ! nonlin-OGW scale 1/10sec + real(kind=kind_phys), parameter :: rtau = 0.01 ! nonlin-OGW scale 1/10sec real(kind=kind_phys), parameter :: Linsat2 =0.5 real(kind=kind_phys), parameter :: kxmin = 6.28e-3/100. real(kind=kind_phys), parameter :: kxmax = 6.28e-3/5.0 @@ -124,12 +124,12 @@ subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, & wkdis(:,:) = kedmin call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), & - & prsi(j,:), prsL(j,:), grav, con_rd, & + & prsi(j,:), prsL(j,:), & & del(j,:), rho(i,:), & & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, & & xn(i), yn(i)) - fcor2 = (2*omega*sinlat(j))*(2*omega*sinlat(j))*fc_flag + fcor2 = omega2*sinlat(j)*omega2*sinlat(j)*fc_flag k = ksrc @@ -152,11 +152,11 @@ subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, & ! ! if (cxoro(iw) > cxmin) then - wave_act(iw,k:levs+1) = 0. ! crit-level + wave_act(iw,k:levs+1) = 0. ! crit-level else cdf2(iw) = cxoro(iw)*cxoro(iw) -c2f2(iw) if ( cdf2(iw) < cxmin2) then - wave_act(iw,k:levs+1) = 0. ! coriolis cut-off + wave_act(iw,k:levs+1) = 0. ! coriolis cut-off else kzw2 = max(Bv2/Cdf2(iw) - akx2(iw), mkz2min) kzw = sqrt(kzw2) @@ -199,7 +199,7 @@ subroutine oro_spectral_solver(im, levs,npt,ipt, kref,kdt,me,master, & wave_act(iw,k:levs+1) = 0.0 else ! -! upward propagation w/o reflection +! upward propagation w/o reflection effects ! kxw = akx(iw) kzw = sqrt(kzw2) @@ -283,18 +283,17 @@ end subroutine oro_spectral_solver ! !------------------------------------------------------------- subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & - & grav, con_rd, & - & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) + & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) use machine , only : kind_phys - use ugwp_common , only : velmin, dw2min + use ugwp_common , only : velmin, dw2min, rdi, grav, rgrav, hpscale, rhp, rh4 implicit none - + integer :: nz, nzi real(kind=kind_phys), dimension(nz ) :: u1, v1, t1, delp, rho, pmid real(kind=kind_phys), dimension(nz ) :: bn2 ! define at the interfaces real(kind=kind_phys), dimension(nz+1) :: pint real(kind=kind_phys) :: xn, yn - real(kind=kind_phys),intent(in) :: grav, con_rd + ! output real(kind=kind_phys), dimension(nz+1) :: dzi, uzi, rhoi, ktur, kalp @@ -303,24 +302,23 @@ subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & integer :: i, j, k real(kind=kind_phys) :: ui, vi, ti, uz, vz, shr2, rdz, kamp real(kind=kind_phys) :: zgrow, zmet, rdpm, ritur, kmol, w1 - real(kind=kind_phys) :: rgrav, rdi + ! paremeters - real(kind=kind_phys), parameter :: hps = 7000., rpspa = 1.e-5 - real(kind=kind_phys), parameter :: rhps=1.0/hps - real(kind=kind_phys), parameter :: h4= 0.25/hps - real(kind=kind_phys), parameter :: rimin = 1.0/8.0, kedmin = 0.01 - real(kind=kind_phys), parameter :: lturb = 30. , uturb = 150.0 +! real(kind=kind_phys), parameter :: hps = 7000., rpspa = 1.e-5 +! real(kind=kind_phys), parameter :: rhps=1.0/hps +! real(kind=kind_phys), parameter :: h4= 0.25/hps + + real(kind=kind_phys), parameter :: rimin = 0.125, kedmin = 0.01 + real(kind=kind_phys), parameter :: lturb = 30. , uturb = 150.0 real(kind=kind_phys), parameter :: lsc2 = lturb*lturb,usc2 = uturb*uturb - kalp(1:nzi) = 2.e-7 ! radiative damping - - rgrav = 1.0/grav - rdi = 1.0/con_rd + + kalp(1:nzi) = 2.e-7 ! radiative damping scale do k=2, nz rdpm = grav/(pmid(k-1)-pmid(k)) ui = .5*(u1(k-1)+u1(k)) vi = .5*(v1(k-1)+v1(k)) - uzi(k) = Ui*xn + Vi*yn + uzi(k) = ui*xn + vi*yn ti = .5*(t1(k-1)+t1(k)) rhoi(k) = rdi*pint(k)/ti rdz = rdpm *rhoi(k) @@ -328,13 +326,13 @@ subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, & uz = u1(k)-u1(k-1) vz = v1(k)-v1(k-1) shr2 = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) - zmet = -hps*alog(pint(k)*rpspa) - zgrow = exp(zmet*h4) - kmol = 2.e-5*exp(zmet*rhps)+kedmin + zmet = -hpscale*alog(pint(k)*1.e-5) + zgrow = exp(zmet*rh4) + kmol = 2.e-5*exp(zmet*rhp) + kedmin ritur = max(bn2(k)/shr2, rimin) kamp = sqrt(shr2)*lsc2 *zgrow w1 = 1./(1. + 5*ritur) - ktur(k) = kamp * w1 * w1 +kmol + ktur(k) = kamp * w1 * w1 + kmol enddo k = 1 diff --git a/physics/cires_ugwpv1_triggers.F90 b/physics/cires_ugwpv1_triggers.F90 index db95a4f87..3c42e573b 100644 --- a/physics/cires_ugwpv1_triggers.F90 +++ b/physics/cires_ugwpv1_triggers.F90 @@ -4,7 +4,6 @@ module cires_ugwpv1_triggers contains - ! ! ! @@ -177,87 +176,8 @@ subroutine slat_geos5(im, xlatdeg, tau_gw) tau_gw(i) = tau_amp*flat_gw enddo ! - end subroutine slat_geos5 - - subroutine init_nazdir(con_pi, naz, xaz, yaz) - implicit none - real(kind=kind_phys) :: con_pi - integer :: naz - real(kind=kind_phys), dimension(naz) :: xaz, yaz - integer :: idir - real(kind=kind_phys) :: phic, drad - real(kind=kind_phys) :: pi2 - pi2 = 2.0*con_pi - drad = pi2/float(naz) - if (naz.ne.4) then - do idir =1, naz - Phic = drad*(float(idir)-1.0) - xaz(idir) = cos(Phic) - yaz(idir) = sin(Phic) - enddo - else -! if (naz.eq.4) then - xaz(1) = 1.0 !E - yaz(1) = 0.0 - xaz(2) = 0.0 - yaz(2) = 1.0 !N - xaz(3) =-1.0 !W - yaz(3) = 0.0 - xaz(4) = 0.0 - yaz(4) =-1.0 !S - endif - end subroutine init_nazdir -!========================================================================= -! Below subroutine that can be activated after "testing" and extra-work" -!========================================================================= - subroutine emc_modulation(im , levs, ntke, tau_ngw, cdmb3, cdmb4, dtp, & - q_tke, dqdt_tke, del, rain) - - integer, intent(in) :: im , levs, ntke - real(kind=kind_phys), intent(in) :: cdmb3, cdmb4, dtp - real(kind=kind_phys), intent(in) :: rain(im) - real(kind=kind_phys), intent(inout) :: tau_ngw(im) - real(kind=kind_phys), intent(in), dimension(im,levs) :: q_tke, dqdt_tke, del - -! locals - - - real(kind=kind_phys) :: turb_fac, tem - real(kind=kind_phys) :: rfac, tx1, tke - + end subroutine slat_geos5 -!============ -! -! below the "EMC-proposal" in May 2019 without rigorous tests reported elsewhere -! can be eliminated due to "lack" of validations and -! in GFSv16 cdmbgwd(3) =1.0 and the next if-loop is "cosmetic" proposal -! -!============ - if (1.0-cdmb3 > 1.0e-6) then - rfac = 86400000. / dtp !??? -! -! in operations cdmbgwd(3) = 1 in GFSv16, and code below is not executed -! - if (cdmb4 > 0.0) then - do i=1,im - turb_fac = 0.0 - if (ntke > 0) then - tem = 0.0 - do k=1,(levs+levs)/3 ! ???? - tke = q_tke(i,k) + dqdt_tke(i,k) * dtp - turb_fac = turb_fac + del(i,k) * tke - tem = tem + del(i,k) - enddo - turb_fac = turb_fac / tem - endif - tx1 = cdmb4*min(10.0, max(turb_fac,rain(i)*rfac)) - tau_ngw(i) = tau_ngw(i) * max(0.1, min(5.0, tx1)) * cdmb3 !???? - enddo - endif - endif - end subroutine emc_modulation - - !=============================================== ! ! Spontaneous GW triggers by dynamical inbalances (OKW, fronts/jets, and convection) diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 252838ca1..20ab38897 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -37,22 +37,14 @@ module ugwpv1_gsldrag use machine, only: kind_phys + use cires_ugwpv1_triggers, only: slat_geos5_2020, slat_geos5_tamp_v1 - use cires_ugwpv1_module, only: cires_ugwpv1_init, ngwflux_update, calendar_ugwp - use cires_ugwpv1_module, only: knob_ugwp_version, cires_ugwp_dealloc, tamp_mpa - use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2 - use cires_ugwpv1_oro, only: orogw_v1 -! use cires_ugwp1_sporo, only: oro_spectral_solver - - use drag_suite, only: drag_suite_run - -! use cires_ugwpv1_triggers, only: get_spectra_tau_convgw, get_spectra_tau_okw, get_spectra_tau_nstgw -! use cires_ugwp_orolm97_v1, only: gwdps_oro_v1 -! use cires_ugwp_triggers_v1, only: slat_geos5_tamp_v1 -! use cires_ugwp_solv2_v1_mod, only: cires_ugwp_solv2_v1 -! use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize -! use cires_ugwp_module_v1, only: cires_ugwp_init_v1, cires_ugwp_finalize, calendar_ugwp -! use gwdps, only: gwdps_run + use cires_ugwpv1_module, only: cires_ugwpv1_init, ngwflux_update, calendar_ugwp + use cires_ugwpv1_module, only: knob_ugwp_version, cires_ugwp_dealloc, tamp_mpa + use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2 + use cires_ugwpv1_oro, only: orogw_v1 + + use drag_suite, only: drag_suite_run implicit none @@ -77,10 +69,13 @@ subroutine ugwpv1_gsldrag_init ( & me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, & con_pi, con_rerth, con_p0, & + con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, & do_ugwp,do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, errmsg, errflg) + use ugwp_common + !---- initialization of unified_ugwp implicit none @@ -97,6 +92,7 @@ subroutine ugwpv1_gsldrag_init ( & real(kind=kind_phys), intent (in) :: dtp real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth + real(kind=kind_phys), intent(in) :: con_g, con_cp, con_rd, con_rv, con_omega, con_fvirt logical, intent (in) :: do_ugwp logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & @@ -118,12 +114,32 @@ subroutine ugwpv1_gsldrag_init ( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 -!============================================= -! 3 cases for ORO-schemes + NGWs: -! gwd_opt => "1 and 2, 3, 22, 33' +!============================================================================ +! +! gwd_opt => "1 and 2, 3, 22, 33' see previous GSL-commits +! related to GSL-oro drag suite +! for use of the new-GSL/old-GFS/EMC inputs for sub-grid orography +! see details inside /ufs-weather-model/FV3/io/FV3GFS_io.F90 +! FV3GFS_io.F90: if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & +! FV3GFS_io.F90: Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then +! FV3GFS_io.F90: if ( (Model%gwd_opt==3 .or. Model%gwd_opt==33) .or. & +! FV3GFS_io.F90: ( (Model%gwd_opt==2 .or. Model%gwd_opt==22) .and. & +! +! gwd_opt=1 -current 14-element GFS-EMC subgrid-oro input +! gwd_opt=2 and 3 24-element -current 14-element GFS-EMC subgrid-oro input +! GSL uses the gwd_opt flag to control "extra" diagnostics (22 and 33) +! CCPP may use gwd_opt to determine 14 or 24 variables for the input +! but at present you work with "nmtvr" +! GFS_GWD_generic.F90: integer, intent(in) :: im, levs, nmtvr +!GFS_GWD_generic.F90: real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) +!GFS_GWD_generic.F90: if (nmtvr == 14) then ! gwd_opt=1 current operational - as of 2014 +!GFS_GWD_generic.F90: elseif (nmtvr == 10) then ???? +!GFS_GWD_generic.F90: elseif (nmtvr == 6) then ???? +!GFS_GWD_generic.F90: elseif (nmtvr == 24) then ! GSD_drag_suite and unified_ugwp gwd_opt=2,3 +! ! 1) gsldrag: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1 -! 2) CIRES-v1: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp -!============================================= +! 2) CIRES-v1: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp +!============================================================================== ! Test to make sure that at most only one large-scale/blocking ! orographic drag scheme is chosen if ( (do_ugwp_v0.and.(do_ugwp_v0_orog_only.or.do_gsl_drag_ls_bl.or. & @@ -140,7 +156,7 @@ subroutine ugwpv1_gsldrag_init ( & return end if - +! if ( do_ugwp_v0_orog_only .or. do_ugwp_v0) then print *, ' ccpp do_ugwp_v0 active ', do_ugwp_v0 print *, ' ccpp do_ugwp_v1_orog_only active ', do_ugwp_v0_orog_only @@ -149,6 +165,7 @@ subroutine ugwpv1_gsldrag_init ( & errflg = 1 return endif +! if (do_ugwp_v1_w_gsldrag .and. do_ugwp_v1_orog_only ) then print *, ' do_ugwp_v1_w_gsldrag ', do_ugwp_v1_w_gsldrag @@ -159,7 +176,57 @@ subroutine ugwpv1_gsldrag_init ( & errflg = 1 return endif - if (is_initialized) return +!========================== +! +! initialize ugwp_common +! con_pi, con_rerth, con_p0, con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt +! +!========================== + + pi = con_pi + arad = con_rerth + p0s = con_p0 + grav = con_g + omega1= con_omega + cpd = con_cp + rd = con_rd + rv = con_rv + fv = con_fvirt + + grav2 = grav + grav; rgrav = 1.0/grav ; rgrav2 = rgrav*rgrav + rdi = 1.0 / rd ; rcpd = 1./cpd; rcpd2 = 0.5/cpd + gor = grav/rd + gr2 = grav*gor + grcp = grav*rcpd + gocp = grcp + rcpdl = cpd*rgrav + grav2cpd = grav*grcp + + pi2 = 2.*pi ; pih = .5*pi + rad_to_deg=180.0/pi + deg_to_rad=pi/180.0 + + bnv2min = (pi2/1800.)*(pi2/1800.) + bnv2max = (pi2/30.)*(pi2/30.) + dw2min = 1.0 + velmin = sqrt(dw2min) + minvel = 0.5 + + omega2 = 2.*omega1 + omega3 = 3.*omega1 + + hpscale = 7000. ; hpskm = hpscale*1.e-3 + rhp = 1./hpscale + rhp2 = 0.5*rhp; rh4 = 0.25*rhp + rhp4 = rhp2 * rhp2 + khp = rhp* rd/cpd + mkzmin = pi2/80.0e3 + mkz2min = mkzmin*mkzmin + mkzmax = pi2/500. + mkz2max = mkzmax*mkzmax + cdmin = 2.e-2/mkzmax + + rcpdt = rcpd/dtp if ( do_ugwp_v1 ) then call cires_ugwpv1_init (me, master, nlunit, logunit, jdat, con_pi, & @@ -177,7 +244,9 @@ subroutine ugwpv1_gsldrag_init ( & print *, ' ccpp: ugwpv1_gsldrag_init ' endif + + is_initialized = .true. @@ -238,7 +307,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, do_gsl_drag_ss, & do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, & gwd_opt, do_tofd, ldiag_ugwp, cdmbgwd, jdat, & - con_g, con_omega, con_pi, con_cp, con_rd, con_rv, con_rerth, con_fvirt, & +! con_g, con_omega, con_pi, con_cp, con_rd, con_rv, con_rerth, con_fvirt, & nmtvr, hprime, oc, theta, sigma, gamma, elvmax, clx, oa4, & varss,oc1ss,oa4ss,ol4ss, dx, xlat, xlat_d, sinlat, coslat, area, & rain, br1, hpbl, kpbl, slmsk, & @@ -252,32 +321,31 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, dudt, dvdt, dtdt, rdxzb, & ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw, & lprnt, ipr, errmsg, errflg) - -! old data: jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & -! cap: dt3dt(i,k) = dt3dt(i,k) - dtdt(i,k)*dtf -! ! !######################################################################## ! Attention New Arrays and Names must be ADDED inside ! -! a) /FV3/gfsphysics/GFS_layer/GFS_typedefs.meta -! b) /FV3/gfsphysics/GFS_layer/GFS_typedefs.F90 -! c) /FV3/gfsphysics/GFS_layer/GFS_diagnostics.F90 -!######################################################################## -![ccpp-table-properties] -! name = GFS_interstitial_type -! type = ddt +! a) /FV3/gfsphysics/GFS_layer/GFS_typedefs.meta +! b) /FV3/gfsphysics/GFS_layer/GFS_typedefs.F90 +! c) /FV3/gfsphysics/GFS_layer/GFS_diagnostics.F90 "diag-cs is not tested" !######################################################################## -! -! + +! + + use ugwp_common, only : con_pi => pi, con_g => grav, con_rd => rd, & + con_rv => rv, con_cp => cpd, con_fv => fv, & + con_rerth => arad, con_omega => omega1, rgrav + implicit none -! Preference use (im,levs) rather than (:,:) to avoid memory-leaks -! order description control-logical -! other in-variables -! out-variables -! local-variables -! unified diagnostics inside CCPP and GFS_typedefs.F90/GFS_diagnostics.F90 +! Preference use (im,levs) rather than (:,:) to avoid memory-leaks +! that found in Nov-Dec 2020 +! order array-description control-logical +! other in-variables +! out-variables +! local-variables +! +! unified GSL and CIRES diagnostics inside CCPP and GFS_typedefs.F90/GFS_diagnostics.F90 ! ! ! interface variables @@ -298,9 +366,9 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd integer, intent(in) :: kdt, jdat(8) ! SSO parameters and variables - integer, intent(in) :: gwd_opt + integer, intent(in) :: gwd_opt !gwd_opt and nmtvr are "redundant" controls integer, intent(in) :: nmtvr - real(kind=kind_phys), intent(in) :: cdmbgwd(4) ! in gsl_drag + real(kind=kind_phys), intent(in) :: cdmbgwd(4) ! for gsl_drag real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc, theta, sigma, gamma @@ -311,13 +379,13 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd real(kind=kind_phys), intent(in), dimension(im, 4) :: oa4ss,ol4ss !===== -!ccpp-style passing constants +!ccpp-style passing constants, I prefer to take them out from the "call-subr" list !===== - real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, & - con_rv, con_rerth, con_fvirt +! real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, & +! con_rv, con_rerth, con_fvirt ! grids - real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlat_d, sinlat, coslat, area + real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlat_d, sinlat, coslat, area ! State vars + PBL/slmsk +rain @@ -392,9 +460,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! switches that activate impact of OGWs and NGWs ! integer :: nmtvr_temp - - real(kind=kind_phys) :: inv_g - + real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces @@ -419,13 +485,12 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! ! for all oro-suites can uze geo-meters having "hpbl" ! - inv_g = 1./con_g ! ! All GW-schemes operate with Zmet =phil*inv_g, passing Zmet/Zmeti can be more robust ! + rho*dz = =delp * inv_g can be also pre-comp for all "GW-schemes" ! - zmeti = phii*inv_g - zmet = phil*inv_g + zmeti = phii* rgrav + zmet = phil* rgrav !=============================================================== ! ORO-diag @@ -452,8 +517,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd zlwb(:)= 0. ; zogw(:)=0. ; zobl(:)=0. ; zngw(:)=0. !=============================================================== -! Accumulated tendencies due to 3-SSO schemes (all ORO-physics) -! ogw + obl +oss +ofd ..... no explicit "lee wave trapping" +! diag tendencies due to all-SSO schemes (ORO-physics) +! ogw + obl + oss + ofd ..... no explicit "lee wave trapping" !=============================================================== do k=1,levs do i=1,im @@ -464,25 +529,18 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd enddo enddo ! -! ------------------ -! -! Also zero all ORO diag-c arrays to avoid "special ifs and zeros" -! like old GFS-ORO gwdps_run has limited diagnostics -! -! ------------------ - ! Run the appropriate large-scale (large-scale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd & .or. do_ugwp_v1_w_gsldrag) then ! -! the zero diag and tendency values assigned inside "drag_suite_run" can be skipped : +! to do: the zero diag and tendency values assigned inside "drag_suite_run" can be skipped : ! ! dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl,dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd ! du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, du_osscol, dv_osscol, du_ofdcol dv_ofdcol ! dusfcg, dvsfcg -! gsd_diss_ht_opt =0 => Pdtdt = bl+ls +(Pdtdt=0) +! ! call drag_suite_run(im,levs, Pdvdt, Pdudt, Pdtdt, & ugrs,vgrs,tgrs,q1, & @@ -494,21 +552,21 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd dusfcg, dvsfcg, & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & - slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & - con_fvirt,con_pi,lonr, & + slmsk,br1,hpbl, con_g,con_cp,con_rd,con_rv, & + con_fv, con_pi, lonr, & cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & errmsg,errflg) ! ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol ! - if (kdt <= 2 .and. me == master) then - print *, ' unified drag_suite_run ', kdt - print *, ' GSL drag du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 - print *, ' GSL drag dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 - +! if (kdt <= 2 .and. me == master) then +! print *, ' unified drag_suite_run ', kdt +! print *, ' GSL drag du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 +! print *, ' GSL drag dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 +! ! zero print *, ' unified drag_GSL dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 - +! ! if (gwd_opt == 22 .or. gwd_opt == 33) then ! print *, ' unified drag_GSL dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 ! print *, ' unified drag_GSL dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 @@ -519,7 +577,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! print *, ' unified drag_GSL dUOfd/dt ', maxval(dudt_ofd)*86400, minval(dudt_ofd)*86400 ! print *, ' unified drag_GSL dVOfd/dt ', maxval(dvdt_ofd)*86400, minval(dvdt_ofd)*86400 ! endif - endif +! endif else ! @@ -539,8 +597,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd if (gwd_opt >1 ) sgh30 = varss ! as in gsldrag: see drag_suite_run call orogw_v1 (im, levs, lonr, me, master,dtp, kdt, do_tofd, & - con_g, con_omega, con_rd, con_cp, con_rv,con_pi, & - con_rerth, con_fvirt,xlat_d, sinlat, coslat, area, & + xlat_d, sinlat, coslat, area, & cdmbgwd(1:2), hprime, oc, oa4, clx, theta, & sigma, gamma, elvmax, sgh30, kpbl, ugrs, & vgrs, tgrs, q1, prsi,del,prsl,prslk, zmeti, zmet, & @@ -553,21 +610,20 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! orogw_v1: dusfcg = du_ogwcol + du_oblcol + du_ofdcol only 3 terms ! ! - if (kdt <= 2 .and. me == master) then +! if (kdt <= 2 .and. me == master) then +! +! print *, ' unified_ugwp orogw_v1 ', kdt, me, nmtvr +! print *, ' unified_ugwp orogw_v1 du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 +! print *, ' unified_ugwp orogw_v1 dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 +! print *, ' unified_ugwp orogw_v1 dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 +! print *, ' unified_ugwp orogw_v1 dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 +! print *, ' unified_ugwp orogw_v1 dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 +! endif - print *, ' unified_ugwp orogw_v1 ', kdt, me, nmtvr - print *, ' unified_ugwp orogw_v1 du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 - print *, ' unified_ugwp orogw_v1 dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 - print *, ' unified_ugwp orogw_v1 dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 - print *, ' unified_ugwp orogw_v1 dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 - print *, ' unified_ugwp orogw_v1 dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 - endif - -! pdudt = 0.0*pdudt ; pdvdt = 0.0*pdvdt ; pdtdt = 0. end if ! -! GFS-style diag dt3dt(:.:, 1:14) +! for old-fashioned GFS-style diag-cs like dt3dt(:.:, 1:14) collections ! if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then do k=1,levs @@ -591,14 +647,11 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd !================================================================== ! call slat_geos5_tamp_v1(im, tamp_mpa, xlat_d, tau_ngw) ! -! updates of MERRA/GEOS tau_ngw for the C96-QBO FV3GFS-127L runs +! 2020 updates of MERRA/GEOS tau_ngw for the C96-QBO FV3GFS-127L runs !================================================================== - call slat_geos5_2020(im, tamp_mpa, xlat_d, tau_ngw) -! if (me == master) then -! print *, ' ugwpv1 forcing ', maxval(tau_ngw), minval(tau_ngw) -! print *, ' ugwpv1 forcing tamp_mpa ', tamp_mpa -! endif + call slat_geos5_2020(im, tamp_mpa, xlat_d, tau_ngw) + y4 = jdat(1); month = jdat(2); day = jdat(3) ! ! hour = jdat(5) @@ -616,23 +669,21 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, & tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, & zmet, zmeti,prslk, xlat_d, sinlat, coslat, & - con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt, & dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw) - - - if (me == master .and. kdt <= 2) then - print * - write(6,*)'FV3GFS finished fv3_ugwp_solv2_v1 ' +! +! => con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt +! +! if (me == master .and. kdt <= 2) then +! print * +! write(6,*)'FV3GFS finished fv3_ugwp_solv2_v1 ' ! write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' - print * - - print *, ' ugwp_v1 ', kdt - print *, ' ugwp_v1 du/dt ', maxval(dudt_ngw)*86400, minval(dudt_ngw)*86400 - print *, ' ugwp_v1 dv/dt ', maxval(dvdt_ngw)*86400, minval(dvdt_ngw)*86400 - print *, ' ugwp_v1 dT/dt ', maxval(dtdt_ngw)*86400, minval(dtdt_ngw)*86400 - - - endif +! print * +! +! print *, ' ugwp_v1 ', kdt +! print *, ' ugwp_v1 du/dt ', maxval(dudt_ngw)*86400, minval(dudt_ngw)*86400 +! print *, ' ugwp_v1 dv/dt ', maxval(dvdt_ngw)*86400, minval(dvdt_ngw)*86400 +! print *, ' ugwp_v1 dT/dt ', maxval(dtdt_ngw)*86400, minval(dtdt_ngw)*86400 +! endif end if ! do_ugwp_v1 @@ -657,10 +708,9 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd dvdt_gw = Pdvdt +dvdt_ngw dtdt_gw = Pdtdt +dtdt_ngw kdis_gw = Pkdis +kdis_ngw -! -! add to previous phys-tendencies -! ?-accumulation of GFS ( pbl + gw =0 rf should be taken out from physics, inside FV3-dycore) - +! +! accumulate "tendencies" as in the GFS-ipd (pbl + ugwp + zero-RF) +! dudt = dudt + dudt_ngw dvdt = dvdt + dvdt_ngw dtdt = dtdt + dtdt_ngw diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta index 73d717f78..1cfec2104 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -64,6 +64,8 @@ units = none dimensions = (8) type = integer + intent = in + optional = F [lonr] standard_name = number_of_equatorial_longitude_points long_name = number of global points in x-dir (i) along the equator @@ -142,6 +144,60 @@ kind = kind_phys intent = in optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_omega] + standard_name = angular_velocity_of_earth + long_name = angular velocity of earth + units = s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat !of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [do_ugwp] standard_name = do_ugwp long_name = flag to activate CIRES UGWP @@ -445,78 +501,6 @@ type = integer intent = in optional = F -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_omega] - standard_name = angular_velocity_of_earth - long_name = angular velocity of earth - units = s-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_pi] - standard_name = pi - long_name = ratio of a circle's circumference to its diameter - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat !of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_rd] - standard_name = gas_constant_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_rv] - standard_name = gas_constant_water_vapor - long_name = ideal gas constant for water vapor - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_rerth] - standard_name = radius_of_earth - long_name = radius of earth - units = m - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F -[con_fvirt] - standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one - long_name = rv/rd - 1 (rv = ideal gas constant for water vapor) - units = none - dimensions = () - type = real - kind = kind_phys - intent = in - optional = F [nmtvr] standard_name = number_of_statistical_measures_of_subgrid_orography long_name = number of topographic variables in GWD From a5547cb6785de3c990a62bb3ee5aea5fa32a93be Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 26 Jan 2021 10:50:39 -0700 Subject: [PATCH 184/274] Fix formatting in physics/GFS_phys_time_vary.fv3.F90 --- physics/GFS_phys_time_vary.fv3.F90 | 48 ++++++++++++++++-------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 04f191fdf..b0f88695b 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -81,7 +81,6 @@ subroutine GFS_phys_time_vary_init ( integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) - logical, intent(in) :: do_ugwp_v1 real(kind_phys), intent(inout) :: ddy_j1tau(:), ddy_j2tau(:) integer, intent(inout) :: jindx1_tau(:), jindx2_tau(:) @@ -108,7 +107,7 @@ subroutine GFS_phys_time_vary_init ( !$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & !$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & !$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & -!$OMP shared (do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau) & +!$OMP shared (do_ugwp_v1,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) & !$OMP private (ix,i,j) !$OMP sections @@ -185,11 +184,13 @@ subroutine GFS_phys_time_vary_init ( ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif -!$OMP section + +!$OMP section !> - Call tau_amf dats for ugwp_v1 - if (do_ugwp_v1) then - call read_tau_amf(me, master, errmsg, errflg) - endif + if (do_ugwp_v1) then + call read_tau_amf(me, master, errmsg, errflg) + endif + !$OMP end sections ! Need an OpenMP barrier here (implicit in "end sections") @@ -224,12 +225,14 @@ subroutine GFS_phys_time_vary_init ( jindx2_ci, ddy_ci, xlon_d, & iindx1_ci, iindx2_ci, ddx_ci) endif + !$OMP section !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs if (do_ugwp_v1) then call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & ddy_j1tau, ddy_j2tau) endif + !$OMP section !--- initial calculation of maps local ix -> global i and j ix = 0 @@ -292,7 +295,7 @@ subroutine GFS_phys_time_vary_timestep_init ( tsfc, tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, zorli, zorll, & zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, stype, shdmin, shdmax, snowd, & cv, cvb, cvt, oro, oro_uf, xlat_d, xlon_d, slmsk, & - do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) + do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf, errmsg, errflg) implicit none @@ -316,19 +319,17 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in) :: prsl(:,:) integer, intent(in) :: seed0 real(kind_phys), intent(inout) :: rann(:,:) - + logical, intent(in) :: do_ugwp_v1 integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) - real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) - real(kind_phys), intent(inout) :: tau_amf(:) - + real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) + real(kind_phys), intent(inout) :: tau_amf(:) + ! For gcycle only integer, intent(in) :: nthrds, nx, ny, nsst, tile_num, nlunit, lsoil integer, intent(in) :: lsoil_lsm, kice, ialb, isot, ivegsrc character(len=*), intent(in) :: input_nml_file(:) - logical, intent(in) :: use_ufo, nst_anl, frac_grid - real(kind_phys), intent(in) :: fhcyc, phour, lakefrac(:), min_seaice, min_lakeice, & xlat_d(:), xlon_d(:) real(kind_phys), intent(inout) :: smc(:,:), slc(:,:), stc(:,:), smois(:,:), sh2o(:,:), & @@ -337,7 +338,7 @@ subroutine GFS_phys_time_vary_timestep_init ( facsf(:), facwf(:), alvsf(:), alvwf(:), alnsf(:), alnwf(:), & zorli(:), zorll(:), zorlo(:), weasd(:), slope(:), snoalb(:), & canopy(:), vfrac(:), vtype(:), stype(:), shdmin(:), shdmax(:), & - snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) + snowd(:), cv(:), cvb(:), cvt(:), oro(:), oro_uf(:), slmsk(:) ! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -431,13 +432,14 @@ subroutine GFS_phys_time_vary_timestep_init ( iindx2_ci, ddx_ci, & levs, prsl, in_nm, ccn_nm) endif - + !> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that resolve GW-activ if (do_ugwp_v1) then - call tau_amf_interp(me, master, im, idate,fhour, & - jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, tau_amf) + call tau_amf_interp(me, master, im, idate, fhour, & + jindx1_tau, jindx2_tau, & + ddy_j1tau, ddy_j2tau, tau_amf) endif - + !> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs if (nscyc > 0) then if (mod(kdt,nscyc) == 1) THEN @@ -512,12 +514,12 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (allocated(ciplin) ) deallocate(ciplin) if (allocated(ccnin) ) deallocate(ccnin) if (allocated(ci_pres) ) deallocate(ci_pres) - - ! Deallocate UGWP-input arrays - if (allocated (ugwp_taulat)) deallocate(ugwp_taulat) - if (allocated (tau_limb)) deallocate (tau_limb) + + ! Deallocate UGWP-input arrays + if (allocated (ugwp_taulat)) deallocate(ugwp_taulat) + if (allocated (tau_limb)) deallocate (tau_limb) if (allocated (days_limb)) deallocate(days_limb) - + is_initialized = .false. end subroutine GFS_phys_time_vary_finalize From 4c42f034d48485f3e8733fd4ebc631204e8cd7ed Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 26 Jan 2021 20:40:52 -0700 Subject: [PATCH 185/274] update SCM-only time-vary schemes to use timestep_init phase (revert CMakeLists.txt change in order to compile?) --- CMakeLists.txt | 9 +- physics/GFS_phys_time_vary.scm.F90 | 638 ++++++++++++----------- physics/GFS_phys_time_vary.scm.meta | 782 +++++++++++++++++++++++++--- physics/GFS_rad_time_vary.scm.F90 | 160 +++--- physics/GFS_rad_time_vary.scm.meta | 218 +++++++- physics/GFS_time_vary_pre.scm.F90 | 12 +- physics/GFS_time_vary_pre.scm.meta | 2 +- 7 files changed, 1347 insertions(+), 474 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 441f047f6..4dedf715a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -72,7 +72,8 @@ set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) if(TYPEDEFS) message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") else(TYPEDEFS) - include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) + #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) + include(./CCPP_TYPEDEFS.cmake) message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") endif(TYPEDEFS) @@ -88,7 +89,8 @@ set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") else(SCHEMES) - include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) + #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) + include(./CCPP_SCHEMES.cmake) message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") endif(SCHEMES) @@ -97,7 +99,8 @@ set(CAPS $ENV{CCPP_CAPS}) if(CAPS) message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") else(CAPS) - include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) + #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) + include(./CCPP_CAPS.cmake) message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") endif(CAPS) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 7f2377397..a1acc3fa0 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -1,19 +1,27 @@ -!> \file GFS_phys_time_vary.F90 +!> \file GFS_phys_time_vary.scm.F90 !! Contains code related to GFS physics suite setup (physics part of time_vary_step) +!>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update +!! This module contains GFS physics time vary subroutines including ozone, stratospheric water vapor, +!! aerosol, IN&CCN and surface properties updates. +!> @{ module GFS_phys_time_vary + + use machine, only : kind_phys - use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin - use ozinterp, only : read_o3data, setindxoz, ozinterpol + use mersenne_twister, only: random_setseed, random_number - use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin - use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol + use ozne_def, only : levozp, oz_coeff, oz_lat, oz_pres, oz_time, ozplin + use ozinterp, only : read_o3data, setindxoz, ozinterpol - use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm - use aerinterp, only : read_aerdata, setindxaer, aerinterpol + use h2o_def, only : levh2o, h2o_coeff, h2o_lat, h2o_pres, h2o_time, h2oplin + use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol - use iccn_def, only : ciplin, ccnin, ci_pres - use iccninterp, only : read_cidata, setindxci, ciinterpol + use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm + use aerinterp, only : read_aerdata, setindxaer, aerinterpol + + use iccn_def, only : ciplin, ccnin, ci_pres + use iccninterp, only : read_cidata, setindxci, ciinterpol #if 0 !--- variables needed for calculating 'sncovr' @@ -24,376 +32,400 @@ module GFS_phys_time_vary private - public GFS_phys_time_vary_init, GFS_phys_time_vary_run, GFS_phys_time_vary_finalize + public GFS_phys_time_vary_init, GFS_phys_time_vary_timestep_init, GFS_phys_time_vary_timestep_finalize, GFS_phys_time_vary_finalize logical :: is_initialized = .false. + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + contains !> \section arg_table_GFS_phys_time_vary_init Argument Table !! \htmlinclude GFS_phys_time_vary_init.html !! - subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errflg) - - use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_Tbd_type, GFS_interstitial_type +!>\section gen_GFS_phys_time_vary_init GFS_phys_time_vary_init General Algorithm +!! @{ + subroutine GFS_phys_time_vary_init ( & + me, master, ntoz, h2o_phys, iaerclm, iccn, iflip, im, nx, ny, idate, xlat_d, xlon_d, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & + jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & + errmsg, errflg) implicit none ! Interface variables - type(GFS_grid_type), intent(inout) :: Grid - type(GFS_control_type), intent(in) :: Model - type(GFS_interstitial_type), intent(inout) :: Interstitial - type(GFS_tbd_type), intent(in) :: Tbd - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny + logical, intent(in) :: h2o_phys, iaerclm + integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) + + integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(inout) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(inout) :: ddy_aer(:), ddx_aer(:) + real(kind_phys), intent(in) :: aer_nm(:,:,:) + integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) + integer, intent(inout) :: imap(:), jmap(:) + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! Local variables - integer :: i, j, ix, nb, nt + integer :: i, j, ix ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (is_initialized) return - - nb = 1 - nt = 1 - call read_o3data (Model%ntoz, Model%me, Model%master) +!> - Call read_o3data() to read ozone data + call read_o3data (ntoz, me, master) ! Consistency check that the hardcoded values for levozp and ! oz_coeff in GFS_typedefs.F90 match what is set by read_o3data - ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) - if (size(Tbd%ozpl, dim=2).ne.levozp) then + ! in GFS_typedefs.F90: allocate (Tbd%ozpl (IM,levozp,oz_coeff)) + if (size(ozpl, dim=2).ne.levozp) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levozp from read_o3data does not match value in GFS_typedefs.F90: ", & - levozp, " /= ", size(Tbd%ozpl, dim=2) + levozp, " /= ", size(ozpl, dim=2) errflg = 1 end if - if (size(Tbd%ozpl, dim=3).ne.oz_coeff) then + if (size(ozpl, dim=3).ne.oz_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "oz_coeff from read_o3data does not match value in GFS_typedefs.F90: ", & - oz_coeff, " /= ", size(Tbd%ozpl, dim=3) + oz_coeff, " /= ", size(ozpl, dim=3) errflg = 1 end if - - call read_h2odata (Model%h2o_phys, Model%me, Model%master) - + +!> - Call read_h2odata() to read stratospheric water vapor data + call read_h2odata (h2o_phys, me, master) + ! Consistency check that the hardcoded values for levh2o and ! h2o_coeff in GFS_typedefs.F90 match what is set by read_o3data ! in GFS_typedefs.F90: allocate (Tbd%h2opl (IM,levh2o,h2o_coeff)) - if (size(Tbd%h2opl, dim=2).ne.levh2o) then + if (size(h2opl, dim=2).ne.levh2o) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "levh2o from read_h2odata does not match value in GFS_typedefs.F90: ", & - levh2o, " /= ", size(Tbd%h2opl, dim=2) + levh2o, " /= ", size(h2opl, dim=2) errflg = 1 end if - if (size(Tbd%h2opl, dim=3).ne.h2o_coeff) then + if (size(h2opl, dim=3).ne.h2o_coeff) then write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & "h2o_coeff from read_h2odata does not match value in GFS_typedefs.F90: ", & - h2o_coeff, " /= ", size(Tbd%h2opl, dim=3) + h2o_coeff, " /= ", size(h2opl, dim=3) errflg = 1 - end if - - if (Model%iaerclm) then - ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 - ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def - if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then - write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & - "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & - ntrcaerm, " /= ", size(Tbd%aer_nm, dim=3) - errflg = 1 - else - ! Update the value of ntrcaer in aerclm_def with the value defined - ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm - ntrcaer = size(Tbd%aer_nm, dim=3) - ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) - if (errflg/=0) return - endif + end if + +!> - Call read_aerdata() to read aerosol climatology + if (iaerclm) then + ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 + ! and used to allocate aer_nm matches the value defined in aerclm_def + if (size(aer_nm, dim=3).ne.ntrcaerm) then + write(errmsg,'(2a,i0,a,i0)') "Value error in GFS_phys_time_vary_init: ", & + "ntrcaerm from aerclm_def does not match value in GFS_typedefs.F90: ", & + ntrcaerm, " /= ", size(aer_nm, dim=3) + errflg = 1 + else + ! Update the value of ntrcaer in aerclm_def with the value defined + ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. + ! If iaerclm is .true., then ntrcaer == ntrcaerm + ntrcaer = size(aer_nm, dim=3) + ! Read aerosol climatology + call read_aerdata (me,master,iflip,idate,errmsg,errflg) + endif else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%iaerclm is .false., then ntrcaer == 1 - ntrcaer = size(Tbd%aer_nm, dim=3) + ! If iaerclm is .false., then ntrcaer == 1 + ntrcaer = size(aer_nm, dim=3) endif - - if (Model%iccn == 1) then - call read_cidata ( Model%me, Model%master) - ! No consistency check needed for in/ccn data, all values are - ! hardcoded in module iccn_def.F and GFS_typedefs.F90 + +!> - Call read_cidata() to read IN and CCN data + if (iccn == 1) then + call read_cidata (me,master) + ! No consistency check needed for in/ccn data, all values are + ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif - - ! Update values of oz_pres in Interstitial data type for all threads - if (Model%ntoz > 0) then - Interstitial%oz_pres = oz_pres - end if - ! Update values of h2o_pres in Interstitial data type for all threads - if (Model%h2o_phys) then - Interstitial%h2o_pres = h2o_pres - end if - - - !--- read in and initialize ozone - if (Model%ntoz > 0) then - call setindxoz (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_o3, & - Grid%jindx2_o3, Grid%ddy_o3) +!> - Call setindxoz() to initialize ozone data + if (ntoz > 0) then + call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) endif - !--- read in and initialize stratospheric water - if (Model%h2o_phys) then - call setindxh2o (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_h, & - Grid%jindx2_h, Grid%ddy_h) +!> - Call setindxh2o() to initialize stratospheric water vapor data + if (h2o_phys) then + call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif - !--- read in and initialize aerosols - if (Model%iaerclm) then - call setindxaer (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_aer, & - Grid%jindx2_aer, Grid%ddy_aer, Grid%xlon_d, & - Grid%iindx1_aer, Grid%iindx2_aer, Grid%ddx_aer, & - Model%me, Model%master) +!> - Call setindxaer() to initialize aerosols data + if (iaerclm) then + call setindxaer (im, xlat_d, jindx1_aer, & + jindx2_aer, ddy_aer, xlon_d, & + iindx1_aer, iindx2_aer, ddx_aer, & + me, master) endif - !--- read in and initialize IN and CCN - if (Model%iccn == 1) then - call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & - Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & - Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) + +!> - Call setindxci() to initialize IN and CCN data + if (iccn == 1) then + call setindxci (im, xlat_d, jindx1_ci, & + jindx2_ci, ddy_ci, xlon_d, & + iindx1_ci, iindx2_ci, ddx_ci) endif - - !--- initial calculation of maps local ix -> global i and j, store in Tbd + + !--- initial calculation of maps local ix -> global i and j ix = 0 - nb = 1 - do j = 1,Model%ny - do i = 1,Model%nx + do j = 1,ny + do i = 1,nx ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then - ix = 1 - nb = nb + 1 - endif - Tbd%jmap(ix) = j - Tbd%imap(ix) = i + jmap(ix) = j + imap(ix) = i enddo enddo +#if 0 + !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) + ! if (first_time_step) then + ! if (nint(Sfcprop%sncovr(1)) == -9999) then + ! !--- compute sncovr from existing variables + ! !--- code taken directly from read_fix.f + ! do ix = 1, im + ! Sfcprop%sncovr(ix) = 0.0 + ! if (Sfcprop%slmsk(ix) > 0.001) then + ! vegtyp = Sfcprop%vtype(ix) + ! if (vegtyp == 0) vegtyp = 7 + ! rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) + ! if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then + ! Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + ! else + ! Sfcprop%sncovr(ix) = 1.0 + ! endif + ! endif + ! enddo + ! ! DH* 20201104: don't forget snocvr_ice for RUC LSM (see FV3GFS_io.F90) + ! endif + ! endif +#endif + is_initialized = .true. - + end subroutine GFS_phys_time_vary_init +!! @} -!> \section arg_table_GFS_phys_time_vary_finalize Argument Table -!! \htmlinclude GFS_phys_time_vary_finalize.html +!> \section arg_table_GFS_phys_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_phys_time_vary_timestep_init.html !! - subroutine GFS_phys_time_vary_finalize(errmsg, errflg) - implicit none +!>\section gen_GFS_phys_time_vary_timestep_init GFS_phys_time_vary_timestep_init General Algorithm +!! @{ + subroutine GFS_phys_time_vary_timestep_init ( & + me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, idate, nsswr, fhswr, lsswr, fhour, & + imfdeepcnv, cal_pre, random_clds, ntoz, h2o_phys, iaerclm, iccn, clstp, & + jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & + jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & + jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & + imap, jmap, prsl, seed0, rann, errmsg, errflg) - ! Interface variables - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + implicit none - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 + ! Interface variables + integer, intent(in) :: me, master, cnx, cny, isc, jsc, nrcm, im, levs, kdt, & + nsswr, imfdeepcnv, iccn, ntoz + integer, intent(in) :: idate(:) + real(kind_phys), intent(in) :: fhswr, fhour + logical, intent(in) :: lsswr, cal_pre, random_clds, h2o_phys, iaerclm + real(kind_phys), intent(out) :: clstp + integer, intent(in) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) + real(kind_phys), intent(in) :: ddy_o3(:), ddy_h(:) + real(kind_phys), intent(inout) :: ozpl(:,:,:), h2opl(:,:,:) + integer, intent(in) :: jindx1_aer(:), jindx2_aer(:), iindx1_aer(:), iindx2_aer(:) + real(kind_phys), intent(in) :: ddy_aer(:), ddx_aer(:) + real(kind_phys), intent(inout) :: aer_nm(:,:,:) + integer, intent(in) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) + real(kind_phys), intent(in) :: ddy_ci(:), ddx_ci(:) + real(kind_phys), intent(inout) :: in_nm(:,:), ccn_nm(:,:) + integer, intent(in) :: imap(:), jmap(:) + real(kind_phys), intent(in) :: prsl(:,:) + integer, intent(in) :: seed0 + real(kind_phys), intent(inout) :: rann(:,:) + ! + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg - if (.not.is_initialized) return + ! Local variables + integer :: i, j, k, iseed, iskip, ix, kdt_rad + real(kind=kind_phys) :: sec_zero, rsnow + real(kind=kind_phys) :: wrk(1) + real(kind=kind_phys) :: rannie(cny) + real(kind=kind_phys) :: rndval(cnx*cny*nrcm) - ! Deallocate ozone arrays - if (allocated(oz_lat) ) deallocate(oz_lat) - if (allocated(oz_pres) ) deallocate(oz_pres) - if (allocated(oz_time) ) deallocate(oz_time) - if (allocated(ozplin) ) deallocate(ozplin) + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 - ! Deallocate h2o arrays - if (allocated(h2o_lat) ) deallocate(h2o_lat) - if (allocated(h2o_pres)) deallocate(h2o_pres) - if (allocated(h2o_time)) deallocate(h2o_time) - if (allocated(h2oplin) ) deallocate(h2oplin) + ! Check initialization status + if (.not.is_initialized) then + write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_timestep_init called before GFS_phys_time_vary_init" + errflg = 1 + return + end if - ! Deallocate aerosol arrays - if (allocated(aerin) ) deallocate(aerin) - if (allocated(aer_pres)) deallocate(aer_pres) + !--- switch for saving convective clouds - cnvc90.f + !--- aka Ken Campana/Yu-Tai Hou legacy + if ((mod(kdt,nsswr) == 0) .and. (lsswr)) then + !--- initialize,accumulate,convert + clstp = 1100 + min(fhswr/con_hr,fhour,con_99) + elseif (mod(kdt,nsswr) == 0) then + !--- accumulate,convert + clstp = 0100 + min(fhswr/con_hr,fhour,con_99) + elseif (lsswr) then + !--- initialize,accumulate + clstp = 1100 + else + !--- accumulate + clstp = 0100 + endif - ! Deallocate IN and CCN arrays - if (allocated(ciplin) ) deallocate(ciplin) - if (allocated(ccnin) ) deallocate(ccnin) - if (allocated(ci_pres) ) deallocate(ci_pres) + !--- random number needed for RAS and old SAS and when cal_pre=.true. + ! imfdeepcnv < 0 when ras = .true. + if ( (imfdeepcnv <= 0 .or. cal_pre) .and. random_clds ) then + + iseed = mod(con_100*sqrt(fhour*con_hr),1.0d9) + seed0 + call random_setseed(iseed) + call random_number(wrk) + do i = 1,cnx*nrcm + iseed = iseed + nint(wrk(1)*1000.0) * i + call random_setseed(iseed) + call random_number(rannie) + rndval(1+(i-1)*cny:i*cny) = rannie(1:cny) + enddo - is_initialized = .false. + do k = 1,nrcm + iskip = (k-1)*cnx*cny + do ix=1,im + j = jmap(ix) + i = imap(ix) + rann(ix,k) = rndval(i+isc-1 + (j+jsc-2)*cnx + iskip) + enddo + enddo - end subroutine GFS_phys_time_vary_finalize + endif ! imfdeepcnv, cal_re, random_clds -!> \section arg_table_GFS_phys_time_vary_run Argument Table -!! \htmlinclude GFS_phys_time_vary_run.html -!! - subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Diag, first_time_step, errmsg, errflg) - - use mersenne_twister, only: random_setseed, random_number - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_grid_type, & - GFS_Tbd_type, GFS_sfcprop_type, & - GFS_cldprop_type, GFS_diag_type, & - GFS_statein_type - - implicit none - - type(GFS_grid_type), intent(in) :: Grid - type(GFS_statein_type), intent(in) :: Statein - type(GFS_control_type), intent(inout) :: Model - type(GFS_tbd_type), intent(inout) :: Tbd - type(GFS_sfcprop_type), intent(inout) :: Sfcprop - type(GFS_cldprop_type), intent(inout) :: Cldprop - type(GFS_diag_type), intent(inout) :: Diag - logical, intent(in) :: first_time_step - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - - integer :: i, j, k, iseed, iskip, ix, nb, kdt_rad, vegtyp - real(kind=kind_phys) :: sec_zero, rsnow - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Check initialization status - if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_run called before GFS_phys_time_vary_init" - errflg = 1 - return - end if - - nb = 1 - - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif - - !--- random number needed for RAS and old SAS and when cal_pre=.true. - if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 - call random_setseed(iseed) - call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)*1000.0) * i - call random_setseed(iseed) - call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) - enddo +!> - Call ozinterpol() to make ozone interpolation + if (ntoz > 0) then + call ozinterpol (me, im, idate, fhour, & + jindx1_o3, jindx2_o3, & + ozpl, ddy_o3) + endif - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny - do ix=1,Model%blksz(nb) - j = Tbd%jmap(ix) - i = Tbd%imap(ix) - Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) - enddo - enddo - endif ! imfdeepcnv, cal_re, random_clds - - !--- o3 interpolation - if (Model%ntoz > 0) then - call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_o3, Grid%jindx2_o3, Tbd%ozpl, Grid%ddy_o3) - endif - - !--- h2o interpolation - if (Model%h2o_phys) then - call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_h, Grid%jindx2_h, Tbd%h2opl, Grid%ddy_h) - endif - - !--- aerosol interpolation - if (Model%iaerclm) then - call aerinterpol (Model%me, Model%master, Model%blksz(nb), & - Model%idate, Model%fhour, & - Grid%jindx1_aer, Grid%jindx2_aer, & - Grid%ddy_aer,Grid%iindx1_aer, & - Grid%iindx2_aer,Grid%ddx_aer, & - Model%levs,Statein%prsl, & - Tbd%aer_nm) - endif - !--- ICCN interpolation - if (Model%iccn == 1) then - call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Grid%jindx1_ci, Grid%jindx2_ci, & - Grid%ddy_ci,Grid%iindx1_ci, & - Grid%iindx2_ci,Grid%ddx_ci, & - Model%levs,Statein%prsl, & - Tbd%in_nm, Tbd%ccn_nm) - endif - - !--- original FV3 code, not needed for SCM; also not compatible with the way - ! the time vary steps are run (over each block) --> cannot use - !--- repopulate specific time-varying sfc properties for AMIP/forecast runs - !if (Model%nscyc > 0) then - ! if (mod(Model%kdt,Model%nscyc) == 1) THEN - ! call gcycle (nblks, Model, Grid(:), Sfcprop(:), Cldprop(:)) - ! endif +!> - Call h2ointerpol() to make stratospheric water vapor data interpolation + if (h2o_phys) then + call h2ointerpol (me, im, idate, fhour, & + jindx1_h, jindx2_h, & + h2opl, ddy_h) + endif + +!> - Call aerinterpol() to make aerosol interpolation + if (iaerclm) then + call aerinterpol (me, master, im, idate, fhour, & + jindx1_aer, jindx2_aer, & + ddy_aer, iindx1_aer, & + iindx2_aer, ddx_aer, & + levs, prsl, aer_nm) + endif + +!> - Call ciinterpol() to make IN and CCN data interpolation + if (iccn == 1) then + call ciinterpol (me, im, idate, fhour, & + jindx1_ci, jindx2_ci, & + ddy_ci, iindx1_ci, & + iindx2_ci, ddx_ci, & + levs, prsl, in_nm, ccn_nm) + endif + +! Not needed for SCM: +!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs + !if (nscyc > 0) then + ! if (mod(kdt,nscyc) == 1) THEN + ! call gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, & + ! input_nml_file, lsoil, lsoil_lsm, kice, idate, ialb, isot, ivegsrc, & + ! use_ufo, nst_anl, fhcyc, phour, lakefrac, min_seaice, min_lakeice, & + ! frac_grid, smc, slc, stc, smois, sh2o, tslb, tiice, tg3, tref, tsfc, & + ! tsfco, tisfc, hice, fice, facsf, facwf, alvsf, alvwf, alnsf, alnwf, & + ! zorli, zorll, zorlo, weasd, slope, snoalb, canopy, vfrac, vtype, & + ! stype, shdmin, shdmax, snowd, cv, cvb, cvt, oro, oro_uf, & + ! xlat_d, xlon_d, slmsk, imap, jmap) + ! endif !endif - !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 0) then - call Diag%rad_zero (Model) - call Diag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - endif - else - if (mod(Model%kdt,Model%nszero) == 0) then - call Diag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - endif - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 0) then - call Diag%rad_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - endif - endif + end subroutine GFS_phys_time_vary_timestep_init +!! @} -#if 0 - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - if (first_time_step) then - if (nint(Sfcprop%sncovr(1)) == -9999) then - !--- compute sncovr from existing variables - !--- code taken directly from read_fix.f - do ix = 1, Model%blksz(nb) - Sfcprop%sncovr(ix) = 0.0 - if (Sfcprop%slmsk(ix) > 0.001) then - vegtyp = Sfcprop%vtype(ix) - if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) - if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then - Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - else - Sfcprop%sncovr(ix) = 1.0 - endif - endif - enddo - ! DH* 20201104: don't forget snocvr_ice for RUC LSM (see FV3GFS_io.F90) - endif - endif -#endif +!> \section arg_table_GFS_phys_time_vary_timestep_finalize Argument Table +!! \htmlinclude GFS_phys_time_vary_timestep_finalize.html +!! +!>\section gen_GFS_phys_time_vary_timestep_finalize GFS_phys_time_vary_timestep_finalize General Algorithm +!! @{ + subroutine GFS_phys_time_vary_timestep_finalize (errmsg, errflg) + + implicit none + + ! Interface variables + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine GFS_phys_time_vary_timestep_finalize +!! @} - end subroutine GFS_phys_time_vary_run +!> \section arg_table_GFS_phys_time_vary_finalize Argument Table +!! \htmlinclude GFS_phys_time_vary_finalize.html +!! + subroutine GFS_phys_time_vary_finalize(errmsg, errflg) + + implicit none + + ! Interface variables + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + ! Deallocate ozone arrays + if (allocated(oz_lat) ) deallocate(oz_lat) + if (allocated(oz_pres) ) deallocate(oz_pres) + if (allocated(oz_time) ) deallocate(oz_time) + if (allocated(ozplin) ) deallocate(ozplin) + + ! Deallocate h2o arrays + if (allocated(h2o_lat) ) deallocate(h2o_lat) + if (allocated(h2o_pres)) deallocate(h2o_pres) + if (allocated(h2o_time)) deallocate(h2o_time) + if (allocated(h2oplin) ) deallocate(h2oplin) + + ! Deallocate aerosol arrays + if (allocated(aerin) ) deallocate(aerin) + if (allocated(aer_pres)) deallocate(aer_pres) + + ! Deallocate IN and CCN arrays + if (allocated(ciplin) ) deallocate(ciplin) + if (allocated(ccnin) ) deallocate(ccnin) + if (allocated(ci_pres) ) deallocate(ci_pres) + + is_initialized = .false. + + end subroutine GFS_phys_time_vary_finalize - end module GFS_phys_time_vary + end module GFS_phys_time_vary +!> @} diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 556aa80c7..cf0b3afbd 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -7,38 +7,306 @@ [ccpp-arg-table] name = GFS_phys_time_vary_init type = scheme -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT + +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_grid_type - intent = inout + type = integer + intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index dimensions = () - type = GFS_control_type + type = integer intent = in optional = F -[Interstitial] - standard_name = GFS_interstitial_type_instance - long_name = Fortran DDT containing FV3-GFS interstitial data - units = DDT +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index dimensions = () - type = GFS_interstitial_type - intent = inout + type = integer + intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS miscellaneous data - units = DDT +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in + optional = F +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation + units = flag + dimensions = () + type = logical + intent = in + optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none dimensions = () - type = GFS_tbd_type + type = integer + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = iflip - is not the same as flipv + units = flag + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nx] + standard_name = number_of_points_in_x_direction_for_this_MPI_rank + long_name = number of points in x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[ny] + standard_name = number_of_points_in_y_direction_for_this_MPI_rank + long_name = number of points in y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = in + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys intent = in optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -81,72 +349,432 @@ ######################################################################## [ccpp-arg-table] - name = GFS_phys_time_vary_run + name = GFS_phys_time_vary_timestep_init type = scheme -[Grid] - standard_name = GFS_grid_type_instance - long_name = Fortran DDT containing FV3-GFS grid and interpolation related data - units = DDT +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index dimensions = () - type = GFS_grid_type + type = integer intent = in optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = instance of derived type GFS_statein_type - units = DDT +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index dimensions = () - type = GFS_statein_type + type = integer intent = in optional = F -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count dimensions = () - type = GFS_control_type - intent = inout + type = integer + intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS miscellaneous data - units = DDT +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count dimensions = () - type = GFS_tbd_type - intent = inout + type = integer + intent = in optional = F -[Sfcprop] - standard_name = GFS_sfcprop_type_instance - long_name = Fortran DDT containing FV3-GFS surface fields - units = DDT +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count dimensions = () - type = GFS_sfcprop_type - intent = inout + type = integer + intent = in optional = F -[Cldprop] - standard_name = GFS_cldprop_type_instance - long_name = Fortran DDT containing FV3-GFS cloud fields - units = DDT +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank + units = count dimensions = () - type = GFS_cldprop_type - intent = inout + type = integer + intent = in optional = F -[Diag] - standard_name = GFS_diag_type_instance - long_name = Fortran DDT containing FV3-GFS fields targeted for diagnostic output - units = DDT +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count dimensions = () - type = GFS_diag_type - intent = inout + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[nsswr] + standard_name = number_of_timesteps_between_shortwave_radiation_calls + long_name = number of timesteps between shortwave radiation calls + units = + dimensions = () + type = integer + intent = in + optional = F +[fhswr] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[cal_pre] + standard_name = flag_for_precipitation_type_algorithm + long_name = flag controls precip type algorithm + units = flag + dimensions = () + type = logical + intent = in + optional = F +[random_clds] + standard_name = flag_for_random_clouds_for_RAS + long_name = flag for using random clouds with the RAS scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + intent = in optional = F -[first_time_step] - standard_name = flag_for_first_time_step - long_name = flag for first time step for time integration loop (cold/warmstart) +[iaerclm] + standard_name = flag_for_aerosol_input_MG_radiation + long_name = flag for using aerosols in Morrison-Gettelman MP_radiation units = flag dimensions = () type = logical intent = in optional = F +[iccn] + standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics + long_name = flag for IN and CCN forcing for morrison gettelman microphysics + units = none + dimensions = () + type = integer + intent = in + optional = F +[clstp] + standard_name = convective_cloud_switch + long_name = index used by cnvc90 (for convective clouds) + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[jindx1_o3] + standard_name = lower_ozone_interpolation_index + long_name = interpolation low index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_o3] + standard_name = upper_ozone_interpolation_index + long_name = interpolation high index for ozone + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_o3] + standard_name = ozone_interpolation_weight + long_name = interpolation high index for ozone + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ozpl] + standard_name = ozone_forcing + long_name = ozone forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_ozone_forcing_data,number_of_coefficients_in_ozone_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_h] + standard_name = lower_water_vapor_interpolation_index + long_name = interpolation low index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_h] + standard_name = upper_water_vapor_interpolation_index + long_name = interpolation high index for stratospheric water vapor + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_h] + standard_name = water_vapor_interpolation_weight + long_name = interpolation high index for stratospheric water vapor + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[h2opl] + standard_name = h2o_forcing + long_name = water forcing data + units = various + dimensions = (horizontal_dimension,vertical_dimension_of_h2o_forcing_data,number_of_coefficients_in_h2o_forcing_data) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_aer] + standard_name = lower_aerosol_y_interpolation_index + long_name = interpolation low index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_aer] + standard_name = upper_aerosol_y_interpolation_index + long_name = interpolation high index for prescribed aerosols in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_aer] + standard_name = aerosol_y_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[iindx1_aer] + standard_name = lower_aerosol_x_interpolation_index + long_name = interpolation low index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx2_aer] + standard_name = upper_aerosol_x_interpolation_index + long_name = interpolation high index for prescribed aerosols in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddx_aer] + standard_name = aerosol_x_interpolation_weight + long_name = interpolation high index for prescribed aerosols in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[aer_nm] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = inout + optional = F +[jindx1_ci] + standard_name = lower_cloud_nuclei_y_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_ci] + standard_name = upper_cloud_nuclei_y_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_ci] + standard_name = cloud_nuclei_y_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the y direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[iindx1_ci] + standard_name = lower_cloud_nuclei_x_interpolation_index + long_name = interpolation low index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[iindx2_ci] + standard_name = upper_cloud_nuclei_x_interpolation_index + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddx_ci] + standard_name = cloud_nuclei_x_interpolation_weight + long_name = interpolation high index for ice and cloud condensation nuclei in the x direction + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[in_nm] + standard_name = ice_nucleation_number + long_name = ice nucleation number in MG MP + units = kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ccn_nm] + standard_name = tendency_of_ccn_activated_number + long_name = tendency of ccn activated number + units = kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[seed0] + standard_name = seed_random_numbers_RAS + long_name = random number seed for the RAS scheme + units = none + dimensions = () + type = integer + intent = in + optional = F +[rann] + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -164,3 +792,25 @@ type = integer intent = out optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_phys_time_vary_timestep_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 9d7302beb..38b9c9508 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -1,90 +1,92 @@ !>\file GFS_rad_time_vary.F90 !! Contains code related to GFS physics suite setup (radiation part of time_vary_step) - module GFS_rad_time_vary + module GFS_rad_time_vary implicit none private - public GFS_rad_time_vary_init, GFS_rad_time_vary_run, GFS_rad_time_vary_finalize + public GFS_rad_time_vary_timestep_init contains -!>\defgroup GFS_rad_time_vary GFS RRTMG Update -!!\ingroup RRTMG -!! @{ - subroutine GFS_rad_time_vary_init - end subroutine GFS_rad_time_vary_init - -!> \section arg_table_GFS_rad_time_vary_run Argument Table -!! \htmlinclude GFS_rad_time_vary_run.html +!>\defgroup mod_GFS_rad_time_vary GFS Radiation Time Update +!> @{ +!> \section arg_table_GFS_rad_time_vary_timestep_init Argument Table +!! \htmlinclude GFS_rad_time_vary_timestep_init.html !! - subroutine GFS_rad_time_vary_run (Model, Statein, Tbd, errmsg, errflg) - - use physparam, only: ipsd0, ipsdlim, iaerflg - use mersenne_twister, only: random_setseed, random_index, random_stat - use machine, only: kind_phys - use GFS_typedefs, only: GFS_statein_type, & - GFS_control_type, & - GFS_grid_type, & - GFS_tbd_type - use radcons, only: qmin, con_100 - - implicit none - - type(GFS_control_type), intent(inout) :: Model - type(GFS_statein_type), intent(in) :: Statein - type(GFS_tbd_type), intent(inout) :: Tbd - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - !--- local variables - type (random_stat) :: stat - integer :: ix, nb, j, i, nblks, ipseed - integer :: numrdm(Model%cnx*Model%cny*2) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - nb = 1 - - if (Model%lsswr .or. Model%lslwr) then - - !--- call to GFS_radupdate_run is now in GFS_rrtmg_setup_run - - !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) - if ((Model%isubc_lw==2) .or. (Model%isubc_sw==2)) then - ipseed = mod(nint(con_100*sqrt(Model%sec)), ipsdlim) + 1 + ipsd0 - call random_setseed (ipseed, stat) - call random_index (ipsdlim, numrdm, stat) - - !--- set the random seeds for each column in a reproducible way - do ix=1,Model%blksz(nb) - j = Tbd%jmap(ix) - i = Tbd%imap(ix) - !--- for testing purposes, replace numrdm with '100' - Tbd%icsdsw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx) - Tbd%icsdlw(ix) = numrdm(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + Model%cnx*Model%cny) - enddo - endif ! isubc_lw and isubc_sw - - if (Model%imp_physics == 99) then - if (Model%kdt == 1) then - Tbd%phy_f3d(:,:,1) = Statein%tgrs - Tbd%phy_f3d(:,:,2) = max(qmin,Statein%qgrs(:,:,1)) - Tbd%phy_f3d(:,:,3) = Statein%tgrs - Tbd%phy_f3d(:,:,4) = max(qmin,Statein%qgrs(:,:,1)) - Tbd%phy_f2d(:,1) = Statein%prsi(:,1) - Tbd%phy_f2d(:,2) = Statein%prsi(:,1) - endif - endif - - endif - - end subroutine GFS_rad_time_vary_run - - subroutine GFS_rad_time_vary_finalize() - end subroutine GFS_rad_time_vary_finalize -!! @} - end module GFS_rad_time_vary + subroutine GFS_rad_time_vary_timestep_init ( & + lslwr, lsswr, isubc_lw, isubc_sw, icsdsw, icsdlw, cnx, cny, isc, jsc, & + imap, jmap, sec, kdt, imp_physics, imp_physics_zhao_carr, ps_2delt, & + ps_1delt, t_2delt, t_1delt, qv_2delt, qv_1delt, t, qv, ps, errmsg, errflg) + + use physparam, only: ipsd0, ipsdlim, iaerflg + use mersenne_twister, only: random_setseed, random_index, random_stat + use machine, only: kind_phys + use radcons, only: qmin, con_100 + + implicit none + + ! Interface variables + integer, intent(in) :: isubc_lw, isubc_sw, cnx, cny, isc, jsc, kdt + integer, intent(in) :: imp_physics, imp_physics_zhao_carr + logical, intent(in) :: lslwr, lsswr + integer, intent(inout) :: icsdsw(:), icsdlw(:) + integer, intent(in) :: imap(:), jmap(:) + real(kind_phys), intent(in) :: sec + real(kind_phys), intent(inout) :: ps_2delt(:) + real(kind_phys), intent(inout) :: ps_1delt(:) + real(kind_phys), intent(inout) :: t_2delt(:,:) + real(kind_phys), intent(inout) :: t_1delt(:,:) + real(kind_phys), intent(inout) :: qv_2delt(:,:) + real(kind_phys), intent(inout) :: qv_1delt(:,:) + real(kind_phys), intent(in) :: t(:,:), qv(:,:), ps(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + type (random_stat) :: stat + integer :: ix, j, i, ipseed + integer :: numrdm(cnx*cny*2) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lsswr .or. lslwr) then + + !--- call to GFS_radupdate_timestep_init is now in GFS_rrtmg_setup_timestep_init + + !--- set up random seed index in a reproducible way for entire cubed-sphere face (lat-lon grid) + if ((isubc_lw==2) .or. (isubc_sw==2)) then + ipseed = mod(nint(con_100*sqrt(sec)), ipsdlim) + 1 + ipsd0 + call random_setseed (ipseed, stat) + call random_index (ipsdlim, numrdm, stat) + + do ix=1,size(jmap) + j = jmap(ix) + i = imap(ix) + !--- for testing purposes, replace numrdm with '100' + icsdsw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx) + icsdlw(ix) = numrdm(i+isc-1 + (j+jsc-2)*cnx + cnx*cny) + enddo + + endif ! isubc_lw and isubc_sw + + if (imp_physics == imp_physics_zhao_carr) then + if (kdt == 1) then + t_2delt = t + t_1delt = t + qv_2delt = max(qmin,qv) + qv_1delt = max(qmin,qv) + ps_2delt = ps + ps_1delt = ps + endif + endif + + endif + + end subroutine GFS_rad_time_vary_timestep_init +!> @} + + end module GFS_rad_time_vary diff --git a/physics/GFS_rad_time_vary.scm.meta b/physics/GFS_rad_time_vary.scm.meta index b78be178a..ffe33810c 100644 --- a/physics/GFS_rad_time_vary.scm.meta +++ b/physics/GFS_rad_time_vary.scm.meta @@ -5,32 +5,218 @@ ######################################################################## [ccpp-arg-table] - name = GFS_rad_time_vary_run + name = GFS_rad_time_vary_timestep_init type = scheme -[Model] - standard_name = GFS_control_type_instance - long_name = Fortran DDT containing FV3-GFS model control parameters - units = DDT +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag dimensions = () - type = GFS_control_type + type = logical + intent = in + optional = F +[isubc_lw] + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_sw] + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icsdsw] + standard_name = seed_random_numbers_sw + long_name = random seeds for sub-column cloud generators sw + units = none + dimensions = (horizontal_dimension) + type = integer intent = inout optional = F -[Statein] - standard_name = GFS_statein_type_instance - long_name = Fortran DDT containing FV3-GFS prognostic state data in from dycore - units = DDT +[icsdlw] + standard_name = seed_random_numbers_lw + long_name = random seeds for sub-column cloud generators lw + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[cnx] + standard_name = number_of_points_in_x_direction_for_this_cubed_sphere_face + long_name = number of points in x direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[cny] + standard_name = number_of_points_in_y_direction_for_this_cubed_sphere_face + long_name = number of points in y direction for this cubed sphere face + units = count + dimensions = () + type = integer + intent = in + optional = F +[isc] + standard_name = starting_x_index_for_this_MPI_rank + long_name = starting index in the x direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[jsc] + standard_name = starting_y_index_for_this_MPI_rank + long_name = starting index in the y direction for this MPI rank + units = count + dimensions = () + type = integer + intent = in + optional = F +[imap] + standard_name = map_of_block_column_number_to_global_i_index + long_name = map of local index ix to global index i for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jmap] + standard_name = map_of_block_column_number_to_global_j_index + long_name = map of local index ix to global index j for this block + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sec] + standard_name = seconds_elapsed_since_model_initialization + long_name = seconds elapsed since model initialization + units = s dimensions = () - type = GFS_statein_type + type = real + kind = kind_phys intent = in optional = F -[Tbd] - standard_name = GFS_tbd_type_instance - long_name = Fortran DDT containing FV3-GFS data not yet assigned to a defined container - units = DDT +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag dimensions = () - type = GFS_tbd_type + type = integer + intent = in + optional = F +[ps_2delt] + standard_name = surface_air_pressure_two_timesteps_back + long_name = surface air pressure two timesteps back + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ps_1delt] + standard_name = surface_air_pressure_at_previous_timestep + long_name = surface air pressure at previous timestep + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys intent = inout optional = F +[t_2delt] + standard_name = air_temperature_two_timesteps_back + long_name = air temperature two timesteps back + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t_1delt] + standard_name = air_temperature_at_previous_timestep + long_name = air temperature at previous timestep + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_2delt] + standard_name = water_vapor_specific_humidity_two_timesteps_back + long_name = water vapor specific humidity two timesteps back + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qv_1delt] + standard_name = water_vapor_specific_humidity_at_previous_timestep + long_name = water vapor specific humidity at previous timestep + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[t] + standard_name = air_temperature + long_name = model layer mean temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qv] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[ps] + standard_name = air_pressure_at_lowest_model_interface + long_name = air pressure at lowest model interface + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index ad98b14e3..365bd2c56 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -9,7 +9,7 @@ module GFS_time_vary_pre private - public GFS_time_vary_pre_init, GFS_time_vary_pre_run, GFS_time_vary_pre_finalize + public GFS_time_vary_pre_init, GFS_time_vary_pre_timestep_init, GFS_time_vary_pre_finalize logical :: is_initialized = .false. @@ -62,10 +62,10 @@ subroutine GFS_time_vary_pre_finalize(errmsg, errflg) end subroutine GFS_time_vary_pre_finalize -!> \section arg_table_GFS_time_vary_pre_run Argument Table -!! \htmlinclude GFS_time_vary_pre_run.html +!> \section arg_table_GFS_time_vary_pre_timestep_init Argument Table +!! \htmlinclude GFS_time_vary_pre_timestep_init.html !! - subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & + subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, & julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg) @@ -104,7 +104,7 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & ! Check initialization status if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_run called & + write(errmsg,'(*(a))') "Logic error: GFS_time_vary_pre_timestep_init called & &before GFS_time_vary_pre_init" errflg = 1 return @@ -185,6 +185,6 @@ subroutine GFS_time_vary_pre_run (jdat, idat, dtp, lsm, lsm_noahmp, nsswr, & print *,' solhr ', solhr endif - end subroutine GFS_time_vary_pre_run + end subroutine GFS_time_vary_pre_timestep_init end module GFS_time_vary_pre diff --git a/physics/GFS_time_vary_pre.scm.meta b/physics/GFS_time_vary_pre.scm.meta index 6241e29f1..5033f7988 100644 --- a/physics/GFS_time_vary_pre.scm.meta +++ b/physics/GFS_time_vary_pre.scm.meta @@ -49,7 +49,7 @@ ######################################################################## [ccpp-arg-table] - name = GFS_time_vary_pre_run + name = GFS_time_vary_pre_timestep_init type = scheme [jdat] standard_name = forecast_date_and_time From 2b4489a9a9a8a90bcf8e06f725e625da3f0bd0af Mon Sep 17 00:00:00 2001 From: "valery.yudin" Date: Thu, 28 Jan 2021 13:32:21 -0500 Subject: [PATCH 186/274] compiling all 3 GW suites --- physics/cires_orowam2017.f | 57 +- physics/cires_ugwp.F90 | 29 +- physics/cires_ugwp.meta | 5 +- physics/cires_ugwp_initialize.F90 | 317 +------- physics/cires_ugwp_initialize_v1.F90 | 805 -------------------- physics/cires_ugwp_module.F90 | 473 +----------- physics/cires_ugwp_module_v1.F90 | 672 ----------------- physics/cires_ugwp_ngw_utils.F90 | 73 -- physics/cires_ugwp_orolm97_v1.F90 | 1008 ------------------------- physics/cires_ugwp_solv2_v1_mod.F90 | 829 -------------------- physics/cires_ugwp_solvers.F90 | 664 ---------------- physics/cires_ugwp_triggers.F90 | 483 +----------- physics/cires_ugwp_triggers_v1.F90 | 584 -------------- physics/cires_ugwp_utils.F90 | 152 ---- physics/cires_ugwpv1_triggers.F90 | 36 - physics/cires_vert_lsatdis.F90 | 524 ------------- physics/cires_vert_orodis.F90 | 1018 ------------------------- physics/cires_vert_orodis_v1.F90 | 1047 -------------------------- physics/cires_vert_wmsdis.F90 | 425 ----------- physics/ugwp_driver_v0.F | 678 +---------------- physics/ugwpv1_gsldrag.F90 | 30 +- physics/unified_ugwp.F90 | 136 +--- physics/unified_ugwp.meta | 51 +- 23 files changed, 180 insertions(+), 9916 deletions(-) delete mode 100644 physics/cires_ugwp_initialize_v1.F90 delete mode 100644 physics/cires_ugwp_module_v1.F90 delete mode 100644 physics/cires_ugwp_ngw_utils.F90 delete mode 100644 physics/cires_ugwp_orolm97_v1.F90 delete mode 100644 physics/cires_ugwp_solv2_v1_mod.F90 delete mode 100644 physics/cires_ugwp_solvers.F90 delete mode 100644 physics/cires_ugwp_triggers_v1.F90 delete mode 100644 physics/cires_ugwp_utils.F90 delete mode 100644 physics/cires_vert_lsatdis.F90 delete mode 100644 physics/cires_vert_orodis.F90 delete mode 100644 physics/cires_vert_orodis_v1.F90 delete mode 100644 physics/cires_vert_wmsdis.F90 diff --git a/physics/cires_orowam2017.f b/physics/cires_orowam2017.f index 4170a3d79..c20f98f42 100644 --- a/physics/cires_orowam2017.f +++ b/physics/cires_orowam2017.f @@ -4,7 +4,7 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, & sinlat, xlatd, taup, taud, pkdis) ! USE MACHINE , ONLY : kind_phys - use ugwp_common , only : grav, omega2 + use ugwp_common_v0 , only : grav, omega2 ! implicit none @@ -121,7 +121,7 @@ subroutine oro_wam_2017(im, levs,npt,ipt, kref,kdt,me,master, taub_kx(1:nw) = tau_kx(1:nw) * taub(i) wkdis(:,:) = kedmin - call oro_meanflow(levs, nzi, u1(j,:), v1(j,:), t1(j,:), + call oro_meanflow_v0(levs, nzi, u1(j,:), v1(j,:), t1(j,:), & prsi(j,:), prsL(j,:), del(j,:), rho(i,:), & bn2(i,:), uzi, rhoi,ktur, kalp,dzi, & xn(i), yn(i)) @@ -275,10 +275,10 @@ end subroutine oro_wam_2017 ! define mean flow and dissipation for OGW-kx spectrum ! !------------------------------------------------------------- - subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, + subroutine oro_meanflow_v0(nz, nzi, u1, v1, t1, pint, pmid, & delp, rho, bn2, uzi, rhoi, ktur, kalp, dzi, xn, yn) - use ugwp_common , only : grav, rgrav, rdi, velmin, dw2min + use ugwp_common_v0 , only : grav, rgrav, rdi, velmin, dw2min implicit none integer :: nz, nzi @@ -336,4 +336,51 @@ subroutine oro_meanflow(nz, nzi, u1, v1, t1, pint, pmid, rhoi(k) = rhoi(k-1)*.5 dzi(k) = dzi(k-1) - end subroutine oro_meanflow + end subroutine oro_meanflow_v0 + + subroutine ugwpv0_tofd1d(levs, sigflt, elvmax, zsurf, + & zpbl, u, v, zmid, utofd, vtofd, epstofd, krf_tofd) + use machine , only : kind_phys + use ugwp_common_v0 , only : rcpd2 + use ugwpv0_oro_init, only : n_tofd, const_tofd, ze_tofd + use ugwpv0_oro_init, only : a12_tofd, ztop_tofd +! + implicit none + integer :: levs + real(kind_phys), dimension(levs) :: u, v, zmid + real(kind_phys) :: sigflt, elvmax, zpbl, zsurf + real(kind_phys), dimension(levs) :: utofd, vtofd + real(kind_phys), dimension(levs) :: epstofd, krf_tofd +! +! locals +! + integer :: i, k + real(kind_phys) :: sghmax = 5. + real(kind_phys) :: sgh2, ekin, zdec, rzdec, umag, zmet + real(kind_phys) :: zarg, ztexp, krf +! + utofd =0.0 ; vtofd = 0.0 + epstofd =0.0 ; krf_tofd =0.0 +! + zdec = max(n_tofd*sigflt, zpbl) ! ntimes*sgh_turb or Zpbl + zdec = min(ze_tofd, zdec) ! cannot exceed 18 km + rzdec = 1.0/zdec + sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! 25 meters dz-of the first layer + + do k=1, levs + zmet = zmid(k)-zsurf + if (zmet > ztop_tofd) cycle + ekin = u(k)*u(k) + v(k)*v(k) + umag = sqrt(ekin) + zarg = zmet*rzdec + ztexp = exp(-zarg*sqrt(zarg)) + krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *ztexp + + utofd(k) = -krf*u(k) + vtofd(k) = -krf*v(k) + epstofd(k) = rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" + ! to update momentum and temp-re; epstofd(k) can be skipped + krf_tofd(k) = krf + enddo +! + end subroutine ugwpv0_tofd1d diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 21b331041..672a2ac81 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -14,7 +14,7 @@ module cires_ugwp use machine, only: kind_phys - use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize + use cires_ugwpv0_module, only: knob_ugwp_version, cires_ugwpv0_mod_init, cires_ugwpv0_mod_finalize use gwdps, only: gwdps_run @@ -77,7 +77,7 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if (is_initialized) return if (do_ugwp .or. cdmbgwd(3) > 0.0) then - call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + call cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) else @@ -120,7 +120,7 @@ subroutine cires_ugwp_finalize(errmsg, errflg) if (.not.is_initialized) return - call cires_ugwp_mod_finalize() + call cires_ugwpv0_mod_finalize() is_initialized = .false. @@ -293,7 +293,7 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr if (cdmbgwd(3) > 0.0) then ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing - call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) + call slat_geos5_tamp_v0(im, tamp_mpa, xlat_d, tau_ngw) if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then if (cdmbgwd(4) > 0.0) then @@ -365,27 +365,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. endif -#if 0 - !============================================================================= - ! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving - ! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" - !============================================================================= - ! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies - !------------------------------------------------------------------------------ - do k=1,levs - do i=1,im - ed_dudt(i,k) = 0.0 ; ed_dvdt(i,k) = 0.0 ; ed_dtdt(i,k) = 0.0 - enddo - enddo - - call edmix_ugwp_v0(im, levs, dtp, tgrs, ugrs, vgrs, qgrs(:,:,1), & - del, prsl, prsi, phil, prslk, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & - ed_dudt, ed_dvdt, ed_dtdt, me, master, kdt) - gw_dtdt = gw_dtdt*(1.-pked) + ed_dtdt*pked - gw_dvdt = gw_dvdt*(1.-pked) + ed_dvdt*pked - gw_dudt = gw_dudt*(1.-pked) + ed_dudt*pked -#endif - if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then do k=1,levs do i=1,im diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index d7d7da286..887280612 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -1,8 +1,9 @@ [ccpp-table-properties] name = cires_ugwp type = scheme -# DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp! - dependencies = cires_ugwp_triggers.F90,cires_ugwp_initialize.F90,cires_ugwp_solvers.F90,cires_ugwp_utils.F90,cires_orowam2017.f,cires_vert_lsatdis.F90,cires_vert_orodis.F90,cires_vert_wmsdis.F90,cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F +# DH* 20200804 - this is a result of the nasty hack to call gwdps from within ugwp-v0! + dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 + dependencies=cires_orowam2017.f, cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F ######################################################################## [ccpp-arg-table] diff --git a/physics/cires_ugwp_initialize.F90 b/physics/cires_ugwp_initialize.F90 index fbcc1d205..e2f7afd7b 100644 --- a/physics/cires_ugwp_initialize.F90 +++ b/physics/cires_ugwp_initialize.F90 @@ -1,41 +1,11 @@ !=============================== ! cu-cires ugwp-scheme -! initialization of selected -! init gw-solvers (1,2,3,4) +! initialization of ugwp_common_v0 +! init gw-solvers (1,2) .. no UFS-funds for (3,4) tests ! init gw-source specifications ! init gw-background dissipation -!============================== -! -! Part-0 specifications of common constants, limiters and "criiical" values - - -! module oro_state - -! integer, parameter :: kind_phys=8 -! integer, parameter :: nvaroro=14 -! real (kind=kind_phys), allocatable :: oro_stat(:, :) -! contains - -! subroutine fill_oro_stat(nx, oc, oa4, clx4, theta, gamm, sigma, elvmax, hprime) - -! real (kind=kind_phys),dimension(nx) :: oc, theta, gamm, sigma, elvmax, hprime -! real(kind=kind_phys),dimension(nx,4) :: oa4, clx4 -! integer :: i -! do i=1, nx -! oro_stat(i,1) = hprime(i) -! oro_stat(i,2) = oc(i) -! oro_stat(i,3:6) = oa4(i,1:4) -! oro_stat(i,7:10) = clx4(i,1:4) -! oro_stat(i,11) = theta(i) -! oro_stat(i,12) = gamm(i) -! oro_stat(i,13) = sigma(i) -! oro_stat(i,14) = elvmax(i) -! enddo -! end subroutine fill_oro_stat - -! end module oro_state - - module ugwp_common +!=============================== + module ugwp_common_v0 ! use machine, only: kind_phys use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & @@ -45,7 +15,7 @@ module ugwp_common real(kind=kind_phys), parameter :: grcp = grav/cpd, rgrav = 1.0d0/grav, & rdi = 1.0d0/rd, & - gor = grav/rd, gr2 = grav*gor, gocp = grav/cpd, & + gor = grav/rd, gr2 = grav*gor, gocp = grav/cpd, & rcpd = 1./cpd, rcpd2 = 0.5*rcpd, & pi2 = pi + pi, omega1 = pi2/86400.0, & omega2 = omega1+omega1, & @@ -53,7 +23,7 @@ module ugwp_common dw2min=1.0, bnv2min=1.e-6, velmin=sqrt(dw2min) - end module ugwp_common + end module ugwp_common_v0 ! ! !=================================================== @@ -61,7 +31,7 @@ end module ugwp_common !Part-1 init => wave dissipation + RFriction ! !=================================================== - subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion) + subroutine init_global_gwdis_v0(levs, zkm, pmb, kvg, ktg, krad, kion) implicit none integer :: levs @@ -111,51 +81,20 @@ subroutine init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion) kvg(k) = kvg(k-1) ktg(k) = ktg(k-1) ! - end subroutine init_global_gwdis -! -! - subroutine rf_damp_init(levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) - implicit none + end subroutine init_global_gwdis_v0 - integer :: levs - real :: pa_rf, tau_rf - real :: dtp - - real :: pmb(levs) - real :: rfdis(levs), rfdist(levs) - integer :: levs_rf - - real :: krf, krfz - integer :: k -! - rfdis(1:levs) = 1.0 - rfdist(1:levs) = 0.0 - levs_rf = levs - if (tau_rf <= 0.0 .or. pa_rf == 0.0) return - - krf = 1.0/(tau_rf*86400.0) - - do k=levs, 1, -1 - if(pmb(k) < pa_rf ) then ! applied only on constant pressure surfaces fixed pmb in "Pa" - krfz = krf*log(pa_rf/pmb(k)) - rfdis(k) = 1.0/(1.+krfz*dtp) - rfdist(k) = (rfdis(k) -1.0)/dtp ! du/dtp - levs_rf = k - endif - enddo - - end subroutine rf_damp_init + ! ======================================================================== ! Part 2 - sources ! wave sources ! ======================================================================== ! -! ugwp_oro_init +! ugwpv0_oro_init ! !========================================================================= - module ugwp_oro_init + module ugwpv0_oro_init - use ugwp_common, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi + use ugwp_common_v0, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi implicit none ! @@ -230,7 +169,7 @@ module ugwp_oro_init contains ! - subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & + subroutine init_oro_gws_v0(nwaves, nazdir, nstoch, effac, & lonr, kxw, cdmbgwd ) ! ! @@ -270,195 +209,10 @@ subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & !.................................................................... ! ! print *, ' init_oro_gws 2-1cdmb', cdmbgwd(2), cdmbgwd(1) - end subroutine init_oro_gws -! - - end module ugwp_oro_init -! ========================================================================= -! -! ugwp_conv_init -! -!========================================================================= - module ugwp_conv_init - - implicit none - real :: eff_con ! scale factors for conv GWs - integer :: nwcon ! number of waves - integer :: nazcon ! number of azimuths - integer :: nstcon ! flag for stochastic choice of launch level above Conv-cloud - real :: con_dlength - real :: con_cldf - - real, parameter :: cmin = 5 !2.5 - real, parameter :: cmax = 95. !82.5 - real, parameter :: cmid = 22.5 - real, parameter :: cwid = cmid - real, parameter :: bns = 2.e-2, bns2 = bns*bns, bns4=bns2*bns2 - real, parameter :: mstar = 6.28e-3/2. ! 2km - real :: dc - - real, allocatable :: ch_conv(:), spf_conv(:) - real, allocatable :: xaz_conv(:), yaz_conv(:) - contains -! - subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & - lonr, kxw, cgwf) - use ugwp_common, only : pi2, arad - implicit none - - integer :: nwaves, nazdir, nstoch - integer :: lonr - real :: cgwf(2) - real :: kxw, effac - real :: work1 = 0.5 - real :: chk, tn4, snorm - integer :: k - - nwcon = nwaves - nazcon = nazdir - nstcon = nstoch - eff_con = effac - - con_dlength = pi2*arad/float(lonr) - con_cldf = cgwf(1) * work1 + cgwf(2) *(1.-work1) -! -! allocate & define spectra in "selected direction": "dc" "ch(nwaves)" -! - if (.not. allocated(ch_conv)) allocate (ch_conv(nwaves)) - if (.not. allocated(spf_conv)) allocate (spf_conv(nwaves)) - if (.not. allocated(xaz_conv)) allocate (xaz_conv(nazdir)) - if (.not. allocated(yaz_conv)) allocate (yaz_conv(nazdir)) - - dc = (cmax-cmin)/float(nwaves-1) -! -! we may use different spectral "shapes" -! for example FVS-93 "Desabeius" -! E(s=1, t=3,m, w, k) ~ m^s/(m*^4 + m^4) ~ m^-3 saturated tail -! - do k = 1,nwaves - chk = cmin + (k-1)*dc - tn4 = (mstar*chk)**4 - ch_conv(k) = chk - spf_conv(k) = bns4*chk/(bns4+tn4) - enddo - - snorm = sum(spf_conv) - spf_conv = spf_conv/snorm*1.5 - - call init_nazdir(nazdir, xaz_conv, yaz_conv) - end subroutine init_conv_gws - - - end module ugwp_conv_init -!========================================================================= -! -! ugwp_fjet_init -! -!========================================================================= - - module ugwp_fjet_init - implicit none - real :: eff_fj ! scale factors for conv GWs - integer :: nwfj ! number of waves - integer :: nazfj ! number of azimuths - integer :: nstfj ! flag for stochastic choice of launch level above Conv-cloud -! - real, parameter :: fjet_trig=0. ! if ( abs(frgf) > fjet_trig ) launch GW-packet - - - real, parameter :: cmin = 2.5 - real, parameter :: cmax = 67.5 - real :: dc - real, allocatable :: ch_fjet(:) , spf_fjet(:) - real, allocatable :: xaz_fjet(:), yaz_fjet(:) - contains - subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) - use ugwp_common, only : pi2, arad - implicit none - - integer :: nwaves, nazdir, nstoch - integer :: lonr - real :: kxw, effac , chk - - integer :: k - - nwfj = nwaves - nazfj = nazdir - nstfj = nstoch - eff_fj = effac - - if (.not. allocated(ch_fjet)) allocate (ch_fjet(nwaves)) - if (.not. allocated(spf_fjet)) allocate (spf_fjet(nwaves)) - if (.not. allocated(xaz_fjet)) allocate (xaz_fjet(nazdir)) - if (.not. allocated(yaz_fjet)) allocate (yaz_fjet(nazdir)) - - dc = (cmax-cmin)/float(nwaves-1) - do k = 1,nwaves - chk = cmin + (k-1)*dc - ch_fjet(k) = chk - spf_fjet(k) = 1.0 - enddo - call init_nazdir(nazdir, xaz_fjet, yaz_fjet) - - end subroutine init_fjet_gws - - end module ugwp_fjet_init -! -!========================================================================= -! -! - module ugwp_okw_init -!========================================================================= - implicit none - - real :: eff_okw ! scale factors for conv GWs - integer :: nwokw ! number of waves - integer :: nazokw ! number of azimuths - integer :: nstokw ! flag for stochastic choice of launch level above Conv-cloud -! - real, parameter :: okw_trig=0. ! if ( abs(okwp) > okw_trig ) launch GW-packet - - real, parameter :: cmin = 2.5 - real, parameter :: cmax = 67.5 - real :: dc - real, allocatable :: ch_okwp(:), spf_okwp(:) - real, allocatable :: xaz_okwp(:), yaz_okwp(:) - - contains + end subroutine init_oro_gws_v0 ! - subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, lonr, kxw) - - use ugwp_common, only : pi2, arad - implicit none - - integer :: nwaves, nazdir, nstoch - integer :: lonr - real :: kxw, effac , chk - - integer :: k - - nwokw = nwaves - nazokw = nazdir - nstokw = nstoch - eff_okw = effac - - if (.not. allocated(ch_okwp)) allocate (ch_okwp(nwaves)) - if (.not. allocated(spf_okwp)) allocate (spf_okwp(nwaves)) - if (.not. allocated(xaz_okwp)) allocate (xaz_okwp(nazdir)) - if (.not. allocated(yaz_okwp)) allocate (yaz_okwp(nazdir)) - dc = (cmax-cmin)/float(nwaves-1) - do k = 1,nwaves - chk = cmin + (k-1)*dc - ch_okwp(k) = chk - spf_okwp(k) = 1. - enddo - - call init_nazdir(nazdir, xaz_okwp, yaz_okwp) - - end subroutine init_okw_gws - - end module ugwp_okw_init + end module ugwpv0_oro_init !=============================== end of GW sources ! ! init specific gw-solvers (1,2,3,4) @@ -468,7 +222,7 @@ end module ugwp_okw_init ! Part -3 init wave solvers !=============================== - module ugwp_lsatdis_init + module ugwpv0_lsatdis_init implicit none integer :: nwav, nazd @@ -478,7 +232,7 @@ module ugwp_lsatdis_init ! contains - subroutine initsolv_lsatdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) + subroutine initsolv_lsatdis_v0(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) implicit none ! @@ -508,14 +262,14 @@ subroutine initsolv_lsatdis(me, master, nwaves, nazdir, nstoch, effac, do_physb eff = effac endif ! - end subroutine initsolv_lsatdis + end subroutine initsolv_lsatdis_v0 ! - end module ugwp_lsatdis_init + end module ugwpv0_lsatdis_init ! ! - module ugwp_wmsdis_init + module ugwpv0_wmsdis_init - use ugwp_common, only : pi, pi2 + use ugwp_common_v0, only : pi, pi2 implicit none real, parameter :: maxdudt = 250.e-5 @@ -539,8 +293,6 @@ module ugwp_wmsdis_init real, parameter :: zfluxglob= 3.75e-3 real , parameter :: nslope=1 ! the GW sprctral slope at small-m -! integer, parameter :: klaunch=55 ! 32 - ~ 1km ;55 - 5.5 km ; 52 4.7km ; 60-7km index for selecting launch level -! integer, parameter :: ilaunch=klaunch integer , parameter :: iazidim=4 ! number of azimuths integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum @@ -563,11 +315,8 @@ module ugwp_wmsdis_init real, allocatable :: zcosang(:), zsinang(:) contains !============================================================================ - subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) + subroutine initsolv_wmsdis_v0(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) -! call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & -! knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) -! implicit none ! !input -control for solvers: @@ -680,25 +429,7 @@ subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, print * endif - - end subroutine initsolv_wmsdis + end subroutine initsolv_wmsdis_v0 ! -! make a list of all-initilized parameters needed for "gw_solver_wmsdis" -! - - end module ugwp_wmsdis_init -!========================================================================= -! -! work TODO for 2-extra WAM-solvers: -! DSPDIS (Hines)+ADODIS (Alexander-Dunkerton-Ortland) -! -!========================================================================= - subroutine init_dspdis - implicit none - end subroutine init_dspdis - - subroutine init_adodis - implicit none - end subroutine init_adodis - + end module ugwpv0_wmsdis_init diff --git a/physics/cires_ugwp_initialize_v1.F90 b/physics/cires_ugwp_initialize_v1.F90 deleted file mode 100644 index 4258680ea..000000000 --- a/physics/cires_ugwp_initialize_v1.F90 +++ /dev/null @@ -1,805 +0,0 @@ -!=============================== -! cu-cires ugwp-scheme -! initialization of selected -! init gw-solvers (1,2,3,4) -! init gw-source specifications -! init gw-background dissipation -!============================== -! -! Part-0 specifications of common constants, limiters and "criiical" values -! -! - - module ugwp_common_v1 -! -! use machine, only : kind_phys -! use physcons, only : pi => con_pi, grav => con_g, rd => con_rd, & -! rv => con_rv, cpd => con_cp, fv => con_fvirt,& -! arad => con_rerth - implicit none - - real, parameter :: grav =9.81, cpd = 1004. - real, parameter :: rd = 287.0 , rv =461.5 - real, parameter :: grav2 = grav + grav - real, parameter :: rgrav = 1.0/grav, rgrav2= rgrav*rgrav - - real, parameter :: fv = rv/rd - 1.0 - real, parameter :: rdi = 1.0 / rd, rcpd = 1./cpd, rcpd2 = 0.5/cpd - real, parameter :: gor = grav/rd - real, parameter :: gr2 = grav*gor - real, parameter :: grcp = grav*rcpd, gocp = grcp - real, parameter :: rcpdl = cpd*rgrav ! 1/[g/cp] == cp/g - real, parameter :: grav2cpd = grav*grcp ! g*(g/cp)= g^2/cp - - real, parameter :: pi = 4.*atan(1.0), pi2 = 2.*pi, pih = .5*pi - real, parameter :: rad_to_deg=180.0/pi, deg_to_rad=pi/180.0 - - real, parameter :: arad = 6370.e3 -! - real, parameter :: bnv2min = (pi2/1800.)*(pi2/1800.) - real, parameter :: bnv2max = (pi2/30.)*(pi2/30.) - - real, parameter :: dw2min=1.0, velmin=sqrt(dw2min), minvel = 0.5 - real, parameter :: omega1 = pi2/86400. - real, parameter :: omega2 = 2.*omega1, omega3 = 3.*omega1 - real, parameter :: hpscale= 7000., rhp=1./hpscale, rhp2=.5*rhp, rh4 = 0.25*rhp - real, parameter :: mkzmin = pi2/80.0e3, mkz2min = mkzmin*mkzmin - real, parameter :: mkzmax = pi2/500., mkz2max = mkzmax*mkzmax - real, parameter :: cdmin = 2.e-2/mkzmax - end module ugwp_common_v1 -! -! -!=================================================== -! -!Part-1 init => wave dissipation + RFriction -! -!=================================================== - subroutine init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & - pa_rf, tau_rf, me, master) - - - implicit none - integer , intent(in) :: me, master - integer , intent(in) :: levs - real, intent(in) :: con_pi, pa_rf, tau_rf - real, intent(in) :: zkm(levs), pmb(levs) ! in km-Pa - real, intent(out), dimension(levs+1) :: kvg, ktg, krad, kion -! -!locals + data -! - integer :: k - real, parameter :: vusurf = 2.e-5 - real, parameter :: musurf = vusurf/1.95 - real, parameter :: hpmol = 8.5 -! - real, parameter :: kzmin = 0.1 - real, parameter :: kturbo = 100. - real, parameter :: zturbo = 130. - real, parameter :: zturw = 30. - real, parameter :: inv_pra = 3. !kt/kv =inv_pr -! - real, parameter :: alpha = 1./86400./15. ! height variable see Zhu-1993 from 60-days => 6 days - real :: pa_alp = 750. ! super-RF parameters - real :: tau_alp = 10. ! days (750 Pa /10days) -! - real, parameter :: kdrag = 1./86400./30. !parametrization for WAM for FV3GFS SuperRF - real, parameter :: zdrag = 100. - real, parameter :: zgrow = 50. -! - real :: vumol, mumol, keddy, ion_drag - real :: rf_fv3, rtau_fv3, ptop, pih_dlog -! - real :: ae1 ,ae2 - real :: pih - - pih = 0.5*con_pi - - pa_alp = pa_rf - tau_alp = tau_rf - - ptop = pmb(levs) - rtau_fv3 = 1./86400./tau_alp - pih_dlog = pih/log(pa_alp/ptop) - - do k=1, levs - ae1 = -zkm(k)/hpmol - vumol = vusurf*exp(ae1) - mumol = musurf*exp(ae1) - ae2 = -((zkm(k)-zturbo) /zturw)**2 - keddy = kturbo*exp(ae2) - - kvg(k) = vumol + keddy - ktg(k) = mumol + keddy*inv_pra - - krad(k) = alpha -! - ion_drag = kdrag -! - kion(k) = ion_drag! -! add Rayleigh_Super of FV3 for pmb < pa_alp -! - if (pmb(k) .le. pa_alp) then - rf_fv3=rtau_fv3*sin(pih_dlog*log(pa_alp/pmb(k)))**2 - krad(k) = krad(k) + rf_fv3 - kion(k) = kion(k) + rf_fv3 - - endif - -! write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) - enddo - - k= levs+1 - kion(k) = kion(k-1) - krad(k) = krad(k-1) - kvg(k) = kvg(k-1) - ktg(k) = ktg(k-1) - if (me == master) then - write(6, * ) ' zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k) ' - do k=1, levs, 1 - write(6,132) zkm(k), kvg(k), kvg(k)*(6.28/5000.)**2, kion(k), pmb(k) - enddo - endif -! - 132 format( 2x, F8.3,' dis-scales:', 4(2x, E10.3)) - - end subroutine init_global_gwdis_v1 -! -! - subroutine rf_damp_init_v1(levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) - implicit none - - integer :: levs - real :: pa_rf, tau_rf - real :: dtp - - real :: pmb(levs) - real :: rfdis(levs), rfdist(levs) - integer :: levs_rf - - real :: krf, krfz - integer :: k -! - rfdis(1:levs) = 1.0 - rfdist(1:levs) = 0.0 - levs_rf = levs - if (tau_rf <= 0.0 .or. pa_rf == 0.0) return - - krf = 1.0/(tau_rf*86400.0) - - do k=levs, 1, -1 - if(pmb(k) < pa_rf ) then ! applied only on constant pressure surfaces fixed pmb in "Pa" - krfz = krf*log(pa_rf/pmb(k)) - rfdis(k) = 1.0/(1.+krfz*dtp) - rfdist(k) = (rfdis(k) -1.0)/dtp ! du/dtp - levs_rf = k - endif - enddo - - end subroutine rf_damp_init_v1 -! ======================================================================== -! Part 2 - sources -! wave sources -! ======================================================================== -! -! ugwp_oro_init_v1 -! -!========================================================================= - module ugwp_oro_init_v1 - - use ugwp_common_v1, only : bnv2min, grav, grcp, fv, grav, cpd, grcp, pi - use ugwp_common_v1, only : mkzmin, mkz2min - implicit none -! -! constants and "crirtical" values to run oro-mtb_gw physics -! -! choice of oro-scheme: strver = 'vay_2018' , 'gfs_2018', 'kdn_2005', 'smc_2000' -! -! - real, parameter :: hncrit=9000. ! max value in meters for elvmax - real, parameter :: hminmt=50. ! min mtn height (*j*) - real, parameter :: sigfac=4.0 ! mb3a expt test for elvmax factor -! -! - real, parameter :: minwnd=1.0 ! min wind component (*j*) - real, parameter :: dpmin=5000.0 ! minimum thickness of the reference layer in pa - real, parameter :: hpmax=2400.0, hpmin=25.0 - - character(len=8) :: strver = 'gfs_2018' - character(len=8) :: strbase = 'gfs_2018' - real, parameter :: rimin=-10., ric=0.25 - -! - real, parameter :: efmin=0.5, efmax=10.0 - - - real, parameter :: sigma_std=1./100., gamm_std=1.0 - - real, parameter :: frmax=10., frc =1.0, frmin =0.01 -! - - real, parameter :: ce=0.8, ceofrc=ce/frc, cg=0.5 - real, parameter :: gmax=1.0, veleps=1.0, factop=0.5 -! - real, parameter :: rlolev=50000.0 -! - - -! hncrit set to 8000m and sigfac added to enhance elvmax mtn hgt - - - - real, parameter :: kxoro=6.28e-3/200. ! - real, parameter :: coro = 0.0 - integer, parameter :: nridge=2 - - real :: cdmb ! scale factors for mtb - real :: cleff ! scale factors for orogw - integer :: nworo ! number of waves - integer :: nazoro ! number of azimuths - integer :: nstoro ! flag for stochastic launch above SG-peak - - integer, parameter :: mdir = 8 - real, parameter :: fdir=.5*mdir/pi - - integer nwdir(mdir) - data nwdir/6,7,5,8,2,3,1,4/ - save nwdir - - real, parameter :: odmin = 0.1, odmax = 10.0 -!------------------------------------------------------------------------------ -! small-scale orography parameters for TOFD of Beljaars et al., 2004, QJRMS -!------------------------------------------------------------------------------ - - integer, parameter :: n_tofd = 2 ! depth of SSO for TOFD compared with Zpbl - real, parameter :: const_tofd = 0.0759 ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - real, parameter :: ze_tofd = 1500.0 ! BJ's z-decay in meters - real, parameter :: a12_tofd = 0.0002662*0.005363 ! BJ's k-spect const for sigf2 * a1*a2*exp(-[z/zdec]**1.5] - real, parameter :: ztop_tofd = 10.*ze_tofd ! no TOFD > this height too higher 15 km -!------------------------------------------------------------------------------ -! - real, parameter :: fcrit_sm = 0.7, fcrit_sm2 = fcrit_sm * fcrit_sm - real, parameter :: fcrit_gfs = 0.7 - real, parameter :: fcrit_mtb = 0.7 - - real, parameter :: zbr_pi = (1.0/2.0)*pi - real, parameter :: zbr_ifs = 0.5*pi - - contains -! - subroutine init_oro_gws(nwaves, nazdir, nstoch, effac, & - lonr, kxw, cdmbgwd ) -! -! - integer :: nwaves, nazdir, nstoch - integer :: lonr - real :: cdmbgwd(2) ! scaling factors for MTb (1) & (2) for cleff = cleff * cdmbgwd(2) - ! high res-n "larger" MTB and "less-active" cleff in GFS-2018 - real :: cdmbX - real :: kxw - real :: effac ! it is analog of cdmbgwd(2) for GWs, off for now -!-----------------------------! GFS-setup for cdmb & cleff -! cdmb = 4.0 * (192.0/IMX) -! cleff = 0.5E-5 / SQRT(IMX/192.0) = 0.5E-5*SQRT(192./IMX) -! - real, parameter :: lonr_refmb = 4.0 * 192.0 - real, parameter :: lonr_refgw = 192.0 - -! copy to "ugwp_oro_init_v1" => nwaves, nazdir, nstoch - - nworo = nwaves - nazoro = nazdir - nstoro = nstoch - - cdmbX = lonr_refmb/float(lonr) - cdmb = cdmbX - if (cdmbgwd(1) >= 0.0) cdmb = cdmb * cdmbgwd(1) - - cleff = 0.5e-5 * sqrt(lonr_refgw/float(lonr)) !* effac - -!!! cleff = kxw * sqrt(lonr_refgw/float(lonr)) !* effac - - if (cdmbgwd(2) >= 0.0) cleff = cleff * cdmbgwd(2) -! -!.................................................................... -! higher res => smaller h' ..&.. higher kx -! flux_gwd ~ 'u'^2*kx/kz ~kxu/n ~1/dx *u/n tau ~ h'*h'*kx*kx = const (h'-less kx-grow) -!.................................................................... -! -! print *, ' init_oro_gws 2-1cdmb', cdmbgwd(2), cdmbgwd(1) - end subroutine init_oro_gws -! - - end module ugwp_oro_init_v1 -! ========================================================================= -! -! ugwp_conv_init_v1 -! -!========================================================================= - module ugwp_conv_init_v1 - - implicit none - real :: eff_con ! scale factors for conv GWs - integer :: nwcon ! number of waves - integer :: nazcon ! number of azimuths - integer :: nstcon ! flag for stochastic choice of launch level above Conv-cloud - real :: con_dlength - real :: con_cldf - - real, parameter :: cmin = 5 !2.5 - real, parameter :: cmax = 95. !82.5 - real, parameter :: cmid = 22.5 - real, parameter :: cwid = cmid - real, parameter :: bns = 2.e-2, bns2 = bns*bns, bns4=bns2*bns2 - real, parameter :: mstar = 6.28e-3/2. ! 2km - real :: dc - - real, allocatable :: ch_conv(:), spf_conv(:) - real, allocatable :: xaz_conv(:), yaz_conv(:) - contains -! - subroutine init_conv_gws(nwaves, nazdir, nstoch, effac, & - con_pi, arad, lonr, kxw, cgwf) - - implicit none - - integer :: nwaves, nazdir, nstoch - integer :: lonr - real :: con_pi, arad - real :: cgwf(2) - real :: kxw, effac - real :: work1 = 0.5 - real :: chk, tn4, snorm - integer :: k - - nwcon = nwaves - nazcon = nazdir - nstcon = nstoch - eff_con = effac - - con_dlength = 2.0*con_pi*arad/float(lonr) - con_cldf = cgwf(1) * work1 + cgwf(2) *(1.-work1) -! -! allocate & define spectra in "selected direction": "dc" "ch(nwaves)" -! - if (.not. allocated(ch_conv)) allocate (ch_conv(nwaves)) - if (.not. allocated(spf_conv)) allocate (spf_conv(nwaves)) - if (.not. allocated(xaz_conv)) allocate (xaz_conv(nazdir)) - if (.not. allocated(yaz_conv)) allocate (yaz_conv(nazdir)) - - dc = (cmax-cmin)/float(nwaves-1) -! -! we may use different spectral "shapes" -! for example FVS-93 "Desabeius" -! E(s=1, t=3,m, w, k) ~ m^s/(m*^4 + m^4) ~ m^-3 saturated tail -! - do k = 1,nwaves - chk = cmin + (k-1)*dc - tn4 = (mstar*chk)**4 - ch_conv(k) = chk - spf_conv(k) = bns4*chk/(bns4+tn4) - enddo - - snorm = sum(spf_conv) - spf_conv = spf_conv/snorm*1.5 - - call init_nazdir(con_pi, nazdir, xaz_conv, yaz_conv) - end subroutine init_conv_gws - - - end module ugwp_conv_init_v1 -!========================================================================= -! -! ugwp_fjet_init_v1 -! -!========================================================================= - - module ugwp_fjet_init_v1 - implicit none - real :: eff_fj ! scale factors for conv GWs - integer :: nwfj ! number of waves - integer :: nazfj ! number of azimuths - integer :: nstfj ! flag for stochastic choice of launch level above Conv-cloud -! - real, parameter :: fjet_trig=0. ! if ( abs(frgf) > fjet_trig ) launch GW-packet - - - real, parameter :: cmin = 2.5 - real, parameter :: cmax = 67.5 - real :: dc - real, allocatable :: ch_fjet(:) , spf_fjet(:) - real, allocatable :: xaz_fjet(:), yaz_fjet(:) - contains - subroutine init_fjet_gws(nwaves, nazdir, nstoch, effac, & - con_pi, lonr, kxw) - implicit none - - integer :: nwaves, nazdir, nstoch - integer :: lonr - real :: con_pi - real :: kxw, effac , chk - - integer :: k - - nwfj = nwaves - nazfj = nazdir - nstfj = nstoch - eff_fj = effac - - if (.not. allocated(ch_fjet)) allocate (ch_fjet(nwaves)) - if (.not. allocated(spf_fjet)) allocate (spf_fjet(nwaves)) - if (.not. allocated(xaz_fjet)) allocate (xaz_fjet(nazdir)) - if (.not. allocated(yaz_fjet)) allocate (yaz_fjet(nazdir)) - - dc = (cmax-cmin)/float(nwaves-1) - do k = 1,nwaves - chk = cmin + (k-1)*dc - ch_fjet(k) = chk - spf_fjet(k) = 1.0 - enddo - call init_nazdir(con_pi, nazdir, xaz_fjet, yaz_fjet) - - end subroutine init_fjet_gws - - end module ugwp_fjet_init_v1 -! -!========================================================================= -! -! - module ugwp_okw_init_v1 -!========================================================================= - implicit none - - real :: eff_okw ! scale factors for conv GWs - integer :: nwokw ! number of waves - integer :: nazokw ! number of azimuths - integer :: nstokw ! flag for stochastic choice of launch level above Conv-cloud -! - real, parameter :: okw_trig=0. ! if ( abs(okwp) > okw_trig ) launch GW-packet - - real, parameter :: cmin = 2.5 - real, parameter :: cmax = 67.5 - real :: dc - real, allocatable :: ch_okwp(:), spf_okwp(:) - real, allocatable :: xaz_okwp(:), yaz_okwp(:) - - contains -! - subroutine init_okw_gws(nwaves, nazdir, nstoch, effac, & - con_pi, lonr, kxw) - - implicit none - - integer :: nwaves, nazdir, nstoch - integer :: lonr - real :: con_pi - real :: kxw, effac , chk - - integer :: k - - nwokw = nwaves - nazokw = nazdir - nstokw = nstoch - eff_okw = effac - - if (.not. allocated(ch_okwp)) allocate (ch_okwp(nwaves)) - if (.not. allocated(spf_okwp)) allocate (spf_okwp(nwaves)) - if (.not. allocated(xaz_okwp)) allocate (xaz_okwp(nazdir)) - if (.not. allocated(yaz_okwp)) allocate (yaz_okwp(nazdir)) - dc = (cmax-cmin)/float(nwaves-1) - do k = 1,nwaves - chk = cmin + (k-1)*dc - ch_okwp(k) = chk - spf_okwp(k) = 1. - enddo - - call init_nazdir(con_pi, nazdir, xaz_okwp, yaz_okwp) - - end subroutine init_okw_gws - - end module ugwp_okw_init_v1 - -!=============================== end of GW sources -! -! init specific gw-solvers (1,2,3,4) -! - -!=============================== -! Part -3 init wave solvers -!=============================== - - module ugwp_lsatdis_init_v1 - implicit none - - integer :: nwav, nazd - integer :: nst - real :: eff - integer, parameter :: incdim = 4, iazdim = 4 -! - contains - - subroutine initsolv_lsatdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) - - implicit none -! - integer :: me, master - integer :: nwaves, nazdir - integer :: nstoch - real :: effac - logical :: do_physb - real :: kxw -! -!locals: define azimuths and Ch(nwaves) - domain when physics-based soureces -! are not actibve -! - integer :: inc, jk, jl, iazi, i, j, k - - if( nwaves == 0 .or. nstoch == 1 ) then -! redefine from the default - nwav = incdim - nazd = iazdim - nst = 0 - eff = 1.0 - else -! from input_nml multi-wave spectra - nwav = nwaves - nazd = nazdir - nst = nstoch - eff = effac - endif -! - end subroutine initsolv_lsatdis -! - end module ugwp_lsatdis_init_v1 -! -! - module ugwp_wmsdis_init_v1 - - use ugwp_common_v1, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4, omega2 - use ugwp_common_v1, only : bnv2max, bnv2min, minvel - use ugwp_common_v1, only : mkzmin, mkz2min, mkzmax, mkz2max, cdmin - implicit none - - real, parameter :: maxdudt = 250.e-5, maxdtdt=15.e-2 - real, parameter :: dked_min =0.01, dked_max=250.0 - - real, parameter :: gptwo=2.0 - - real , parameter :: bnfix = pi2/300., bnfix2= bnfix * bnfix - real , parameter :: bnfix4 = bnfix2 * bnfix2 - real , parameter :: bnfix3 = bnfix2 * bnfix -! -! make parameter list that will be passed to SOLVER -! -! integer, parameter :: klaunch=55 ! 32 - ~ 1km ;55 - 5.5 km ; 52 4.7km ; 60-7km index for selecting launch level -! integer, parameter :: ilaunch=klaunch - - integer , parameter :: iazidim=4 ! number of azimuths - integer , parameter :: incdim=25 ! number of discrete cx - spectral elements in launch spectrum - real , parameter :: ucrit=cdmin - - real , parameter :: zcimin = 2.5 - real , parameter :: zcimax = 125.0 - real , parameter :: zgam = 0.25 -! -! Verical spectra -! - real , parameter :: pind_wd = 5./3. - real , parameter :: sind_kz = 1. - real , parameter :: tind_kz = 3. - real , parameter :: stind_kz = sind_kz + tind_kz -! -! from kmob_ugwp namelist -! - real :: nslope ! the GW sprctral slope at small-m - real :: lzstar - real :: lzmin - real :: lzmax - real :: lhmet - real :: tamp_mpa !amplitude for GEOS-5/MERRA-2 - real :: tau_min ! min of GW MF 0.25 mPa - integer :: ilaunch - real :: gw_eff - - real :: v_kxw, rv_kxw, v_kxw2 - - - -!=========================================================================== - integer :: nwav, nazd, nst - real :: eff - - real :: zaz_fct, zms - real, allocatable :: zci(:), zci4(:), zci3(:),zci2(:), zdci(:) - real, allocatable :: zcosang(:), zsinang(:) - real, allocatable :: lzmet(:), czmet(:), mkzmet(:), dczmet(:), dmkz(:) - -! -! GW-eddy constants for wave-mode dissipation by background and stability of -! "final" flow after application of GW-effects -! - real, parameter :: iPr_pt = 0.5 - real, parameter :: lturb = 30., sc2 = lturb*lturb ! stable on 80-km TL lmix ~ 500 met. - real, parameter :: ulturb=150., sc2u = ulturb* ulturb ! unstable - real, parameter :: ric =0.25 - real, parameter :: rimin = -10., prmin = 0.25 - real, parameter :: prmax = 4.0 -! - contains -!============================================================================ - subroutine initsolv_wmsdis(me, master, nwaves, nazdir, nstoch, effac, do_physb, kxw) - -! call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & -! knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) -! - implicit none -! -!input -control for solvers: -! nwaves, nazdir, nstoch, effac, do_physb, kxw -! -! - integer :: me, master, nwaves, nazdir, nstoch - real :: effac, kxw - logical :: do_physb - real :: dlzmet -! -!locals -! - integer :: inc, jk, jl, iazi -! - real :: zang, zang1, znorm - real :: zx1, zx2, ztx, zdx, zxran, zxmin, zxmax, zx, zpexp - real :: fpc, fpc_dc - real :: ae1,ae2 - if( nwaves == 0) then -! -! redefine from the deafault -! - nwav = incdim - nazd = iazidim - nst = 0 - eff = 1.0 - gw_eff = eff - else -! -! from input.nml -! - nwav = nwaves - nazd = nazdir - nst = nstoch - gw_eff = effac - endif - - - v_kxw = pi2/lhmet ; v_kxw2 = v_kxw*v_kxw - rv_kxw = 1./v_kxw - - allocate ( zci(nwav), zci4(nwav), zci3(nwav),zci2(nwav), zdci(nwav) ) - allocate ( zcosang(nazd), zsinang(nazd) ) - allocate (lzmet(nwav), czmet(nwav), mkzmet(nwav), dczmet(nwav), dmkz(nwav) ) - - if (me == master) then - print *, 'ugwp_v1: init_gw_wmsdis_control ' -! - print *, 'ugwp_v1: WMS_DIS launch layer ', ilaunch - print *, 'ugwp_v1: WMS_DIS tot_mflux in mpa', tamp_mpa*1000. - print *, 'ugwp_v1: WMS_DIS lhmet in km ' , lhmet*1.e-3 - endif - - zpexp = gptwo * 0.5 ! gptwo=2 , zpexp = 1. - -! -! set up azimuth directions and some trig factors -! -! - zang = pi2 / float(nazd) - -! get normalization factor to ensure that the same amount of momentum -! flux is directed (n,s,e,w) no mater how many azimuths are selected. -! - znorm = 0.0 - do iazi=1, nazd - zang1 = (iazi-1)*zang - zcosang(iazi) = cos(zang1) - zsinang(iazi) = sin(zang1) - znorm = znorm + abs(zcosang(iazi)) - enddo -! zaz_fct = 1.0 - zaz_fct = 2.0 / znorm ! correction factor for azimuthal sums - -! define coordinate transform for "Ch" ....x = 1/c stretching transform -! ----------------------------------------------- -! -! x=1/Cphase transform -! see eq. 28-30 Scinocca 2003. x = 1/c stretching transform -! - zxmax = 1.0 / zcimin - zxmin = 1.0 / zcimax - zxran = zxmax - zxmin - zdx = zxran / real(nwav-1) ! dkz -! - ae1=zxran/zgam - zx1 = zxran/(exp(ae1)-1.0 ) ! zgam =1./4. - zx2 = zxmin - zx1 - -! -! computations for zci =1/zx, stretching "accuracy" is not "accurate" spectra transform -! it represents additional "empirical" redistribution of "spectral" mode in C-space -! - zms = pi2 / lzstar - - do inc=1, nwav - ztx = real(inc-1)*zdx+zxmin - ae1 = (ztx-zxmin)/zgam - zx = zx1*exp(ae1)+zx2 !eq.(29-30),Scinocca-2003 - zci(inc) = 1.0 /zx ! - zdci(inc) = zci(inc)**2*(zx1/zgam)*exp(ae1)*zdx ! - zci4(inc) = (zms*zci(inc))**4 - zci2(inc) = (zms*zci(inc))**2 - zci3(inc) = (zms*zci(inc))**3 - enddo -! -! -! alternatuve lzmax-lzmin -! -! - dlzmet = (lzmax-lzmin)/ real(nwav-1) - do inc=1, nwav - lzmet(inc) = lzmin + (inc-1)*dlzmet - mkzmet(inc) = pi2/lzmet(inc) - zci(inc) =lzmet(inc)/(pi2/bnfix) - zci4(inc) = (zms*zci(inc))**4 - zci2(inc) = (zms*zci(inc))**2 - zci3(inc) = (zms*zci(inc))**3 - - enddo - - zdx = (zci(nwav)-zci(1))/ real(nwav-1) - - - if (me == master) then - print * - print *, 'ugwp_v0: zcimin=' , zcimin - print *, 'ugwp_v0: zcimax=' , zcimax - print *, 'ugwp_v0: zgam= ', zgam - print * - -! print *, ' ugwp_v1 nslope=', nslope - print * - print *, 'ugwp_v1: zcimin/zci=' , maxval(zci) - print *, 'ugwp_v1: zcimax/zci=' , minval(zci) - print *, 'ugwp_v1: cd_crit=', ucrit - print *, 'ugwp_v1: launch_level', ilaunch - print *, ' ugwp_v1 lzstar=', lzstar - print *, ' ugwp_v1 nslope=', nslope - - print * - do inc=1, nwav - zdci(inc) = zdx - if (nslope == 1) fpc = bnfix4*zci(inc)/ (bnfix4+zci4(inc)) - if (nslope == 0) fpc = bnfix3*zci(inc)/ (bnfix3+zci3(inc)) - fpc_dc = fpc * zdci(inc) - write(6,111) inc, zci(inc), zdci(inc),ucrit, fpc, fpc_dc, 6.28e-3/bnfix*zci(inc) - enddo - endif - 111 format( 'wms-zci', i4, 7 (3x, F8.3)) - - end subroutine initsolv_wmsdis -! -! make a list of all-initilized parameters needed for "gw_solver_wmsdis" -! - - end module ugwp_wmsdis_init_v1 -!========================================================================= -! -! work TODO for 2-extra WAM-solvers: -! DSPDIS (Hines)+ADODIS (Alexander-Dunkerton-Ortland) -! -!========================================================================= - subroutine init_dspdis_v1 - implicit none - end subroutine init_dspdis_v1 - - subroutine init_adodis_v1 - implicit none - end subroutine init_adodis_v1 - diff --git a/physics/cires_ugwp_module.F90 b/physics/cires_ugwp_module.F90 index 51c297237..620386ead 100644 --- a/physics/cires_ugwp_module.F90 +++ b/physics/cires_ugwp_module.F90 @@ -1,17 +1,12 @@ ! -module cires_ugwp_module +module cires_ugwpv0_module ! ! driver is called after pbl & before chem-parameterizations ! -!.................................................................................... -! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re -!................................................................................... -! -! + implicit none logical :: module_is_initialized -!logical :: do_ugwp = .false. ! control => true - ugwp false old gws + rayeleigh friction logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver @@ -54,7 +49,7 @@ module cires_ugwp_module data knob_ugwp_azdir /2, 4, 4,4/ ! number of wave azimuths for- (oro, fronts, conv, imbf-okwp] data knob_ugwp_stoch /0, 0, 0,0/ ! 0 - deterministic ; 1 - stochastic, non-activated option data knob_ugwp_effac /1.,1.,1.,1./ ! efficiency factors for- (oro, fronts, conv, imbf-owp] - integer :: knob_ugwp_version = 0 + integer :: knob_ugwp_version = 0 ! version control had sense under IPD in CCPP=> to SUITES integer :: launch_level = 55 ! namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & @@ -106,16 +101,14 @@ module cires_ugwp_module ! init of cires_ugwp (_init) called from GFS_driver.F90 ! ! ----------------------------------------------------------------------- - subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + subroutine cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & fn_nml, lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, cgwf, & pa_rf_in, tau_rf_in) - use ugwp_oro_init, only : init_oro_gws - use ugwp_conv_init, only : init_conv_gws - use ugwp_fjet_init, only : init_fjet_gws - use ugwp_okw_init, only : init_okw_gws - use ugwp_wmsdis_init, only : initsolv_wmsdis, ilaunch - use ugwp_lsatdis_init, only : initsolv_lsatdis + use ugwpv0_oro_init, only : init_oro_gws_v0 + use ugwpv0_wmsdis_init, only : initsolv_wmsdis_v0, ilaunch + use ugwpv0_lsatdis_init, only : initsolv_lsatdis_v0 + implicit none integer, intent (in) :: me @@ -132,7 +125,6 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW schemes real, intent (in) :: pa_rf_in, tau_rf_in -! integer, parameter :: logunit = 6 integer :: ios logical :: exists real :: dxsg @@ -155,8 +147,6 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & read (nlunit, nml = cires_ugwp_nml) close (nlunit) #endif - - ! ilaunch = launch_level @@ -173,13 +163,6 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & ! effective kxw - resolution-aware ! dxsg = pi2*arad/float(lonr) * knob_ugwp_ndx4lh -! -! kxw = pi2/dxsg -! -! init global background dissipation for ugwp -> 4d-variable for fv3wam linked with pbl-vert_diff -! - -! allocate(fcor(latr), fcor2(latr) ) ! allocate( kvg(levs+1), ktg(levs+1) ) allocate( krad(levs+1), kion(levs+1) ) @@ -195,50 +178,22 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & ! ! Part-1 :init_global_gwdis ! - call init_global_gwdis(levs, zkm, pmb, kvg, ktg, krad, kion) - call rf_damp_init (levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) + call init_global_gwdis_v0(levs, zkm, pmb, kvg, ktg, krad, kion) + ! -! Part-2 :init_SOURCES_gws +! Part-2 :init_SOURCES_gws -- only orowaves, but ugwp-v0 is based on gwdps.f of EMC ! ! ! call init-solver for "stationary" multi-wave spectra and sub-grid oro ! - call init_oro_gws( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & + call init_oro_gws_v0( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & knob_ugwp_stoch(1), knob_ugwp_effac(1), lonr, kxw, cdmvgwd ) ! ! call init-sources for "non-sationary" multi-wave spectra ! do_physb_gwsrcs=.true. - IF (do_physb_gwsrcs) THEN - - if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init ' - if (knob_ugwp_wvspec(4) > 0) then -! okw - call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & - knob_ugwp_stoch(4), knob_ugwp_effac(4), lonr, kxw ) - if (me == master) print *, ' init_okw_gws ' - endif - - if (knob_ugwp_wvspec(3) > 0) then -! fronts - call init_fjet_gws(knob_ugwp_wvspec(3), knob_ugwp_azdir(3), & - knob_ugwp_stoch(3), knob_ugwp_effac(3), lonr, kxw ) - if (me == master) print *, ' init_fjet_gws ' - endif - - if (knob_ugwp_wvspec(2) > 0) then -! conv - call init_conv_gws(knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & - knob_ugwp_stoch(2), knob_ugwp_effac(2), lonr, kxw, cgwf ) - if (me == master) & - print *, ' init_convective GWs cgwf', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) - - endif - - ENDIF !IF (do_physb_gwsrcs) - !====================== ! Part-3 :init_SOLVERS ! ===================== @@ -247,428 +202,40 @@ subroutine cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & ! if (knob_ugwp_solver==1) then ! - call initsolv_lsatdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + call initsolv_lsatdis_v0(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw ) endif if (knob_ugwp_solver==2) then - call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & + call initsolv_wmsdis_v0(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) endif -! -! other solvers not yet tested for fv3gfs -! -!< if (knob_ugwp_solver==3) call init_dspdis -!< if (knob_ugwp_solver==4) call init_adodis -! + !====================== module_is_initialized = .true. - if (me == master) print *, ' VAY-ugwp is initialized ', module_is_initialized - - end subroutine cires_ugwp_mod_init - -! ----------------------------------------------------------------------- -! -! driver of cires_ugwp (_driver) -! called from GFS_physics_driver.F90 -! -! ----------------------------------------------------------------------- -! call cires_ugwp_driver & -! (im, levs, dtp, kdt, me, lprnt, Model%lonr, & -! Model%prslrd0, Model%ral_ts, Model%cdmbgwd, & -! Grid%xlat, Grid%xlat_d, Grid%sinlat, Grid%coslat, & -! Statein, delp_gws, Oro_stat, & -! dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & -! Diag%gwp_ax, Diag%gwp_axo, Diag%gwp_axc, Diag%gwp_axf, & -! Diag%gwp_ay, Diag%gwp_ayo, Diag%gwp_ayc, Diag%gwp_ayf, & -! Diag%gwp_dtdt, Diag%gwp_kdis, Diag%gwp_okw, Diag%gwp_fgf, & -! Diag%gwp_dcheat, Diag%gwp_precip, Diag%gwp_klevs, & -! Diag%zmtb, Diag%gwp_scheat, dlength, cldf, & -! Diag%tau_tofd, Diag%tau_mtb, Diag%tau_ogw, Diag%tau_ngw, & -! Diag%zmtb, Diag%zlwb, Diag%zogw, Diag%du3dt_mtb, & -! Diag%du3dt_ogw, Diag%du3dt_tms ) - - subroutine cires_ugwp_driver & - (im, levs, dtp, kdt, me, lprnt, lonr, & - pa_rf, tau_rf, cdmbgwd, xlat, xlatd, sinlat, coslat, & - ugrs, vgrs, tgrs, qgrs, prsi, prsl, prslk, phii, phil, & - delp, orostat, kpbl, & - dusfc, dvsfc, dudt, dvdt, dtdt, kdis, & - axtot, axo, axc, axf, aytot, ayo, ayc, ayf, & - eps_tot, ekdis, trig_okw, trig_fgf, & - dcheat, precip, cld_klevs, zmtb, scheat, dlength, cldf, & - taus_sso, taus_ogw, tauf_ogw, tauf_ngw, & - ugw_zmtb, ugw_zlwb, ugw_zogw, ugw_axmtb, ugw_axlwb, ugw_axtms ) - -! - use machine, only: kind_phys - use physcons, only: con_cp, con_fvirt, con_g, con_rd - use ugwp_common, only: omega2 -! -! - use ugwp_okw_init, only : & - eff_okw, nstokw, nwokw, ch_okwp, nazokw, spf_okwp, xaz_okwp, yaz_okwp - use ugwp_conv_init, only : & - eff_con, nstcon, nwcon, ch_conv, nazcon, spf_conv, xaz_conv, yaz_conv - use ugwp_fjet_init, only : & - eff_fj, nstfj, nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet - -! - implicit none -! - - logical :: lprnt - integer :: me, im, levs, kdt, lonr - real(kind_phys) :: dtp - real(kind_phys) :: pa_rf, tau_rf - real(kind_phys) :: cdmbgwd(2) - - integer, intent(in) :: kpbl(im) - real(kind_phys) :: hpbl(im) - real(kind_phys), intent(in) :: orostat(im, 14) - real(kind_phys), intent(in), dimension(im,levs) :: ugrs, vgrs, & - tgrs, qgrs, prsi, prsl, prslk, phii, phil, delp -! - real(kind_phys), dimension(im) :: xlat, xlatd, sinlat, coslat - real(kind_phys), dimension(im, levs) :: trig_okw, trig_fgf - real(kind_phys), dimension(im) :: precip ! precip-n rates and - integer , dimension(im, 3) :: cld_klevs ! indices fo cloud top/bot/? - real(kind_phys), dimension(im, levs) :: dcheat, scheat ! deep and shal conv heat tend. - - - real(kind_phys), dimension(im) :: dlength ! tail-grid box scale in meters - real(kind_phys), dimension(im) :: cldf ! "bizzard" old cgwd-tuning knobs dimensionless -!=================== -! tendency + kdis -!=================== - real(kind_phys), dimension(im, levs) :: dudt, dvdt, dtdt, kdis - real(kind_phys), dimension(im, levs) :: axtot, axo, axc, axf - real(kind_phys), dimension(im, levs) :: aytot, ayo, ayc, ayf - real(kind_phys), dimension(im, levs) :: eps_tot, ekdis - -! - real(kind_phys), dimension(im, levs) :: eds_o, kdis_o - real(kind_phys), dimension(im, levs) :: eds_c, kdis_c - real(kind_phys), dimension(im, levs) :: eds_f, kdis_f - real(kind_phys), dimension(im, levs) :: ax_rf, ay_rf, eps_rf -! -!================================================================================== -! diagnostics for OGW & NGW + SSO effects axmtb, axlwb, axtms -!================================================================================== - real(kind_phys), dimension(im) :: dusfc, dvsfc - real(kind_phys), dimension(im) :: taus_sso, taus_ogw, tauf_ogw, tauf_ngw - real(kind_phys), dimension(im) :: ugw_zmtb, ugw_zlwb, ugw_zogw - real(kind_phys), dimension(im, levs) :: ugw_axmtb,ugw_axlwb, ugw_axtms - real(kind_phys), dimension(im, levs) :: tauz_ogw, tauz_ngw, wtauz - -! -! knob_ugwp_source=[ 1, 1, 1, 0 ] -! oro conv nst imbal-okw -! locals -! - integer :: i, j, k, istype, ido -! -! internal diagnostics for oro-waves, lee waves, and mtb : -! - real(kind_phys), dimension(im) :: dusfc_mb, dvsfc_mb, dusfc_ogw, dvsfc_ogw - real(kind_phys), dimension(im) :: dusfc_lwb, dvsfc_lwb - real(kind_phys), dimension(im) :: zmtb, zlwb, zogw ! GW-launch levels in "meters" -! - real(kind_phys), dimension(im) :: fcor, c2f2 -! -! three sources with different: a) spectra-content/azimuth; b) efficiency ;c) spectral shape -! - real(kind_phys), dimension(im) :: taub_con, taub_fj, taub_okw - integer , dimension(im) :: klev_okw, klev_fj, klev_con - integer , dimension(im) :: if_okw, if_con, if_fj - integer :: nf_okw, nf_con, nf_fj -! - dudt = 0. - dvdt = 0. - dtdt = 0. - kdis = 0. - axo = 0. ; axc = 0. ; axf = 0. - ayo = 0. ; ayc = 0. ; ayf = 0. - eds_o = 0. ; kdis_o = 0. ; eds_f = 0. ; kdis_f = 0. ; eds_c = 0. ; kdis_c = 0. - ax_rf = 0. ; ay_rf = 0. ; eps_rf = 0 - - hpbl(:) = 2000. ! hpbl (1:im) = phil(1:im, kpbl(1:im)) -! - - do i=1, im - fcor(i) = omega2*sinlat(i) - c2f2(i) = fcor(i)*fcor(i)/(kxw*kxw) - enddo - -! i=im -! print *, i, fcor(i), 6.28e-3/kxw, sqrt(c2f2(i)) -! print *, maxval(statein%prsl/statein%tgrs)/287. , ' density ' - -! -! -! What can be computed for ALL types of GWs? => -! "Br-Vi frequency"with "limits" in case of "conv-unstable" layers -! Background dissipation: Molecular + Eddy -! Wind projections may differ from GW-sources/propagation azimuths -! - do istype=1, size(knob_ugwp_source) - - ido = knob_ugwp_source(istype) ! 0 or 1 off or active - - ugwp_azdir = knob_ugwp_azdir(istype) - ugwp_stoch = knob_ugwp_stoch(istype) - ugwp_nws = knob_ugwp_wvspec(istype) - ugwp_effac = knob_ugwp_effac(istype) - -! -! oro-gw effects -! - if (ido == 1 .and. istype ==1 ) then -! -! 1. solve for OGW effects on the mean flow -! 2. all parts of ORO effexra inside: MTB TOFD LeeWB OGW-drag -! - call ugwp_oro(im, levs, dtp, kdt, me, lprnt, & - fcor, c2f2, ugrs, vgrs, tgrs, & - qgrs, prsi, delp, prsl, prslk, phii, phil, & - orostat, hpbl, axo, ayo, eds_o, kdis_o, & - dusfc, dvsfc, dusfc_mb, dvsfc_mb, dusfc_ogw, dvsfc_ogw, & - dusfc_lwb, dvsfc_lwb, zmtb, zlwb, zogw,tauf_ogw,tauz_ogw,& - ugw_axmtb,ugw_axlwb, ugw_axtms) -! -! taus_sso, taus_ogw, tauz_ogw, tauz_ngw, tauf_ogw, tauf_ngw, & -! ugw_zmtb, ugw_zlwb, ugw_zogw, ugw_axmtb,ugw_axlwb, ugw_axtms -! collect column-integrated "dusfc, dvsfc" only for oro-waves -! - taus_sso = dusfc_mb + dusfc_lwb + dusfc_ogw - taus_ogw = dusfc_ogw - ugw_zmtb = zmtb - ugw_zlwb = zlwb - ugw_zogw = zogw -! tauz_ogw/tauf_ogw => output -! ugwp_azdir, ugwp_stoch, ugwp_nws ..... "multi-wave + stochastic" -! -! stationary gw-mode ch=0, with "gw_solver_linsat" -! compute column-integrated "dusfc, dvsfc" only for oro-waves -! - dudt = dudt + axo * ugwp_effac - dvdt = dvdt + ayo * ugwp_effac - dtdt = dtdt + eds_o * ugwp_effac - kdis = kdis + kdis_o* ugwp_effac -! print *, ' ido istype ORO=1 ', ido, istype, ' ugwp_oro as a solver ' - endif - - if (ido == 1 .and. istype ==2 ) then -! -! convective gw effects -! -! 1. specify spectra + forcing nstcon, nwcon, ch_conv, nazcon, spf_conv -! - call get_spectra_tau_convgw & - (nwcon, im, levs, dcheat, scheat, precip, cld_klevs, & - xlatd, sinlat, coslat, taub_con, klev_con, if_con, nf_con) -! -! 2. solve for GW effects on the mean flow -! - if ( nf_con > 0) then - - klev_con(:) = 52 ! ~5 km -! -!eff_con, nstcon, nwcon, ch_conv, nazcon, spf_conv, xaz_conv, yaz_conv -! - if (knob_ugwp_solver == 1) call gw_solver_linsatdis & - (im, levs, dtp, kdt, me, taub_con, klev_con, if_con, nf_con, & - nwcon, ch_conv, nazcon, spf_conv, xaz_conv, yaz_conv, & - fcor, c2f2, ugrs, vgrs, tgrs, qgrs, prsi, delp, & - prsl, prslk, phii, phil, & - axc, ayc, eds_c, kdis_c, wtauz) - - - if (knob_ugwp_solver == 2) then -! print *, ' before CONV-2 ', ido, istype, ' gw_solver_wmsdis ', knob_ugwp_solver - call gw_solver_wmsdis & - (im, levs, dtp, kdt, me, taub_con, klev_con, if_con, nf_con, & - nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & - fcor, c2f2, ugrs, vgrs, tgrs, & - qgrs, prsi, delp, prsl, prslk, phii, phil, & - axc, ayc, eds_c, kdis_c, wtauz) -! print *, ' after ido istype CONV-2 ', ido, istype, ' gw_solver_wmsdis ', knob_ugwp_solver - endif - - dudt = dudt + axc * ugwp_effac - dvdt = dvdt + ayc * ugwp_effac - dtdt = dtdt + eds_c * ugwp_effac - kdis = kdis + kdis_c * ugwp_effac - - tauz_ngw = wtauz - - endif - - endif - - if (ido == 1 .and. istype ==3 ) then -! -! nonstationary gw effects -! -! 1. specify spectra + forcing -! - call get_spectra_tau_nstgw (nwfj, im, levs, & - trig_fgf, xlatd, sinlat, coslat, taub_fj, klev_fj, if_fj, nf_fj) -! -! 2. solve for GW effects on the mean flow -! - print *, ' tau_nstgw nf_fj-GW triggers ', nf_fj, ' ugwp_solver = ', knob_ugwp_solver - if ( nf_fj > 0) then - - if (knob_ugwp_solver == 1) call gw_solver_linsatdis & - (im, levs, dtp, kdt, me, taub_fj, klev_fj, if_fj, nf_fj, & - nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & - fcor, c2f2, ugrs, vgrs, tgrs, & - qgrs, prsi, delp, prsl, prslk, phii, phil, & - axf, ayf, eds_f, kdis_f, wtauz) - - - - if (knob_ugwp_solver == 2) call gw_solver_wmsdis & - (im, levs, dtp, kdt, me, taub_fj, klev_fj, if_fj, nf_fj, & - nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & - fcor, c2f2, ugrs, vgrs, tgrs, & - qgrs, prsi, delp, prsl, prslk, phii, phil, & - axf, ayf, eds_f, kdis_f, wtauz) - - dudt = dudt + axf * ugwp_effac - dvdt = dvdt + ayf * ugwp_effac - dtdt = dtdt + eds_f * ugwp_effac - kdis = kdis + kdis_f * ugwp_effac - tauz_ngw = wtauz - print *, ' ido istype for FJ 1-4 ', ido, istype, ' gw_solver_wmsdis ', knob_ugwp_solver - - endif - endif -! print *, ' ido istype for okw 1-4 ', ido, istype - if (ido == 1 .and. istype == 4 ) then -! -! nonstationary gw effects due to both "convection +fronts/jets " = imbalance of rs-flow -! -! 1. specify spectra + forcing -! - call get_spectra_tau_okw (nwokw, im, levs,& - trig_okw, xlatd, sinlat, coslat, taub_okw, klev_okw, if_okw, nf_okw) -! -! 2. solve for GW effects on the mean flow -! - if ( nf_okw > 0) then -! - if (knob_ugwp_solver == 1) call gw_solver_linsatdis & - (im, levs, dtp, kdt, me, taub_okw, klev_okw, if_okw, nf_okw, & - nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & - fcor, c2f2, ugrs, vgrs, tgrs, & - qgrs, prsi, delp, prsl, prslk, phii, phil, & - axf, ayf, eds_f, kdis_f, wtauz) - - - if (knob_ugwp_solver == 2) call gw_solver_wmsdis & - (im, levs, dtp, kdt, me, taub_okw, klev_okw, if_okw, nf_okw, & - nwfj, ch_fjet, nazfj, spf_fjet, xaz_fjet, yaz_fjet, & - fcor, c2f2, ugrs, vgrs, tgrs, & - qgrs, prsi, delp, prsl, prslk, phii, phil, & - axf, ayf, eds_f, kdis_f, wtauz) - - dudt = dudt + axf * ugwp_effac - dvdt = dvdt + ayf * ugwp_effac - dtdt = dtdt + eds_f * ugwp_effac - kdis = kdis + kdis_f * ugwp_effac - tauz_ngw = wtauz - endif - endif -! -! broad gw-spectra -! - 356 continue - enddo -! -! gw-diag only -! - axtot = dudt - aytot = dvdt - eps_tot = dtdt - -! -! optional rf-damping -! - if (do_rfdamp) then -! -! - call rf_damp(im, levs, levs_rf, dtp, rfdis, rfdist, ugrs, vgrs, ax_rf, ay_rf, eps_rf) -! -! gw-diag only + rf-damping ..... now orchestrate it with FV3-dycore RF-damping -! - do k=levs_rf, levs - - dudt(:,k) = dudt(:,k) + ax_rf(:,k) - dvdt(:,k) = dvdt(:,k) + ay_rf(:,k) - dtdt(:,k) = dtdt(:,k) + eps_rf(:,k) - - enddo - - endif -!================================================================================ -! To update U-V-T STATE by [dudt dvdt dtdt kdis+rf] => Solve 3-diag VD-equation -!================================================================================ -! to do for fv3wam=> -! joint eddy+molecular viscosity/conductivity/diffusion -! requires "dqdt" + dudt_vis, dvdt_vis. dtdt_cond - -! print *, ' cires_ugwp_driver +++++++++++++++++ ' -! - end subroutine cires_ugwp_driver - - -!============================================= - - - subroutine cires_ugwp_advance -!----------------------------------------------------------------------- -! -! options for the day-to-day variable sources/spectra + diagnostics -! for stochastic "triggers" -! diagnose GW-source functions * FGF + OKWP + SGO/CONV from IAU-fields -! or use for stochastic GWP-sources "memory" -!----------------------------------------------------------------------- - implicit none -! -! update sources -! a) physics-based triggers for multi-wave -! b) stochastic-based spectra and amplitudes -! c) use "memory" on GW-spectra from previous time-step -! d) update "background" GW dissipation as needed -! - end subroutine cires_ugwp_advance - + end subroutine cires_ugwpv0_mod_init ! ! ----------------------------------------------------------------------- ! finalize of cires_ugwp (_finalize) ! ----------------------------------------------------------------------- - - subroutine cires_ugwp_mod_finalize + subroutine cires_ugwpv0_mod_finalize ! ! deallocate sources/spectra & some diagnostics need to find where "deaalocate them" ! before "end" of the FV3GFS ! implicit none ! -! deallocate arrays employed in: -! cires_ugwp_advance / cires_ugwp_driver / cires_ugwp_init +! deallocate arrays employed in V0 ! deallocate( kvg, ktg ) deallocate( krad, kion ) deallocate( zkm, pmb ) deallocate( rfdis, rfdist) - end subroutine cires_ugwp_mod_finalize + end subroutine cires_ugwpv0_mod_finalize ! - end module cires_ugwp_module + end module cires_ugwpv0_module diff --git a/physics/cires_ugwp_module_v1.F90 b/physics/cires_ugwp_module_v1.F90 deleted file mode 100644 index fd41d8175..000000000 --- a/physics/cires_ugwp_module_v1.F90 +++ /dev/null @@ -1,672 +0,0 @@ - -module cires_ugwp_module_v1 - -! -! driver is called after pbl & before chem-parameterizations -! it uses ugwp_common (like phys_cons) and some module-param od solvers/sources init-modules -!.................................................................................... -! order = dry-adj=>conv=mp-aero=>radiation -sfc/land- chem -> vertdiff-> [rf-gws]=> ion-re -!................................................................................... -! -! - use ugwp_common_v1, only : arad, pi, pi2, hpscale, rhp, rhp2, rh4 - implicit none - logical :: module_is_initialized -!logical :: do_ugwp = .false. ! control => true - ugwp false old gws + rayeleigh friction - character(len=8) :: strsolver='pss-1986' - logical :: do_physb_gwsrcs = .false. ! control for physics-based GW-sources - logical :: do_rfdamp = .false. ! control for Rayleigh friction inside ugwp_driver - integer, parameter :: idebug_gwrms=1 ! control for diag computaions pw wind-temp GW-rms and MF fluxs - logical, parameter :: do_adjoro = .false. - real, parameter :: max_kdis = 250. ! 400 m2/s - real, parameter :: max_axyz = 250.e-5 ! 400 m/s/day - real, parameter :: max_eps = max_kdis*4.e-7 ! ~16 K/day max_kdis*BN2/cp - real, parameter :: maxdudt = max_axyz - real, parameter :: maxdtdt = max_eps - real, parameter :: dked_min = 0.01 - real, parameter :: dked_max = max_kdis - - - real, parameter :: hps = hpscale - real, parameter :: hpskm = hps/1000. -! - - real, parameter :: ricrit = 0.25 - real, parameter :: frcrit = 0.50 - real, parameter :: linsat = 1.00 - real, parameter :: linsat2 = linsat*linsat -! -! integer :: curday_ugwp ! yyyymmdd 20150101 -! integer :: ddd_ugwp ! ddd of year from 1-366 - - integer :: knob_ugwp_solver=1 ! 1, 2, 3, 4 - (linsat, ifs_2010, ad_gfdl, dsp_dis) - integer, dimension(4) :: knob_ugwp_source=(/1,0,1,0/) ! [1,0,1,1] - (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_wvspec=(/1,32,32,32/) ! number of waves for- (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_azdir=(/2,4,4,4/) ! number of wave azimuths for- (oro, fronts, conv, imbf-owp] - integer, dimension(4) :: knob_ugwp_stoch=(/0,0,0,0/) ! 0 - deterministic ; 1 - stochastic - real, dimension(4) :: knob_ugwp_effac=(/1.,1.,1.,1./) ! efficiency factors for- (oro, fronts, conv, imbf-owp] - - integer :: knob_ugwp_doaxyz=1 ! 1 -gwdrag - integer :: knob_ugwp_doheat=1 ! 1 -gwheat - integer :: knob_ugwp_dokdis=0 ! 1 -gwmixing - integer :: knob_ugwp_ndx4lh = 2 ! n-number of "unresolved" "n*dx" for lh_gw - integer :: knob_ugwp_nslope = 1 ! spectral"growth" S-slope of GW-energy spectra mkz^S - - real :: knob_ugwp_palaunch = 500.e2 ! fixed pressure layer in Pa for "launch" of NGWs - real :: knob_ugwp_lzmax = 12.5e3 ! 12.5 km max-VERT-WL of GW-spectra - real :: knob_ugwp_lzstar = 2.0e3 ! UTLS mstar = 6.28/lzstar 2-2.5 km - real :: knob_ugwp_lzmin = 1.5e3 ! 1.5 km min-VERT-WL of GW-spectra - real :: knob_ugwp_taumin = 0.25e-3 - real :: knob_ugwp_tauamp = 7.75e-3 ! range from 30.e-3 to 3.e-3 ( space-borne values) - real :: knob_ugwp_lhmet = 200.e3 ! 200 km -! - real :: kxw = pi2/200.e3 ! single horizontal wavenumber of ugwp schemes -! -! tune-ups for qbo -! - real :: knob_ugwp_qbolev = 500.e2 ! fixed pressure layer in Pa for "launch" of conv-GWs - real :: knob_ugwp_qbosin = 1.86 ! semiannual cycle of tau_qbo_src in radians - real :: knob_ugwp_qbotav = 2.285e-3 ! additional to "climate" for QBO-sg forcing - real :: knob_ugwp_qboamp = 1.191e-3 ! additional to "climate" QBO - real :: knob_ugwp_qbotau = 10. ! relaxation time scale in days - real :: knob_ugwp_qbolat = 15. ! qbo-domain for extra-forcing - real :: knob_ugwp_qbowid = 7.5 ! qbo-attenuation for extra-forcing - character(len=8) :: knob_ugwp_orosolv='pss-1986' - - character(len=255) :: ugwp_qbofile = 'qbo_zmf_2009_2018.nc' - character(len=255) :: ugwp_taufile = 'ugwp_limb_tau.nc' - -! character(len=250) :: knob_ugwp_qbofile='qbo_zmf_2009_2018.nc'! -! character(len=250) :: knob_ugwp_amffile='mern_zmf_amf_12month.nc' -! character(len=255) :: file_limb_tab='ugwp_limb_tau.nc' - -! integer, parameter :: ny_tab=73, nt_tab=14 -! real, parameter :: rdy_tab = 1./2.5, rdd_tab = 1./30. -! real :: days_tab(nt_tab), lat_tab(ny_tab) -! real :: abmf_tab(ny_tab,nt_tab) - - integer :: ugwp_azdir - integer :: ugwp_stoch - - integer :: ugwp_src - integer :: ugwp_nws - real :: ugwp_effac - -! - integer :: knob_ugwp_version = 0 - integer :: launch_level = 55 -! - namelist /cires_ugwp_nml/ knob_ugwp_solver, knob_ugwp_source,knob_ugwp_wvspec, knob_ugwp_azdir, & - knob_ugwp_stoch, knob_ugwp_effac,knob_ugwp_doaxyz, knob_ugwp_doheat, knob_ugwp_dokdis, & - knob_ugwp_ndx4lh, knob_ugwp_version, knob_ugwp_palaunch, knob_ugwp_nslope, knob_ugwp_lzmax, & - knob_ugwp_lzmin, knob_ugwp_lzstar, knob_ugwp_lhmet, knob_ugwp_tauamp, knob_ugwp_taumin, & - knob_ugwp_qbolev, knob_ugwp_qbosin, knob_ugwp_qbotav, knob_ugwp_qboamp, knob_ugwp_qbotau, & - knob_ugwp_qbolat, knob_ugwp_qbowid, knob_ugwp_orosolv - -!&cires_ugwp_nml -! knob_ugwp_solver=2 -! knob_ugwp_source=1,1,1,0 -! knob_ugwp_wvspec=1,32,32,32 -! knob_ugwp_azdir =2, 4, 4,4 -! knob_ugwp_stoch =0, 0, 0,0 -! knob_ugwp_effac=1, 1, 1,1 -! knob_ugwp_doaxyz=1 -! knob_ugwp_doheat=1 -! knob_ugwp_dokdis=0 -! knob_ugwp_ndx4lh=4 -!/ -! -! allocatable arrays, initilized during "cires_ugwp_init" & -! released during "cires_ugwp_finalize" -! - real, allocatable :: kvg(:), ktg(:), krad(:), kion(:) - real, allocatable :: zkm(:), pmb(:) - real, allocatable :: rfdis(:), rfdist(:) - integer :: levs_rf - real :: pa_rf, tau_rf -! -! tabulated GW-sources -! - integer :: ntau_d1y, ntau_d2t, nqbo_d1y, nqbo_d2z, nqbo_d3t - real, allocatable :: ugwp_taulat(:), ugwp_qbolat(:) - real, allocatable :: tau_limb(:,:), days_limb(:) - real, allocatable :: uzmf_merra(:,:,:), days_merra(:), pmb127(:) - real, allocatable :: uqboe(:,:) - real, allocatable :: days_y4ddd(:), zkm127(:) - real, allocatable :: tau_qbo(:), stau_qbo(:) - integer,allocatable :: days_y4md(:) - real, allocatable :: vert_qbo(:) - -! -! limiters -! - real, parameter :: latqbo =20., widqbo=15., taurel = 21600. - integer, parameter :: kz2 = 127-7, kz1= 127-49, kz5=5 ! 64km - 18km -! - -!====================================================================== - real, parameter :: F_coriol=1 ! Coriolis effects - real, parameter :: F_nonhyd=1 ! Nonhydrostatic waves - real, parameter :: F_kds =0 ! Eddy mixing due to GW-unstable below - real, parameter :: iPr_ktgw =1./3., iPr_spgw=iPr_ktgw - real, parameter :: iPr_turb =1./3., iPr_mol =1.95 - real, parameter :: rhp1=1./hps, rh2=0.5*rhp1, rhp4 = rh2*rh2 - real, parameter :: khp = 0.287*rhp1 ! R/Cp/Hp - real, parameter :: cd_ulim = 1.0 ! critical level precision or Lz ~ 0 ~dz of model - - contains -! -! ----------------------------------------------------------------------- -! -! init of cires_ugwp (_init) called from CCPP cap file -! -! ----------------------------------------------------------------------- - - - - subroutine cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat_gfs, con_pi, & - con_rerth, fn_nml2, lonr, latr, levs, ak, bk, pref, dtp, cdmvgwd, & - cgwf, pa_rf_in, tau_rf_in, errmsg, errflg) -! -! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 -! - use netcdf - use ugwp_oro_init_v1, only : init_oro_gws - use ugwp_conv_init_v1, only : init_conv_gws - use ugwp_fjet_init_v1, only : init_fjet_gws - use ugwp_okw_init_v1, only : init_okw_gws - use ugwp_wmsdis_init_v1, only : initsolv_wmsdis - - use ugwp_lsatdis_init_v1, only : initsolv_lsatdis - - - use ugwp_wmsdis_init_v1, only : ilaunch, nslope, lhmet, lzmax, lzmin, lzstar - use ugwp_wmsdis_init_v1, only : tau_min, tamp_mpa - implicit none - - integer, intent (in) :: me - integer, intent (in) :: master - integer, intent (in) :: nlunit - integer, intent (in) :: logunit - integer, intent (in) :: lonr - integer, intent (in) :: levs - integer, intent (in) :: latr - integer, intent (in) :: jdat_gfs(8) - real, intent (in) :: ak(levs+1), bk(levs+1), pref - real, intent (in) :: dtp - real, intent (in) :: cdmvgwd(2), cgwf(2) ! "scaling" controls for "old" GFS-GW dims(2) !!! - real, intent (in) :: pa_rf_in, tau_rf_in, con_pi, con_rerth - - character(len=64), intent (in) :: fn_nml2 - character(len=64), parameter :: fn_nml='input.nml' - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! character, intent (in) :: input_nml_file -! integer, parameter :: logunit = 6 - integer :: ios - logical :: exists - real :: dxsg - - integer :: ncid, iernc, vid, dimid, status - integer :: k - integer :: ddd_ugwp, curday_ugwp - real, dimension(6) :: avqbo = (/0.05, 0.1, 0.25, 0.5, 0.75, 0.95/) -! - if (me == master) print *, trim (fn_nml), ' GW-namelist file ' - inquire (file =trim (fn_nml) , exist = exists) -! - if (.not. exists) then - if (me == master) & - write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' - else - open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios) - endif - rewind (nlunit) - read (nlunit, nml = cires_ugwp_nml) - close (nlunit) -! - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - - strsolver= knob_ugwp_orosolv - pa_rf = pa_rf_in - tau_rf = tau_rf_in - - curday_ugwp = jdat_gfs(1)*10000 + jdat_gfs(2)*100 +jdat_gfs(3) - call calendar_ugwp(jdat_gfs(1), jdat_gfs(2), jdat_gfs(3), ddd_ugwp) - -! write version number and namelist to log file - if (me == master) then - write (logunit, *) " ================================================================== " - write (logunit, *) "cires_ugwp_namelist_extended_v1" - write (logunit, nml = cires_ugwp_nml) - write (logunit, *) " ================================================================== " - - write (6, *) " ================================================================== " - write (6, *) "cires_ugwp_namelist_extended_v1" - write (6, nml = cires_ugwp_nml) - write (6, *) " ================================================================== " - write (6, *) "calendar_ugwp ddd_ugwp=", ddd_ugwp - write (6, *) "calendar_ugwp curday_ugwp=", curday_ugwp - write (6, *) " ================================================================== " - write (6, *) ddd_ugwp, ' jdat_gfs ddd of year ' - endif -! -! effective kxw - resolution-aware -! - dxsg = pi2*arad/float(lonr) * knob_ugwp_ndx4lh - kxw = pi2/knob_ugwp_lhmet -! -! kxw = pi2/dxsg -! -! init global background dissipation for ugwp -> 4d-variable for fv3wam linked with pbl-vert_diff -! - -! allocate(fcor(latr), fcor2(latr) ) -! - allocate( kvg(levs+1), ktg(levs+1) ) - allocate( krad(levs+1), kion(levs+1) ) - allocate( zkm(levs), pmb(levs) ) - allocate( rfdis(levs), rfdist(levs) ) - - allocate (vert_qbo(levs)) - -! -! ak -pa bk-dimensionless from surf => tol_lid_pressure =0 -! - - do k=1, levs - pmb(k) = 1.e0*(ak(k) + pref*bk(k)) ! Pa -unit Pref = 1.e5, pmb = Pa - zkm(k) = -hpskm*alog(pmb(k)/pref) - enddo - vert_qbo(1:levs) = 0. - - do k=kz1, kz2 - vert_qbo(k)=1. - if (k.le.(kz1+kz5)) vert_qbo(k) = avqbo(k+1-kz1) - if (k.ge.(kz2-kz5)) vert_qbo(k) = avqbo(kz2+1-k) - if (me == master) print *, 'vertqbo', vert_qbo(k), zkm(k) - enddo - -! -! find ilaunch -! - - do k=levs, 1, -1 - if (pmb(k) .gt. knob_ugwp_palaunch ) exit - enddo - - launch_level = max(k-1, 5) ! above 5-layers from the surface - -! -! Part-1 :init_global_gwdis_v1 -! - call init_global_gwdis_v1(levs, zkm, pmb, kvg, ktg, krad, kion, con_pi, & - pa_rf, tau_rf, me, master) - call rf_damp_init_v1 (levs, pa_rf, tau_rf, dtp, pmb, rfdis, rfdist, levs_rf) -! -! Part-2 :init_SOURCES_gws -! - -! -! call init-solver for "stationary" multi-wave spectra and sub-grid oro -! - call init_oro_gws( knob_ugwp_wvspec(1), knob_ugwp_azdir(1), & - knob_ugwp_stoch(1), knob_ugwp_effac(1), lonr, kxw, cdmvgwd ) -! -! call init-sources for "non-sationary" multi-wave spectra -! - do_physb_gwsrcs=.true. - - IF (do_physb_gwsrcs) THEN - - if (me == master) print *, ' do_physb_gwsrcs ', do_physb_gwsrcs, ' in cires_ugwp_init_v1 ' - if (knob_ugwp_wvspec(4) > 0) then -! okw - call init_okw_gws(knob_ugwp_wvspec(4), knob_ugwp_azdir(4), & - knob_ugwp_stoch(4), knob_ugwp_effac(4), & - con_pi, lonr, kxw ) - if (me == master) print *, ' init_okw_gws ' - endif - - if (knob_ugwp_wvspec(3) > 0) then -! fronts - call init_fjet_gws(knob_ugwp_wvspec(3), knob_ugwp_azdir(3), & - knob_ugwp_stoch(3), knob_ugwp_effac(3), & - con_pi, lonr, kxw ) - if (me == master) print *, ' init_fjet_gws ' - endif - - if (knob_ugwp_wvspec(2) > 0) then -! conv - call init_conv_gws(knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & - knob_ugwp_stoch(2), knob_ugwp_effac(2), & - con_pi, con_rerth, lonr, kxw, cgwf ) - if (me == master) & - print *, ' init_convective GWs cgwf', knob_ugwp_wvspec(2), knob_ugwp_azdir(2) - - endif - - ENDIF !IF (do_physb_gwsrcs) -! -! -! Tabulated sources -! -! goto 121 - - iernc=NF90_OPEN(trim(ugwp_taufile), nf90_nowrite, ncid) - - if(iernc.ne.0) then - write(errmsg,'(*(a))') "Cannot open file_limb_tab data-file ", & - trim(ugwp_taufile) - errflg = 1 - return - else - - - status = nf90_inq_dimid(ncid, "lat", DimID) -! if (status /= nf90_noerr) call handle_err(status) -! - status = nf90_inquire_dimension(ncid, DimID, len =ntau_d1y ) - - status = nf90_inq_dimid(ncid, "days", DimID) - status = nf90_inquire_dimension(ncid, DimID, len =ntau_d2t ) - if (me == master) print *, ntau_d1y, ntau_d2t, ' dimd-tlimb ' - allocate (ugwp_taulat(ntau_d1y ), days_limb(ntau_d2t)) - allocate ( tau_limb (ntau_d1y, ntau_d2t )) - - iernc=nf90_inq_varid( ncid, 'DAYS', vid ) - iernc= nf90_get_var( ncid, vid, days_limb) - iernc=nf90_inq_varid( ncid, 'LATS', vid ) - iernc= nf90_get_var( ncid, vid, ugwp_taulat) - iernc=nf90_inq_varid( ncid, 'ABSMF', vid ) - iernc= nf90_get_var( ncid, vid, tau_limb) - - iernc=nf90_close(ncid) - - endif -! - iernc=NF90_OPEN(trim(ugwp_qbofile), nf90_nowrite, ncid) - - if(iernc.ne.0) then - write(errmsg,'(*(a))') "Cannot open qbofile data-file ", & - trim(ugwp_qbofile) - errflg = 1 - return - else - - status = nf90_inq_dimid(ncid, "lat", DimID) - status = nf90_inquire_dimension(ncid, DimID, len =nqbo_d1y ) - status = nf90_inq_dimid(ncid, "lev", DimID) - status = nf90_inquire_dimension(ncid, DimID, len =nqbo_d2z) - status = nf90_inq_dimid(ncid, "days", DimID) - status = nf90_inquire_dimension(ncid, DimID, len =nqbo_d3t ) - if (me == master) print *, nqbo_d1y, nqbo_d2z, nqbo_d3t, ' dims tauqbo ' - allocate (ugwp_qbolat(nqbo_d1y ), days_merra(nqbo_d3t) ) - allocate (zkm127(nqbo_d2z), pmb127(nqbo_d2z)) - allocate ( uzmf_merra (nqbo_d1y, nqbo_d2z, nqbo_d3t )) - allocate ( uqboe (nqbo_d2z, nqbo_d3t )) - allocate (days_y4ddd(nqbo_d3t), days_y4md(nqbo_d3t) ) - allocate (tau_qbo(nqbo_d3t), stau_qbo(nqbo_d3t) ) - - iernc=nf90_inq_varid( ncid, 'DAYS', vid ) - iernc= nf90_get_var( ncid, vid, days_merra) - - iernc=nf90_inq_varid( ncid, 'Y4MD', vid ) - iernc= nf90_get_var( ncid, vid, days_y4md) - - iernc=nf90_inq_varid( ncid, 'Y4DDD', vid ) - iernc= nf90_get_var( ncid, vid, days_y4ddd) - - iernc=nf90_inq_varid( ncid, 'LATS', vid ) - iernc= nf90_get_var( ncid, vid, ugwp_qbolat) - - iernc=nf90_inq_varid( ncid, 'LEVS', vid ) - iernc= nf90_get_var( ncid, vid, zkm127) - - - iernc=nf90_inq_varid( ncid, 'UQBO', vid ) - iernc= nf90_get_var( ncid, vid, uzmf_merra) - - iernc=nf90_inq_varid( ncid, 'TAUQBO', vid ) - iernc= nf90_get_var( ncid, vid, tau_qbo) - - iernc=nf90_inq_varid( ncid, 'STAUQBO', vid ) - iernc= nf90_get_var( ncid, vid, stau_qbo) - iernc=nf90_inq_varid( ncid, 'UQBOE', vid ) - iernc= nf90_get_var( ncid, vid, uqboe) - iernc=nf90_close(ncid) - endif - - if (me == master) then - print * - print *, ' ugwp_tabulated files input ' - print *, ' ugwp_taulat ', ugwp_taulat - print *, ' days ', days_limb - print *, ' TAU-limb ', maxval(tau_limb)*1.e3, minval(tau_limb)*1.e3 - print *, ' TAU-qbo ', maxval(stau_qbo)*1.e3, minval(stau_qbo)*1.e3 - print *, ' YMD-qbo ', maxval(days_y4md), minval(days_y4md) - print *, ' YDDD-qbo ', maxval(days_y4ddd), minval(days_y4ddd) - print *, ' uzmf_merra ',maxval(uzmf_merra), minval(uzmf_merra) - print *, ' uEq_merra ',maxval(uqboe), minval(uqboe) - print * - endif - -! -121 continue -! endif ! tabulated sources SABER/HIRDLS/QBO - -!====================== -! Part-3 :init_SOLVERS -! ===================== -! -! call init-solvers for "broad" non-stationary multi-wave spectra -! - if (knob_ugwp_solver==1) then -! - call initsolv_lsatdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & - knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw ) - endif - if (knob_ugwp_solver==2) then -! -! re-assign from namelists -! - nslope = knob_ugwp_nslope ! the GW sprctral slope at small-m - lzstar = knob_ugwp_lzstar - lzmax = knob_ugwp_lzmax - lzmin = knob_ugwp_lzmin - lhmet = knob_ugwp_lhmet - tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 - tau_min =knob_ugwp_taumin ! min of GW MF 0.25 mPa - ilaunch = launch_level - kxw = pi2/lhmet - call initsolv_wmsdis(me, master, knob_ugwp_wvspec(2), knob_ugwp_azdir(2), & - knob_ugwp_stoch(2), knob_ugwp_effac(2), do_physb_gwsrcs, kxw) - endif -! -! other solvers not yet tested for fv3gfs -! -!< if (knob_ugwp_solver==3) call init_dspdis -!< if (knob_ugwp_solver==4) call init_adodis -! - -!====================== - module_is_initialized = .true. - if (me == master) print *, ' CIRES-ugwp-V1 is initialized ', module_is_initialized - - end subroutine cires_ugwp_init_v1 - - -!============================================= - - - subroutine cires_ugwp_advance -!----------------------------------------------------------------------- -! -! options for the day-to-day variable sources/spectra + diagnostics -! for stochastic "triggers" -! diagnose GW-source functions * FGF + OKWP + SGO/CONV from IAU-fields -! or use for stochastic GWP-sources "memory" -!----------------------------------------------------------------------- - implicit none -! -! update sources -! a) physics-based triggers for multi-wave -! b) stochastic-based spectra and amplitudes -! c) use "memory" on GW-spectra from previous time-step -! d) update "background" GW dissipation as needed -! - end subroutine cires_ugwp_advance - -! -! ----------------------------------------------------------------------- -! finalize of cires_ugwp (_finalize) -! ----------------------------------------------------------------------- - - - subroutine cires_ugwp_finalize -! -! deallocate sources/spectra & some diagnostics need to find where "deaalocate them" -! before "end" of the FV3GFS -! - implicit none -! -! deallocate arrays employed in: -! cires_ugwp_advance / cires_ugwp_driver / cires_ugwp_init -! - deallocate( kvg, ktg ) - deallocate( krad, kion ) - deallocate( zkm, pmb ) - deallocate( rfdis, rfdist) - deallocate(ugwp_taulat, ugwp_qbolat) - deallocate(tau_limb, uzmf_merra) - deallocate(days_limb, days_merra, pmb127) - - end subroutine cires_ugwp_finalize - -! -! -! -! - subroutine calendar_ugwp(yr, mm, dd, ddd_ugwp) -! -! computes day of year to get tau_limb forcing written with 1-day precision -! - implicit none - integer, intent(in) :: yr, mm, dd - integer :: ddd_ugwp - - integer :: iw3jdn - integer :: jd1, jddd - jd1 = iw3jdn(yr,1,1) - jddd = iw3jdn(yr,mm,dd) - ddd_ugwp = jddd-jd1+1 - - end subroutine calendar_ugwp - - - subroutine cires_indx_ugwp (npts, me, master, dlat,j1_tau,j2_tau, w1_j1tau, w2_j2tau, & - j1_qbo,j2_qbo, w1_j1qbo, w2_j2qbo, dexp_latqbo ) - - implicit none -! -! ntau_d1y, ntau_d2t, nqbo_d1y, nqbo_d2z, nqbo_d3t -! ugwp_taulat(:), ugwp_qbolat(:), ugwp_merlat(:) -! - integer :: npts, me, master - integer, dimension(npts) :: j1_tau,j2_tau, j1_qbo, j2_qbo - real , dimension(npts) :: dlat, w1_j1tau, w2_j2tau, w1_j1qbo, w2_j2qbo - real , dimension(npts) :: dexp_latqbo - real :: widqbo2, xabs -! - integer i,j, j1, j2 -! -! weights for tau_limb w1_j1tau, w2_j2tau -! - do j=1,npts - j2_qbo(j) = nqbo_d1y - do i=1, nqbo_d1y - if (dlat(j) < ugwp_qbolat(i)) then - j2_qbo(j) = i - exit - endif - enddo - - - j2_qbo(j) = min(j2_qbo(j),nqbo_d1y) - j1_qbo(j) = max(j2_qbo(j)-1,1) - - if (j1_qbo(j) /= j2_qbo(j) ) then - w2_j2qbo(j) = (dlat(j) - ugwp_qbolat(j1_qbo(j))) & - / (ugwp_qbolat(j2_qbo(j))-ugwp_qbolat(j1_qbo(j))) - - else - w2_j2qbo(j) = 1.0 - endif - w1_j1qbo(j) = 1.0 - w2_j2qbo(j) - -! - enddo -! -! weights for tau_limb w1_j1tau, w2_j2tau -! - do j=1,npts - j2_tau(j) = ntau_d1y - do i=1,ntau_d1y - if (dlat(j) < ugwp_taulat(i)) then - j2_tau(j) = i - exit - endif - enddo - - - j2_tau(j) = min(j2_tau(j),ntau_d1y) - j1_tau(j) = max(j2_tau(j)-1,1) - - if (j1_tau(j) /= j2_tau(j) ) then - w2_j2tau(j) = (dlat(j) - ugwp_taulat(j1_tau(j))) & - / (ugwp_taulat(j2_tau(j))-ugwp_taulat(j1_tau(j))) - - else - w2_j2tau(j) = 1.0 - endif - w1_j1tau(j) = 1.0 - w2_j2tau(j) - - enddo - widqbo2 =1./widqbo/widqbo - do j=1,npts - dexp_latqbo(j) =0. - xabs =abs(dlat(j)) - if (xabs .le. latqbo) then - dexp_latqbo(j) = exp(-xabs*xabs*widqbo2) - if (xabs .le. 4.0 ) dexp_latqbo(j) =1. -! print *, ' indx_ugwp dexp=', dexp_latqbo(j), nint(dlat(j)) - endif - enddo - - if (me == master ) then -222 format( 2x, 'vay-wqbo', I4, 5(2x, F10.3)) -223 format( 2x, 'vay-limb', I4, 5(2x, F10.3)) - print *, 'vay_indx_ugwp ', size(dlat), ' npts ', npts - do j=1,npts - j1 = j1_tau(j) - j2 = j2_tau(j) - write(6,223) j, ugwp_taulat(j1), dlat(j), ugwp_taulat(j2), w2_j2tau(j), w1_j1tau(j) - enddo - print * - do j=1,npts - j1 = j1_qbo(j) - j2 = j2_qbo(j) - write(6,222) j, ugwp_qbolat(j1), dlat(j), ugwp_qbolat(j2), w2_j2qbo(j), w1_j1qbo(j) - enddo - endif - end subroutine cires_indx_ugwp - -! - end module cires_ugwp_module_v1 - diff --git a/physics/cires_ugwp_ngw_utils.F90 b/physics/cires_ugwp_ngw_utils.F90 deleted file mode 100644 index 4b2a19884..000000000 --- a/physics/cires_ugwp_ngw_utils.F90 +++ /dev/null @@ -1,73 +0,0 @@ -module cires_ugwp_ngw_utils - - -contains - - - subroutine tau_limb_advance(me, master, im, levs, ddd, curdate, & - j1_tau, j2_tau, ddy_j1tau, ddy_j2tau, tau_sat, kdt ) - - - - - use machine, only : kind_phys - - use cires_ugwp_module_v1, only : ntau_d1y, ntau_d2t - use cires_ugwp_module_v1, only : ugwp_taulat, days_limb, tau_limb - -! use cires_ugwp_module, only : ugwp_qbolat, days_merra, pmb127, days_y4md, days_y4ddd -! use cires_ugwp_module, only : tau_qbo, stau_qbo, uqboe, u2 => uzmf_merra - - implicit none - - integer, intent(in) :: me, master, im, levs, ddd, curdate, kdt - integer, intent(in), dimension(im) :: j1_tau, j2_tau - - real , intent(in), dimension(im) :: ddy_j1tau, ddy_j2tau - - real, intent(out) :: tau_sat(im) - - integer :: i, j1, j2, k, it1, it2, iday - real :: tem, tx1, tx2, w1, w2, day2, day1, ddx - integer :: yr1, yr2 -! - integer :: iqbo1=1 -! - - - - it1 = 2 - do iday=1, ntau_d2t - if (float(ddd) .lt. days_limb(iday) ) then - it2 = iday - exit - endif - enddo - it2 = min(it2,ntau_d2t) - it1 = max(it2-1,1) - if (it2 > ntau_d2t ) then - print *, ' it1, it2, ntau_d2t ', it1, it2, ntau_d2t - stop - endif - w2 = (float(ddd)-days_limb(it1))/(days_limb(it2)-days_limb(it1)) - w1 = 1.0-w2 - do i=1, im - j1 = j1_tau(i) - j2 = j2_tau(i) - tx1 = tau_limb(j1, it1)*ddy_j1tau(i)+tau_limb(j2, it1)*ddy_j2tau(i) - tx2 = tau_limb(j1, it2)*ddy_j1tau(i)+tau_limb(j2, it2)*ddy_j2tau(i) - tau_sat(i) = tx1*w1 + w2*tx2 - enddo - - if (me == master ) then - print*, maxval(tau_limb), minval(tau_limb), ' tau_limb ' - print*, ntau_d2t - print*, days_limb(1) , days_limb(ntau_d2t) , ddd, ' days-taulimb ' - print*, 'curdate ', curdate - print*, maxval(tau_sat), minval(tau_sat), ' tau_sat_fv3 ' - endif - return - - end subroutine tau_limb_advance - -end module cires_ugwp_ngw_utils diff --git a/physics/cires_ugwp_orolm97_v1.F90 b/physics/cires_ugwp_orolm97_v1.F90 deleted file mode 100644 index fd692a825..000000000 --- a/physics/cires_ugwp_orolm97_v1.F90 +++ /dev/null @@ -1,1008 +0,0 @@ -module cires_ugwp_orolm97_v1 - - -contains - - - - subroutine gwdps_oro_v1(im, km, imx, do_tofd, & - pdvdt, pdudt, pdtdt, pkdis, u1,v1,t1,q1,kpbl, & - prsi,del,prsl,prslk, zmeti, zmet, dtp, kdt, hprime, & - oc, oa4, clx4, theta, sigmad, gammad, elvmaxd, & - grav, con_omega, rd, cpd, rv, pi, arad, fv, sgh30, & - dusfc, dvsfc, xlatd, sinlat, coslat, sparea, & - cdmbgwd, me, master, rdxzb, & - zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & - dudt_mtb, dudt_ogw, dudt_tms) -!---------------------------------------- -! ugwp_v1: gwdps_oro_v1 following recent updates of Lott & Miller 1997 -! eventually will be replaced with more "advanced"LLWB -! and multi-wave solver that produce competitive FV3GFS-skills -! -! computation of kref for ogw + coorde diagnostics -! all constants/parameters inside cires_ugwp_initialize.f90 -!---------------------------------------- - - use machine , only : kind_phys - use ugwp_common_v1, only : dw2min, velmin - - use ugwp_oro_init_v1, only : rimin, ric, efmin, efmax , & - hpmax, hpmin, sigfaci => sigfac , & - dpmin, minwnd, hminmt, hncrit , & - rlolev, gmax, veleps, factop , & - frc, ce, ceofrc, frmax, cg, & - fdir, mdir, nwdir, & - cdmb, cleff, fcrit_gfs, fcrit_mtb, & - n_tofd, ze_tofd, ztop_tofd - - use cires_ugwp_module_v1, only : kxw, max_kdis, max_axyz - - use cires_orowam2017, only : oro_wam_2017 - - use cires_vert_orodis_v1, only : ugwp_tofd1d - - -! use sso_coorde, only : pgwd, pgwd4 -!---------------------------------------- - implicit none - real(kind=kind_phys), parameter :: pgwd=1, pgwd4= pgwd - real(kind=kind_phys), parameter :: sigfac = 3, sigfacs = 0.5 - character(len=8) :: strsolver='pss-1986' ! current operational solver or 'wam-2017' - real(kind=kind_phys) :: gammin = 0.00999999 - real(kind=kind_phys), parameter :: nhilmax = 25. - real(kind=kind_phys), parameter :: sso_min = 3000. - logical, parameter :: do_adjoro = .false. -!---------------------------------------- - - integer, intent(in) :: im, km, imx, kdt - integer, intent(in) :: me, master - logical, intent(in) :: do_tofd - - - - integer, intent(in) :: kpbl(im) ! index for the pbl top layer! - real(kind=kind_phys), intent(in) :: dtp ! time step - real(kind=kind_phys), intent(in) :: cdmbgwd(2) - - real(kind=kind_phys), intent(in) :: hprime(im), oc(im), oa4(im,4), & - clx4(im,4), theta(im), sigmad(im), & - gammad(im), elvmaxd(im) - - real(kind=kind_phys), intent(in) :: grav, con_omega, rd, cpd, rv, & - pi, arad, fv - real(kind=kind_phys), intent(in) :: sgh30(im) - real(kind=kind_phys), intent(in), dimension(im,km) :: & - u1, v1, t1, q1,del, prsl, prslk, zmet - - real(kind=kind_phys), intent(in),dimension(im,km+1):: prsi, zmeti - real(kind=kind_phys), intent(in) :: xlatd(im),sinlat(im), coslat(im) - real(kind=kind_phys), intent(in) :: sparea(im) - -! -!output -phys-tend - real(kind=kind_phys),dimension(im,km),intent(out) :: & - pdvdt, pdudt, pkdis, pdtdt -! output - diag-coorde - real(kind=kind_phys),dimension(im,km),intent(out) :: & - dudt_mtb, dudt_ogw, dudt_tms -! - real(kind=kind_phys),dimension(im) :: rdxzb, zmtb, zogw , & - tau_ogw, tau_mtb, tau_tofd, dusfc, dvsfc - -! -!--------------------------------------------------------------------- -! # of permissible sub-grid orography hills for "any" resolution < 25 -! correction for "elliptical" hills based on shilmin-area =sgrid/25 -! 4.*gamma*b_ell*b_ell >= shilmin -! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min -! gamma_min = 1/4*shilmin/sso_min/sso_min -!23.01.2019: cdmb = 4.*192/768_c192=1 x 0.5 -! 192: cdmbgwd = 0.5, 2.5 -! cleff = 2.5*0.5e-5 * sqrt(192./768.) => lh_eff = 1004. km -! 6*dx = 240 km 8*dx = 320. ~ 3-5 more effective OGW-lin -!--------------------------------------------------------------------- -! -! locals SSO -! - real(kind=kind_phys) :: vsigma(im), vgamma(im) - - real(kind=kind_phys) :: ztoph,zlowh,ph_blk, dz_blk - real(kind=kind_phys) :: shilmin, sgrmax, sgrmin - real(kind=kind_phys) :: belpmin, dsmin, dsmax -! real(kind=kind_phys) :: arhills(im) ! not used why do we need? - real(kind=kind_phys) :: xlingfs - -! -! locals mean flow ...etc -! - real(kind=kind_phys), dimension(im,km) :: ri_n, bnv2, ro - real(kind=kind_phys), dimension(im,km) :: vtk, vtj, velco -!mtb - real(kind=kind_phys), dimension(im) :: oa, clx , sigma, gamma, & - elvmax, wk - real(kind=kind_phys), dimension(im) :: pe, ek, up - - real(kind=kind_phys), dimension(im,km) :: db, ang, uds - - real(kind=kind_phys) :: zlen, dbtmp, r, phiang, dbim, zr - real(kind=kind_phys) :: eng0, eng1, cosang2, sinang2 - real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem -! -! tofd -! some constants now in "use ugwp_oro_init" + "use ugwp_common" -! -!================== - real(kind=kind_phys) :: unew, vnew, zpbl, sigflt, zsurf - real(kind=kind_phys), dimension(km) :: utofd1, vtofd1 - real(kind=kind_phys), dimension(km) :: epstofd1, krf_tofd1 - real(kind=kind_phys), dimension(km) :: up1, vp1, zpm - - real(kind=kind_phys),dimension(im, km) :: axtms, aytms -! -! ogw -! - logical icrilv(im) -! - real(kind=kind_phys), dimension(im) :: xn, yn, ubar, vbar, ulow, & - roll, bnv2bar, scor, dtfac, xlinv, delks, delks1 -! - real(kind=kind_phys) :: taup(im,km+1), taud(im,km) - real(kind=kind_phys) :: taub(im), taulin(im), heff, hsat, hdis - - integer, dimension(im) :: kref, idxzb, ipt, kreflm, iwklm, iwk, izlow - -! -!check what we need -! - real(kind=kind_phys) :: bnv, fr, ri_gw, brvf - real(kind=kind_phys) :: tem, tem1, tem2, temc, temv - real(kind=kind_phys) :: ti, rdz, dw2, shr2, bvf2 - real(kind=kind_phys) :: rdelks, efact, coefm, gfobnv - real(kind=kind_phys) :: scork, rscor, hd, fro, sira - real(kind=kind_phys) :: dtaux, dtauy, zmetp, zmetk - - real(kind=kind_phys) :: grav2, rcpdt, windik, wdir - real(kind=kind_phys) :: sigmin, dxres,sigres,hdxres, cdmb4, mtbridge - - real(kind=kind_phys) :: kxridge, inv_b2eff, zw1, zw2 - real(kind=kind_phys) :: belps, aelps, nhills, selps - - real(kind=kind_phys) :: rgrav, rcpd, rcpd2, rad_to_deg, deg_to_rad - real(kind=kind_phys) :: pi2, rdi, gor, grcp, gocp, gr2, bnv2min - -! -! various integers -! - integer :: kmm1, kmm2, lcap, lcapp1 - integer :: npt, kbps, kbpsp1,kbpsm1 - integer :: kmps, idir, nwd, klcap, kp1, kmpbl, kmll - integer :: k_mtb, k_zlow, ktrial, klevm1 - integer :: i, j, k -! -! initialize gamma and sigma - gamma(:) = gammad(:) - sigma(:) = sigmad(:) -! - rcpdt = 1.0 / (cpd*dtp) - grav2 = grav + grav -! - rgrav = 1.0/grav - rcpd = 1.0/cpd - rcpd2 = 0.5/cpd - rad_to_deg=180.0/pi - deg_to_rad=pi/180.0 - pi2 = 2.*pi - rdi = 1.0/rd - gor = grav/rd - grcp = grav*rcpd - gocp = grcp - gr2 = grav*gor - bnv2min = (pi2/1800.)*(pi2/1800.) -! -! mtb-blocking sigma_min and dxres => cires_initialize -! - sgrmax = maxval(sparea) ; sgrmin = minval(sparea) - dsmax = sqrt(sgrmax) ; dsmin = sqrt(sgrmin) - - dxres = pi2*arad/float(imx) - hdxres = 0.5*dxres -! shilmin = sgrmin/nhilmax ! not used - moorthi - -! gammin = min(sso_min/dsmax, 1.) ! moorthi - with this results are not reproducible - gammin = min(sso_min/dxres, 1.) ! moorthi - -! sigmin = 2.*hpmin/dsmax !dxres ! moorthi - this will not reproduce - sigmin = 2.*hpmin/dxres !dxres - -! if (kdt == 1) then -! print *, sgrmax, sgrmin , ' min-max sparea ' -! print *, 'sigmin-hpmin-dsmax', sigmin, hpmin, dsmax -! print *, 'dxres/dsmax ', dxres, dsmax -! print *, ' shilmin gammin ', shilmin, gammin -! endif - - kxridge = float(imx)/arad * cdmbgwd(2) - - if (me == master .and. kdt == 1) then - print *, ' gwdps_v0 kxridge ', kxridge - print *, ' gwdps_v0 scale2 ', cdmbgwd(2) - print *, ' gwdps_v0 imx ', imx - print *, ' gwdps_v0 gam_min ', gammin - print *, ' gwdps_v0 sso_min ', sso_min - endif - - do i=1,im - idxzb(i) = 0 - zmtb(i) = 0.0 - zogw(i) = 0.0 - rdxzb(i) = 0.0 - tau_ogw(i) = 0.0 - tau_mtb(i) = 0.0 - dusfc(i) = 0.0 - dvsfc(i) = 0.0 - tau_tofd(i) = 0.0 -! - ipt(i) = 0 -! - enddo - - do k=1,km - do i=1,im - pdvdt(i,k) = 0.0 - pdudt(i,k) = 0.0 - pdtdt(i,k) = 0.0 - pkdis(i,k) = 0.0 - dudt_mtb(i,k) = 0.0 - dudt_ogw(i,k) = 0.0 - dudt_tms(i,k) = 0.0 - enddo - enddo - -! ---- for lm and gwd calculation points -!cires_ugwp_initialize.F90: real, parameter :: hpmax=2400.0, hpmin=25.0 -!cires_ugwp_initialize.F90: real, parameter :: hminmt=50. ! min mtn height (*j*) -!---- for lm and gwd calculation points - - - npt = 0 - - do i = 1,im - if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then - npt = npt + 1 - ipt(npt) = i - endif - enddo - - if (npt == 0) then -! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt -! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin - return ! no gwd/mb calculation done - endif -!======================================================== - -! - if (do_adjoro ) then - - do i = 1,im -! arhills(i) = 1.0 -! - sigres = max(sigmin, sigma(i)) -! if (sigma(i) < sigmin) sigma(i)= sigmin - dxres = sqrt(sparea(i)) - if (2.*hprime(i)/sigres > dxres) sigres=2.*hprime(i)/dxres - aelps = min(2.*hprime(i)/sigres, 0.5*dxres) - if (gamma(i) > 0.0 ) belps = min(aelps/gamma(i),.5*dxres) -! -! small-scale "turbulent" oro-scales < sso_min -! - if( aelps < sso_min ) then - -! a, b > sso_min upscale ellipse a/b > 0.1 a>sso_min & h/b=>new_sigm -! - aelps = sso_min - if (belps < sso_min ) then - gamma(i) = 1.0 - belps = aelps*gamma(i) - else - gamma(i) = min(aelps/belps, 1.0) - endif - - sigma(i) = 2.*hprime(i)/aelps - gamma(i) = min(aelps/belps, 1.0) - - endif - - selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill - nhills = min(nhilmax, sparea(i)/selps) -! arhills(i) = max(nhills, 1.0) - -!333 format( ' nhil: ', i6, 4(2x, f9.3), 2(2x, e9.3)) -! if (kdt==1 ) -! & write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, -! & belps*1.e-3, sigma(i),gamma(i) - - - enddo - endif !(do_adjoro ) - - - - do i=1,npt - iwklm(i) = 2 - idxzb(i) = 0 - kreflm(i) = 0 - enddo - - do k=1,km - do i=1,im - db(i,k) = 0.0 - ang(i,k) = 0.0 - uds(i,k) = 0.0 - enddo - enddo - - kmm1 = km - 1 ; kmm2 = km - 2 ; kmll = kmm1 - lcap = km ; lcapp1 = lcap + 1 - - cdmb4 = 0.25*cdmb - - do i = 1, npt - j = ipt(i) - elvmax(j) = min (elvmaxd(j)*0. + sigfac * hprime(j), hncrit) - izlow(i) = 1 ! surface-level - enddo -! - do k = 1, kmm1 - do i = 1, npt - j = ipt(i) - ztoph = sigfac * hprime(j) - zlowh = sigfacs* hprime(j) - zmetp = zmet(j,k+1) - zmetk = zmet(j,k) -! if (( elvmax(j) <= zmetp) .and. (elvmax(j).ge.zmetk) ) -! & iwklm(i) = max(iwklm(i), k+1 ) - if (( ztoph <= zmetp) .and. (ztoph >= zmetk) ) iwklm(i) = max(iwklm(i), k+1 ) - if (zlowh <= zmetp .and. zlowh >= zmetk) izlow(i) = max(izlow(i),k) - - enddo - enddo -! - do k = 1,km - do i =1,npt - j = ipt(i) - vtj(i,k) = t1(j,k) * (1.+fv*q1(j,k)) - vtk(i,k) = vtj(i,k) / prslk(j,k) - ro(i,k) = rdi * prsl(j,k) / vtj(i,k) ! density mid-levels - taup(i,k) = 0.0 - enddo - enddo -! -! check ri_n or ri_mf computation -! - do k = 1,kmm1 - do i =1,npt - j = ipt(i) - rdz = 1. / (zmet(j,k+1) - zmet(j,k)) - tem1 = u1(j,k) - u1(j,k+1) - tem2 = v1(j,k) - v1(j,k+1) - dw2 = tem1*tem1 + tem2*tem2 - shr2 = max(dw2,dw2min) * rdz * rdz -! ti = 2.0 / (t1(j,k)+t1(j,k+1)) -! bvf2 = grav*(gocp+rdz*(vtj(i,k+1)-vtj(i,k)))* ti -! ri_n(i,k) = max(bvf2/shr2,rimin) ! richardson number -! - bvf2 = grav2 * rdz * (vtk(i,k+1)-vtk(i,k))/ (vtk(i,k+1)+vtk(i,k)) - - bnv2(i,k+1) = max( bvf2, bnv2min ) - ri_n(i,k+1) = bnv2(i,k)/shr2 ! richardson number consistent with bnv2 -! -! add here computation for ktur and ogw-dissipation fro ve-gfs -! - enddo - enddo - k = 1 - do i = 1, npt - bnv2(i,k) = bnv2(i,k+1) - enddo -! -! level iwklm => zmet(j,k) < sigfac * hprime(j) < zmet(j,k+1) -! - do i = 1, npt - j = ipt(i) - k_zlow = izlow(i) - if (k_zlow == iwklm(i)) k_zlow = 1 - delks(i) = 1.0 / (prsi(j,k_zlow) - prsi(j,iwklm(i))) -! delks1(i) = 1.0 /(prsl(j,k_zlow) - prsl(j,iwklm(i))) - ubar (i) = 0.0 - vbar (i) = 0.0 - roll (i) = 0.0 - pe (i) = 0.0 - ek (i) = 0.0 - bnv2bar(i) = 0.0 - enddo -! - do i = 1, npt - k_zlow = izlow(i) - if (k_zlow == iwklm(i)) k_zlow = 1 - do k = k_zlow, iwklm(i)-1 ! kreflm(i)= iwklm(i)-1 - j = ipt(i) ! laye-aver rho, u, v - rdelks = del(j,k) * delks(i) - ubar(i) = ubar(i) + rdelks * u1(j,k) ! trial mean u below - vbar(i) = vbar(i) + rdelks * v1(j,k) ! trial mean v below - roll(i) = roll(i) + rdelks * ro(i,k) ! trial mean ro below -! - bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks - enddo - enddo -! - do i = 1, npt - j = ipt(i) -! -! integrate from ztoph = sigfac*hprime down to zblk if exists -! find ph_blk, dz_blk like in LM-97 and ifs -! - ph_blk =0. - do k = iwklm(i), 1, -1 - phiang = atan2(v1(j,k),u1(j,k))*rad_to_deg - ang(i,k) = ( theta(j) - phiang ) - if ( ang(i,k) > 90. ) ang(i,k) = ang(i,k) - 180. - if ( ang(i,k) < -90. ) ang(i,k) = ang(i,k) + 180. - ang(i,k) = ang(i,k) * deg_to_rad - uds(i,k) = max(sqrt(u1(j,k)*u1(j,k) + v1(j,k)*v1(j,k)), velmin) -! - if (idxzb(i) == 0 ) then - dz_blk = zmeti(j,k+1) - zmeti(j,k) - pe(i) = pe(i) + bnv2(i,k) *( elvmax(j) - zmet(j,k) ) * dz_blk - - up(i) = max(uds(i,k) * cos(ang(i,k)), velmin) - ek(i) = 0.5 * up(i) * up(i) - - ph_blk = ph_blk + dz_blk*sqrt(bnv2(i,k))/up(i) - -! --- dividing stream lime is found when pe =exceeds ek. oper-l gfs -! if ( pe(i) >= ek(i) ) then - if ( ph_blk >= fcrit_gfs ) then - idxzb(i) = k - zmtb (j) = zmet(j, k) - rdxzb(j) = real(k, kind=kind_phys) - endif - - endif - enddo -! -! alternative expression: zmtb = max(heff*(1. -fcrit_gfs/fr), 0) -! fcrit_gfs/fr -! - goto 788 - - bnv = sqrt( bnv2bar(i) ) - heff = 2.*min(hprime(j),hpmax) - zw2 = ubar(i)*ubar(i)+vbar(i)*vbar(i) - ulow(i) = sqrt(max(zw2,dw2min)) - fr = heff*bnv/ulow(i) - zw1 = max(heff*(1. -fcrit_gfs/fr), 0.0) - zw2 = zmet(j,2) - if (fr > fcrit_gfs .and. zw1 > zw2 ) then - do k=2, kmm1 - zmetp = zmet(j,k+1) - zmetk = zmet(j,k) - if (zw1 <= zmetp .and. zw1 >= zmetk) exit - enddo - idxzb(i) = k - zmtb (j) = zmet(j, k) - else - zmtb (j) = 0. - idxzb(i) = 0 - endif - -788 continue -! -! --- the drag for mtn blocked flow -! - if ( idxzb(i) > 0 ) then - -! (4.16)-ifs - gam2 = gamma(j)*gamma(j) - bgam = 1.0 - 0.18*gamma(j) - 0.04*gam2 - cgam = 0.48*gamma(j) + 0.30*gam2 - - do k = idxzb(i)-1, 1, -1 - zlen = sqrt( (zmtb(j)-zmet(j,k) )/(zmet(j,k ) + hprime(j)) ) - tem = cos(ang(i,k)) - cosang2 = tem * tem - sinang2 = 1.0 - cosang2 -! -! cos =1 sin =0 => 1/r= gam zr = 2.-gam -! cos =0 sin =1 => 1/r= 1/gam zr = 2.- 1/gam -! - rdem = cosang2 + gam2 * sinang2 - rnom = cosang2*gam2 + sinang2 -! -! metoffice dec 2010 -! correction of h. wells & a. zadra for the -! aspect ratio of the hill seen by mean flow -! (1/r , r-inverse below: 2-r) - - rdem = max(rdem, 1.e-6) - r = sqrt(rnom/rdem) - zr = max( 2. - r, 0. ) - - sigres = max(sigmin, sigma(j)) - if (hprime(j)/sigres > dxres) sigres = hprime(j)/dxres - mtbridge = zr * sigres*zlen / hprime(j) -! (4.15)-ifs -! dbtmp = cdmb4 * mtbridge * & -! & max(cos(ang(i,k)), gamma(j)*sin(ang(i,k))) -! (4.16)-ifs - dbtmp = cdmb4*mtbridge*(bgam* cosang2 +cgam* sinang2) - db(i,k)= dbtmp * uds(i,k) - enddo -! - endif - enddo -!............................. -!............................. -! end mtn blocking section -!............................. -!............................. -! -!--- orographic gravity wave drag section -! -! scale cleff between im=384*2 and 192*2 for t126/t170 and t62 -! inside "cires_ugwp_initialize.f90" now -! - kmpbl = km / 2 - iwk(1:npt) = 2 -! -! meto/UK-scheme: -! k_mtb = max(k_zmtb, k_n*hprime/2] to reduce diurnal variations taub_ogw -! - do k=3,kmpbl - do i=1,npt - j = ipt(i) - tem = (prsi(j,1) - prsi(j,k)) - if (tem < dpmin) iwk(i) = k ! dpmin=50 mb - -!=============================================================== -! lev=111 t=311.749 hkm=0.430522 ps-p(iwk)=52.8958 -! below "hprime" - source of ogws and below zblk !!! -! 27 2 kpbl ~ 1-2 km < hprime -!=============================================================== - enddo - enddo -! -! iwk - adhoc gfs-parameter to select ogw-launch level between -! level ~0.4-0.5 km from surface or/and pbl-top -! in ugwp-v1: options to modify as htop ~ (2-3)*hprime > zmtb -! in ugwp-v0 we ensured that : zogw > zmtb -! - - kbps = 1 - kmps = km - k_mtb = 1 - do i=1,npt - j = ipt(i) - k_mtb = max(1, idxzb(i)) - - kref(i) = max(iwk(i), kpbl(j)+1 ) ! reference level pbl or smt-else ???? - kref(i) = max(kref(i), iwklm(i) ) ! iwklm => sigfac*hprime - - if (kref(i) <= k_mtb) kref(i) = k_mtb + 1 ! layer above zmtb - kbps = max(kbps, kref(i)) - kmps = min(kmps, kref(i)) -! - delks(i) = 1.0 / (prsi(j,k_mtb) - prsi(j,kref(i))) - ubar (i) = 0.0 - vbar (i) = 0.0 - roll (i) = 0.0 - bnv2bar(i)= 0.0 - enddo -! - kbpsp1 = kbps + 1 - kbpsm1 = kbps - 1 - k_mtb = 1 -! - do i = 1,npt - k_mtb = max(1, idxzb(i)) - do k = k_mtb,kbps !kbps = max(kref) ;kmps= min(kref) - if (k < kref(i)) then - j = ipt(i) - rdelks = del(j,k) * delks(i) - ubar(i) = ubar(i) + rdelks * u1(j,k) ! mean u below kref - vbar(i) = vbar(i) + rdelks * v1(j,k) ! mean v below kref - roll(i) = roll(i) + rdelks * ro(i,k) ! mean ro below kref - bnv2bar(i) = bnv2bar(i) + .5*(bnv2(i,k)+bnv2(i,k+1))* rdelks - endif - enddo - enddo -! -! orographic asymmetry parameter (oa), and (clx) - do i = 1,npt - j = ipt(i) - wdir = atan2(ubar(i),vbar(i)) + pi - idir = mod(nint(fdir*wdir),mdir) + 1 - nwd = nwdir(idir) - oa(i) = (1-2*int( (nwd-1)/4 )) * oa4(j,mod(nwd-1,4)+1) - clx(i) = clx4(j,mod(nwd-1,4)+1) - enddo -! - do i = 1,npt - dtfac(i) = 1.0 - icrilv(i) = .false. ! initialize critical level control vector - ulow(i) = max(sqrt(ubar(i)*ubar(i)+vbar(i)*vbar(i)),velmin) - xn(i) = ubar(i) / ulow(i) - yn(i) = vbar(i) / ulow(i) - enddo -! - do k = 1, kmm1 - do i = 1,npt - j = ipt(i) - velco(i,k) = 0.5 * ((u1(j,k)+u1(j,k+1))*xn(i)+ (v1(j,k)+v1(j,k+1))*yn(i)) - - enddo - enddo -! -!------------------ -! v0: incorporates latest modifications for kxridge and heff/hsat -! and taulin for fr <=fcrit_gfs -! and concept of "clipped" hill if zmtb > 0. to make -! the integrated "tau_sso = tau_ogw +tau_mtb" close to reanalysis data -! it is still used the "single-orowave"-approach along ulow-upwind -! -! in contrast to the 2-orthogonal wave (2otw) schemes of ifs/meto/e-canada -! 2otw scheme requires "aver angle" and wind projections on 2 axes of ellipse a-b -! with 2-stresses: taub_a & taub_b as of Phillips (1984) -!------------------ - taub(:) = 0. ; taulin(:)= 0. - do i = 1,npt - j = ipt(i) - bnv = sqrt( bnv2bar(i) ) - heff = min(hprime(j),hpmax) - - if( zmtb(j) > 0.) heff = max(sigfac*heff-zmtb(j), 0.)/sigfac - if (heff <= 0) cycle - - hsat = fcrit_gfs*ulow(i)/bnv - heff = min(heff, hsat) - - fr = min(bnv * heff /ulow(i), frmax) -! - efact = (oa(i) + 2.) ** (ceofrc*fr) - efact = min( max(efact,efmin), efmax ) -! - coefm = (1. + clx(i)) ** (oa(i)+1.) -! - xlinv(i) = coefm * cleff ! effective kxw for lin-wave - xlingfs = coefm * cleff -! - tem = fr * fr * oc(j) - gfobnv = gmax * tem / ((tem + cg)*bnv) -! -!new specification of xlinv(i) & taulin(i) - - sigres = max(sigmin, sigma(j)) - if (heff/sigres > hdxres) sigres = heff/hdxres - inv_b2eff = 0.5*sigres/heff - kxridge = 1.0 / sqrt(sparea(j)) - xlinv(i) = xlingfs !or max(kxridge, inv_b2eff) ! 6.28/lx ..0.5*sigma(j)/heff = 1./lridge - taulin(i) = 0.5*roll(i)*xlinv(i)*bnv*ulow(i)*heff*heff*pgwd4 - - if ( fr > fcrit_gfs ) then - taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & - * ulow(i) * gfobnv * efact ! nonlinear flux tau0...xlinv(i) -! - else -! taub(i) = taulin(i) ! linear flux for fr <= fcrit_gfs - taub(i) = xlinv(i) * roll(i) * ulow(i) * ulow(i) & - * ulow(i) * gfobnv * efact -! - endif -! -! - k = max(1, kref(i)-1) - tem = max(velco(i,k)*velco(i,k), dw2min) - scor(i) = bnv2(i,k) / tem ! scorer parameter below kref level -! -! diagnostics for zogw > zmtb -! - zogw(j) = zmeti(j, kref(i) ) - enddo -! -!----set up bottom values of stress -! - do k = 1, kbps - do i = 1,npt - if (k <= kref(i)) taup(i,k) = taub(i) - enddo - enddo - - if (strsolver == 'pss-1986') then - -!====================================================== -! v0-gfs orogw-solver of palmer et al 1986 -"pss-1986" -! in v1-orogw linsatdis of "wam-2017" -! with llwb-mechanism for -! rotational/non-hydrostat ogws important for -! highres-fv3gfs with dx < 10 km -!====================================================== - - do k = kmps, kmm1 ! vertical level loop from min(kref) - kp1 = k + 1 - do i = 1, npt -! - if (k >= kref(i)) then - icrilv(i) = icrilv(i) .or. ( ri_n(i,k) < ric).or. (velco(i,k) <= 0. ) - endif - enddo -! - do i = 1,npt - if (k >= kref(i)) then - if (.not.icrilv(i) .and. taup(i,k) > 0.0 ) then - temv = 1.0 / max(velco(i,k), velmin) -! - if (oa(i) > 0. .and. kp1 < kref(i)) then -! - scork = bnv2(i,k) * temv * temv - rscor = min(1.0, scork / scor(i)) - scor(i) = scork - else - rscor = 1. - endif -! - brvf = sqrt(bnv2(i,k)) ! brent-vaisala frequency interface -! tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k))*brvf*velco(i,k)*0.5 - - tem1 = xlinv(i)*(ro(i,kp1)+ro(i,k))*brvf*0.5 & - * max(velco(i,k), velmin) - hd = sqrt(taup(i,k) / tem1) - fro = brvf * hd * temv -! -! rim is the "wave"-richardson number by palmer,shutts, swinbank 1986 -! - - tem2 = sqrt(ri_n(i,k)) - tem = 1. + tem2 * fro - ri_gw = ri_n(i,k) * (1.0-fro) / (tem * tem) -! -! check stability to employ the 'dynamical saturation hypothesis' -! of palmer,shutts, swinbank 1986 -! - if (ri_gw <= ric .and.(oa(i) <= 0. .or. kp1 >= kref(i) )) then - temc = 2.0 + 1.0 / tem2 - hd = velco(i,k) * (2.*sqrt(temc)-temc) / brvf - taup(i,kp1) = tem1 * hd * hd - else - taup(i,kp1) = taup(i,k) * rscor - endif -! - taup(i,kp1) = min(taup(i,kp1), taup(i,k)) - endif - endif - enddo - enddo -! -! zero momentum deposition at the top model layer -! - taup(1:npt,km+1) = taup(1:npt,km) -! -! calculate wave acc-n: - (grav)*d(tau)/d(p) = taud -! - do k = 1,km - do i = 1,npt - taud(i,k) = grav*(taup(i,k+1) - taup(i,k))/del(ipt(i),k) - enddo - enddo - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -!------if the gravity wave drag would force a critical line in the -!------layers below sigma=rlolev during the next deltim timestep, -!------then only apply drag until that critical line is reached. -! empirical implementation of the llwb-mechanism: lower level wave breaking -! by limiting "ax = dtfac*ax" due to possible llwb around kref and 500 mb -! critical line [v - ax*dtp = 0.] is smt like "llwb" for stationary ogws -!2019: this option limits sensitivity of taux/tauy to increase/decrease of taub -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - do k = 1,kmm1 - do i = 1,npt - if (k >= kref(i) .and. prsi(ipt(i),k) >= rlolev) then - - if(taud(i,k) /= 0.) then - tem = dtp * taud(i,k) ! tem = du/dt-oro*dt => U/dU vs 1 - dtfac(i) = min(dtfac(i),abs(velco(i,k)/tem)) ! reduce Ax= Ax*(1, or U/dU <=1) -! dtfac(i) = 1.0 - endif - endif - enddo - enddo -! -!--------------------------- orogw-solver of gfs pss-1986 -! - else -! -!-----------Unified orogw-solver of wam2017 -! -! sigres = max(sigmin, sigma(j)) -! if (heff/sigres.gt.dxres) sigres=heff/dxres -! inv_b2eff = 0.5*sigres/heff -! xlinv(i) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./lridge - - dtfac(:) = 1.0 - - call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, & - dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsl, & - grav, con_omega, rd, & - del, sigma, hprime, gamma, theta, sinlat, xlatd, taup, taud, pkdis) - - endif ! oro_wam_2017 - linsatdis-solver of wam-2017 -! -!---- above orogw-solver of wam2017 -! -! tofd as in beljaars-2004 -! -! --------------------------- - if( do_tofd ) then - axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 - if ( kdt == 1 .and. me == 0) then - print *, 'vay do_tofd from surface to ', ztop_tofd - endif - do i = 1,npt - j = ipt(i) - zpbl = zmet( j, kpbl(j) ) - - sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of ls-sso - - zsurf = zmeti(j,1) - do k=1,km - zpm(k) = zmet(j,k) - up1(k) = u1(j,k) - vp1(k) = v1(j,k) - enddo - - call ugwp_tofd1d(km, cpd, sigflt, elvmaxd(j), zsurf, zpbl, & - up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) - - do k=1,km - axtms(j,k) = utofd1(k) - aytms(j,k) = vtofd1(k) -! -! add tofd to gw-tendencies -! - pdvdt(j,k) = pdvdt(j,k) + aytms(j,k) - pdudt(j,k) = pdudt(j,k) + axtms(j,k) - enddo -!2018-diag - tau_tofd(j) = sum( utofd1(1:km)* del(j,1:km)) - enddo - endif ! do_tofd - -!-------------------------------------------- -! combine oro-drag effects MB +TOFD + OGWs -!-------------------------------------------- -! + diag-3d - - dudt_tms = axtms - tau_ogw = 0. - tau_mtb = 0. - - do k = 1,km - do i = 1,npt - j = ipt(i) -! - eng0 = 0.5*(u1(j,k)*u1(j,k)+v1(j,k)*v1(j,k)) -! - if ( k < idxzb(i) .and. idxzb(i) /= 0 ) then -! -! if blocking layers -- no ogws -! - dbim = db(i,k) / (1.+db(i,k)*dtp) - pdvdt(j,k) = - dbim * v1(j,k) +pdvdt(j,k) - pdudt(j,k) = - dbim * u1(j,k) +pdudt(j,k) - eng1 = eng0*(1.0-dbim*dtp)*(1.-dbim*dtp) - - dusfc(j) = dusfc(j) - dbim * u1(j,k) * del(j,k) - dvsfc(j) = dvsfc(j) - dbim * v1(j,k) * del(j,k) -!2018-diag - dudt_mtb(j,k) = -dbim * u1(j,k) - tau_mtb(j) = tau_mtb(j) + dudt_mtb(j,k)* del(j,k) - - else -! -! ogw-s above blocking height -! - taud(i,k) = taud(i,k) * dtfac(i) - dtaux = taud(i,k) * xn(i) * pgwd - dtauy = taud(i,k) * yn(i) * pgwd - - pdvdt(j,k) = dtauy +pdvdt(j,k) - pdudt(j,k) = dtaux +pdudt(j,k) - - unew = u1(j,k) + dtaux*dtp ! pdudt(j,k)*dtp - vnew = v1(j,k) + dtauy*dtp ! pdvdt(j,k)*dtp - eng1 = 0.5*(unew*unew + vnew*vnew) -! - dusfc(j) = dusfc(j) + dtaux * del(j,k) - dvsfc(j) = dvsfc(j) + dtauy * del(j,k) -!2018-diag - dudt_ogw(j,k) = dtaux - tau_ogw(j) = tau_ogw(j) +dtaux*del(j,k) - endif -! -! local energy deposition sso-heat -! - pdtdt(j,k) = max(eng0-eng1,0.)*rcpdt - enddo - enddo -! dusfc w/o tofd sign as in the era-i, merra and cfsr - do i = 1,npt - j = ipt(i) - dusfc(j) = -rgrav * dusfc(j) - dvsfc(j) = -rgrav * dvsfc(j) - tau_mtb(j) = -rgrav * tau_mtb(j) - tau_ogw(j) = -rgrav * tau_ogw(j) - tau_tofd(j) = -rgrav * tau_tofd(j) - enddo - - return - - -!============ debug ------------------------------------------------ - if (kdt <= 2 .and. me == 0) then - print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me -! - print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw_axoro' - print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw_ayoro' -! print *, maxval(kdis), minval(kdis), 'vgw_kdispro m2/sec' - print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw_epsoro' - print *, maxval(zmtb), ' z_mtb ', maxval(tau_mtb), ' tau_mtb ' - print *, maxval(zogw), ' z_ogw ', maxval(tau_ogw), ' tau_ogw ' -! print *, maxval(tau_tofd), ' tau_tofd ' -! print *, maxval(axtms)*86400., minval(axtms)*86400, 'vgw_axtms' -! print *,maxval(dudt_mtb)*86400.,minval(dudt_mtb)*86400,'vgw_axmtb' - if (maxval(abs(pdudt))*86400. > 100.) then - - print *, maxval(u1), minval(u1), ' u1 gwdps-v0 ' - print *, maxval(v1), minval(v1), ' v1 gwdps-v0 ' - print *, maxval(t1), minval(t1), ' t1 gwdps-v0 ' - print *, maxval(q1), minval(q1), ' q1 gwdps-v0 ' - print *, maxval(del), minval(del), ' del gwdps-v0 ' - print *, maxval(zmet),minval(zmet), 'zmet' - print *, maxval(zmeti),minval(zmeti), 'zmeti' - print *, maxval(prsi), minval(prsi), ' prsi ' - print *, maxval(prsl), minval(prsl), ' prsl ' - print *, maxval(ro), minval(ro), ' ro-dens ' - print *, maxval(bnv2(1:npt,:)), minval(bnv2(1:npt,:)),' bnv2 ' - print *, maxval(kpbl), minval(kpbl), ' kpbl ' - print *, maxval(sgh30), maxval(hprime), maxval(elvmax),'oro-d' - print * - do i =1, npt - j= ipt(i) - print *,zogw(j)/hprime(j), zmtb(j)/hprime(j), & - zmet(j,1)*1.e-3, nint(hprime(j)/sigma(j)) -! -!.................................................................... -! -! zogw/hp=5.9 zblk/hp=10.7 zm=11.1m ridge/2=2,489m/9,000m -! from 5 to 20 km , we need to count for "ridges" > dx/4 ~ 15 km -! we must exclude blocking by small ridges -! vay-kref < iblk zogw-lev 15 block-level: 39 -! -! velmin => 1.0, 0.01, 0.1 etc.....unification of wind limiters -! max(sqrt(u1(j,k)*u1(j,k) + v1(j,k)*v1(j,k)), minwnd) -! max(dw2,dw2min) * rdz * rdz -! ulow(i) = max(sqrt(ubar(i)*ubar(i) + vbar(i)*vbar(i)), 1.0) -! tem = max(velco(i,k)*velco(i,k), 0.1) -! temv = 1.0 / max(velco(i,k), 0.01) -! & * max(velco(i,k),0.01) -!.................................................................... - enddo - print * - stop - endif - endif - -!cires_ugwp_solv2_v1.f90 - return - end subroutine gwdps_oro_v1 - - -end module cires_ugwp_orolm97_v1 diff --git a/physics/cires_ugwp_solv2_v1_mod.F90 b/physics/cires_ugwp_solv2_v1_mod.F90 deleted file mode 100644 index 46a5fb833..000000000 --- a/physics/cires_ugwp_solv2_v1_mod.F90 +++ /dev/null @@ -1,829 +0,0 @@ -module cires_ugwp_solv2_v1_mod - - -contains - - -!--------------------------------------------------- -! Broad spectrum FVS-1993, mkz^nSlope with nSlope = 0, 1,2 -! dissipative solver with NonHyd/ROT-effects -! reflected GWs treated as waves with "negligible" flux, -! they are out of given column -!--------------------------------------------------- - subroutine cires_ugwp_solv2_v1(im, levs, dtp , & - tm , um, vm, qm, prsl, prsi, zmet, zmeti, & - prslk, xlatd, sinlat, coslat, & - grav, cpd, rd, rv, omega, pi, fv, & - pdudt, pdvdt, pdtdt, dked, tauabs, wrms, trms, & - tau_ngw, mpi_id, master, kdt) -! -!-------------------------------------------------------------------------------- -! nov 2015 alternative gw-solver for nggps-wam -! nov 2017 nh/rotational gw-modes for nh-fv3gfs -! oct 2019 adding empirical satellite-based -! source function and *F90 CIRES-style of the code -! -------------------------------------------------------------------------------- -! - - use machine, only : kind_phys - - use cires_ugwp_module_v1,only : krad, kvg, kion, ktg - - use cires_ugwp_module_v1,only : knob_ugwp_doheat, knob_ugwp_dokdis, idebug_gwrms - - use ugwp_common_v1 , only : dw2min, velmin, hpscale, rhp, rh4 -! - use ugwp_wmsdis_init_v1, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & - maxdudt, gw_eff, dked_min, dked_max, maxdtdt, & - nslope, ilaunch, zms, & - zci, zdci, zci4, zci3, zci2, & - zaz_fct, zcosang, zsinang, nwav, nazd, & - zcimin, zcimax, rimin, sc2, sc2u, ric -! - implicit none -!23456 - - integer, intent(in) :: levs ! vertical level - integer, intent(in) :: im ! horiz tiles - - real ,intent(in) :: dtp ! model time step - real ,intent(in) :: vm(im,levs) ! meridional wind - real ,intent(in) :: um(im,levs) ! zonal wind - real ,intent(in) :: qm(im,levs) ! spec. humidity - real ,intent(in) :: tm(im,levs) ! kinetic temperature - - real ,intent(in) :: prsl(im,levs) ! mid-layer pressure - real ,intent(in) :: prslk(im,levs) ! mid-layer exner function - real ,intent(in) :: zmet(im,levs) ! meters now !!!!! phil =philg/grav - real ,intent(in) :: prsi(im,levs+1) ! interface pressure - real ,intent(in) :: zmeti(im,levs+1) ! interface geopi/meters - real ,intent(in) :: xlatd(im) ! lat was in radians, now with xlat_d in degrees - real ,intent(in) :: sinlat(im) - real ,intent(in) :: coslat(im) - real ,intent(in) :: tau_ngw(im) - - integer, intent(in):: mpi_id, master, kdt - - real ,intent(in) :: grav, cpd, rd, rv, omega, pi, fv -! -! -! out-gw effects -! - real ,intent(out) :: pdudt(im,levs) ! zonal momentum tendency - real ,intent(out) :: pdvdt(im,levs) ! meridional momentum tendency - real ,intent(out) :: pdtdt(im,levs) ! gw-heating (u*ax+v*ay)/cp - real ,intent(out) :: dked(im,levs) ! gw-eddy diffusion -! -! GW diagnostics => next move it to "module_gw_diag" -! - real ,intent(out) :: tauabs(im,levs) ! - real ,intent(out) :: wrms(im,levs) ! - real ,intent(out) :: trms(im,levs) ! - - real :: zwrms(nwav,nazd), wrk1(levs), wrk2(levs) - real :: atrms(nazd, levs),awrms(nazd, levs), akzw(nwav,nazd, levs+1) -! -! local =========================================================================================== - real :: taux(levs+1) ! EW component of vertical momentum flux (pa) - real :: tauy(levs+1) ! NS component of vertical momentum flux (pa) - real :: fpu(nazd, levs+1) ! az-momentum flux - real :: ui(nazd, levs+1) ! azimuthal wind - - real :: fden_bn(levs+1) ! density/brent - real :: flux_z(nwav,levs+1) - real :: flux(nwav, nazd) -! -! =============================================================================================== -! ilaunch:levs ....... MOORTHI's improvements -! all computations of GW-effects include interface layers from ilaunch+1 to levs +1 -! at k=levs+1, extrapolation of MF-state has been made, "ideally" all spectral modes should -! be absorbed; 2-options for this "ideal" requirement -! a) properly truncate GW-spectra ; b) dissipate all GW-energy in the top layers ( GW-sponge) -!===================================================================================================== -! - real :: bn(levs+1) ! interface BV-frequency - real :: bn2(levs+1) ! interface BV*BV-frequency - real :: rhoint(levs+1) ! interface density - real :: uint(levs+1) ! interface zonal wind - real :: vint(levs+1) ! meridional wind - - real :: irhodz_mid(levs), dzdt(levs+1), bnk(levs+1), rhobnk(levs+1) - - real :: v_zmet(levs+1) - real :: vueff(levs+1) - real :: dfdz_v(nazd, levs) ! axj = -df*rho/dz directional momentum deposition - - - real :: suprf(levs+1) ! RF-super linear dissipation - - real, dimension(levs) :: atm , aum, avm, aqm, aprsl, azmet - real, dimension(levs+1) :: aprsi, azmeti - - real :: wrk3(levs) - real, dimension(levs) :: uold, vold, told, unew, vnew, tnew - real, dimension(levs) :: dktur, rho, rhomid, adif, cdif - - real :: rdci(nwav), rci(nwav) - real :: wave_act(nwav, nazd) ! active waves at given vert-level - real :: ul(nazd) ! velocity in azimuthal direction at launch level - real :: bvi, bvi2, bvi3, bvi4, rcms ! BV at launch level - real :: c2f2, cf1 - - - real :: flux_norm ! norm-factor - real :: taub_src, rho_src -! -! scalars -! - real :: zthm, dtau, cgz, ucrit_maxdc - real :: vm_zflx_mode, vc_zflx_mode - real :: kzw2, kzw3, kdsat, cdf2, cdf1, wdop2,v_cdp2 - real :: ucrit_max - real :: pwrms, ptrms - real :: zu, zcin, zcin2, zcin3, zcin4, zcinc - real :: zatmp, fluxs, zdep, ze1, ze2 -! - real :: rcpdl, grav2cpd, rcpd, rcpd2, pi2, rad_to_deg - real :: deg_to_rad, rdi, gor, grcp, gocp, bnv2min, bnv2max, gr2 - real :: grav2, rgrav, rgrav2, mkzmin, mkz2min -! - real :: zdelp, zdelm, taud_min - real :: tvc, tvm, ptc, ptm - real :: umfp, umfm, umfc, ucrit3 - real :: fmode, expdis, fdis - real :: v_kzi, v_kzw, v_cdp, v_wdp, tx1, fcorsat, dzcrit - real :: v_wdi, v_wdpc - real :: ugw, vgw, ek1, ek2, rdtp, rdtp2 - - integer :: j, jj, k, kk, inc, jk, jkp, jl, iaz - integer :: ksrc, km2, km1, kp1, ktop -! -! Kturb-part -! - - real :: uz, vz, shr2 , ritur, ktur - - real :: kamp, zmetk, zgrow - real :: stab, stab_dt, dtstab - integer :: nstab, ist, anstab(levs) - real :: w1, w2, w3, dtdif - - real :: dzmetm, dzmetp, dzmetf, bdif, kturp - real :: bnrh_src -!-------------------------------------------------------------------------- -! - - if (mpi_id == master .and. kdt < 2) then - print *, im, levs, dtp, kdt, ' vay-solv2-v1' - print *, minval(tm), maxval(tm), ' min-max-tm ' - print *, minval(vm), maxval(vm), ' min-max-vm ' - print *, minval(um), maxval(um), ' min-max-um ' - print *, minval(qm), maxval(qm), ' min-max-qm ' - print *, minval(prsl), maxval(prsl), ' min-max-Pmid ' - print *, minval(prsi), maxval(prsi), ' min-max-Pint ' - print *, minval(zmet), maxval(zmet), ' min-max-Zmid ' - print *, minval(zmeti), maxval(zmeti), ' min-max-Zint ' - print *, minval(prslk), maxval(prslk), ' min-max-Exner ' - print *, minval(tau_ngw), maxval(tau_ngw), ' min-max-taungw ' - print *, tau_min, ' tau_min ', tamp_mpa, ' tamp_mpa ' -! - endif - - if (idebug_gwrms == 1) then - tauabs=0.0; wrms =0.0 ; trms =0.0 - endif - - - grav2 = grav + grav - rgrav = 1.0/grav - rgrav2 = rgrav*rgrav - rdi = 1.0/rd - gor = grav/rd - gr2 = grav*gor - rcpd = 1.0/cpd - rcpd2 = 0.5/cpd - rcpdl = cpd*rgrav ! 1/[g/cp] == cp/g - pi2 = 2.0*pi - grcp = grav*rcpd - gocp = grcp - grav2cpd = grav*grcp ! g*(g/cp)= g^2/cp - rad_to_deg=180.0/pi - deg_to_rad=pi/180.0 - bnv2min = (pi2/1800.)*(pi2/1800.) - bnv2max = (pi2/30.)*(pi2/30.) - mkzmin = pi2/80.0e3 - mkz2min = mkzmin*mkzmin - - rci(:) = 1./zci(:) - rdci(:) = 1./zdci(:) - - rdtp = 1./dtp - rdtp2 = 0.5*rdtp -! -! launch level control ksrc > 2 -! - - ksrc= max(ilaunch, 3) - km2 = ksrc - 2 - km1 = ksrc - 1 - kp1 = ksrc + 1 - ktop= levs+1 - - do k=1,levs - suprf(k) = kion(k) ! approximate 1-st order damping with Fast super-RF of FV3 - pdvdt(:,k) = 0.0 - pdudt(:,k) = 0.0 - pdtdt(:,k) = 0.0 - dked(: ,k) = 0.0 - enddo - -!----------------------------------------------------------- -! column-based j=1,im pjysics with 1D-arrays -!----------------------------------------------------------- - DO j=1, im - - jl =j - tx1 = 2*omega * sinlat(j) *rv_kxw - cf1 = abs(tx1) - c2f2 = tx1 * tx1 - ucrit_max = max(ucrit, cf1) - ucrit3 = ucrit_max*ucrit_max*ucrit_max -! -! ngw-fluxes at all gridpoints (with tau_min at least) -! - taub_src = max(tau_ngw(jl), tau_min) - aum(km2:levs) = um(jl,km2:levs) - avm(km2:levs) = vm(jl,km2:levs) - atm(km2:levs) = tm(jl,km2:levs) - aqm(km2:levs) = qm(jl,km2:levs) - aprsl(km2:levs) = prsl(jl,km2:levs) - azmet(km2:levs) = zmet(jl,km2:levs) - aprsi(km2:levs+1) = prsi(jl,km2:levs+1) - azmeti(km2:levs+1) = zmeti(jl,km2:levs+1) - - rho_src = aprsl(ksrc)*rdi/atm(ksrc) - -! --------------------------------------------- -! interface mean flow parameters launch -> levs+1 -! --------------------------------------------- - do jk= km1,levs - tvc = atm(jk) * (1. +fv*aqm(jk)) - tvm = atm(jk-1) * (1. +fv*aqm(jk-1)) - ptc = tvc/ prslk(jl, jk) - ptm = tvm/prslk(jl,jk-1) -! - zthm = 2.0 / (tvc+tvm) -! - uint(jk) = 0.5 *(aum(jk-1)+aum(jk)) - vint(jk) = 0.5 *(avm(jk-1)+avm(jk)) - rhomid(jk) = aprsl(jk)*rdi/atm(jk) - rhoint(jk) = aprsi(jk)*rdi*zthm ! rho = p/(RTv) - zdelp = azmeti(jk+1)-azmeti(jk) ! >0 ...... dz-meters - zdelm = 1./(azmet(jk)-azmet(jk-1)) ! 1/dz ...... 1/meters - dzdt(jk) = dtp/zdelp -! -! bvf2 = grav2 * zdelm * (ptc-ptm)/ (ptc + ptm) ! N2=[g/PT]*(dPT/dz) -! - bn2(jk) = grav2cpd*zthm * (1.0+rcpdl*(tvc-tvm)*zdelm) - bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) - bn(jk) = sqrt(bn2(jk)) - bnk(jk) = bn(jk)*v_kxw - rhobnk(jk)=rhoint(jk)/bnk(jk)*v_kxw - wrk3(jk)= 1./zdelp/rhomid(jk) ! 1/rho_mid(k)/[Z_int(k+1)-Z_int(k)] - irhodz_mid(jk) = rdtp*zdelp*rhomid(jk)/rho_src - - v_zmet(jk) = 2.*zdelp ! 2*kzi*[Z_int(k+1)-Z_int(k)] -! -! -! diagnostics -Kzz above PBL -! - uz = aum(jk) - aum(jk-1) - vz = avm(jk) - avm(jk-1) - shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm - - zmetk = azmet(jk)* rh4 ! mid-layer height k_int => k_int+1 - zgrow = exp(zmetk) - ritur = bn2(jk)/shr2 - kamp = sqrt(shr2)*sc2 *zgrow - w1 = 1./(1. + 5*ritur) - ktur= min(max(kamp * w1 * w1, dked_min)+kvg(k), dked_max) - zmetk = azmet(jk)* rhp - vueff(jk) = ktur*0. + 2.e-5*exp( zmetk) - enddo - - if (idebug_gwrms == 1) then - do jk= km1,levs - wrk1(jk) = rv_kxw/rhoint(jk) - wrk2(jk)= rgrav2*zthm*zthm*bn2(jk) ! dimension [K*K]*(c2/m2) - enddo - endif - -! -! extrapolating values for ktop = levs+1 (lev-interface for prsi(levs+1) =/= 0) -! - jk = levs - - suprf(ktop) = kion(jk) - - rhoint(ktop) = aprsi(ktop)*rdi/atm(jk) - - uint(ktop) = aum(jk) - vint(ktop) = avm(jk) - - v_zmet(ktop) = v_zmet(jk) - vueff(ktop) = vueff(jk) - bn2(ktop) = bn2(jk) - bn(ktop) = bn(jk) - bnk(ktop) = bn(ktop)*v_kxw - - rhobnk(ktop) = rhoint(ktop)/bnk(ktop)*v_kxw - - bvi = bn(ksrc); bvi2 = bvi * bvi; - bvi3 = bvi2*bvi; bvi4 = bvi2 * bvi2; rcms = zms/bvi - bnrh_src = bvi/rhoint(ksrc) -! -! define intrinsic velocity (relative to ilaunch) u(z)-u(zo), and coefficinets -! ------------------------------------------------------------------------------------------ - do iaz=1, nazd - ul(iaz) = zcosang(iaz) *uint(ksrc) + zsinang(iaz) *vint(ksrc) - enddo -! - do jk=ksrc, ktop - do iaz=1, nazd - zu = zcosang(iaz)*uint(jk) + zsinang(iaz)*vint(jk) - ui(iaz, jk) = zu !- ul(iaz)*0. - enddo - enddo -! ----------------------------------------- -! set launch momentum flux spectral density -! ----------------------------------------- - - fpu(1, ksrc) =0. - do inc=1,nwav - zcin = zci(inc) - zcin4 = zci4(inc)/bvi4 -! - if(nslope == 0) then - zcin3 = zci3(inc)/bvi3 - flux(inc,1) = zcin/(1.+zcin3) - endif - - if(nslope == 1) flux(inc,1) = zcin/(1.+zcin4) - if(nslope == 2) flux(inc,1)= zcin/(1.+zcin4*zcin*rcms) - -! integrate (flux x dx) - fpu(1,ksrc) = fpu(1,ksrc) + flux(inc,1)*zdci(inc) - - do iaz=1,nazd - akzw(inc, iaz,ksrc:ktop) = bvi*rci(inc) - enddo - - enddo -! - flux_norm = taub_src / fpu(1, ksrc) -! - do iaz=1,nazd - fpu(iaz, ksrc) = taub_src - enddo - -! adjust rho/bn vertical factors for saturated fluxes (E(m) ~m^-3) - bnrh_src=bnrh_src*flux_norm - do jk=ksrc, ktop - fden_bn(jk) = bnrh_src*rhoint(jk) / bn(jk) !*bvi/rhoint(ksrc) - enddo - -! - do inc=1, nwav - flux(inc,1) = flux_norm*flux(inc,1) - enddo - - if (idebug_gwrms == 1) then - pwrms =0. - ptrms =0. - tx1 = real(nazd)/rhoint(ksrc)*rv_kxw - ze2 = wrk2(ksrc) ! (bvi*atm(ksrc)*rgrav)**2 - do inc=1, nwav - v_kzw = bvi*rci(inc) - ze1 = flux(inc,1)*zdci(inc)*tx1*v_kzw - pwrms = pwrms + ze1 - ptrms = ptrms + ze1 * ze2 - enddo - wrms(jl, ksrc) = pwrms - trms(jl, ksrc) = ptrms - endif - -! copy flux-1 into other azimuths -! -------------------------------- - do iaz=2, nazd - do inc=1,nwav - flux(inc,iaz) = flux(inc,1) - enddo - enddo - -! constant flux below ilaunch - do jk=km1, ksrc - do inc=1, nwav - flux_z(inc,jk)=flux(inc,1) - enddo - enddo - - wave_act(:,:) = 1.0 -! vertical do-loop - do jk=ksrc, levs - jkp = jk+1 -! azimuth do-loop - do iaz=1, nazd - - umfp = ui(iaz, jkp) - umfm = ui(iaz, jk) - umfc = .5*(umfm + umfp) -! wave-cin loop - do inc=1, nwav - - zcin = zci(inc) ! zcin =/0 by definition - zcinc = rci(inc) - - if(wave_act(inc,iaz) == 1.0) then -!======================================================================= -! discrete mode -! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat -! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) -!======================================================================= - - v_cdp = zcin - umfp - - if (v_cdp .le. ucrit_max) then -! -! between layer [k-1,k or jk-jkp] (Chi - Uk) -> ucrit_max ; wave's absorption -! - wave_act(inc,iaz) =0. - akzw(inc, iaz, jkp) = pi/v_zmet(jk) ! pi2/dzmet - fluxs = 0.0 !max(0., rhobnk(jkp)*ucrit3)*rdci(inc) - flux(inc,iaz) = fluxs - flux_z(inc,jkp) = fluxs -! ucrit_maxdc =0. - else - - v_wdp = v_kxw*v_cdp - wdop2 = v_wdp* v_wdp - v_cdp2=v_cdp*v_cdp -! -! rotational cut-off -! - cdf2 = v_cdp2 - c2f2 - - if (cdf2 > 0.0) then - kzw2 = (bn2(jkp)-wdop2)/Cdf2 - else - kzw2 = mkz2min - endif - - if ( kzw2 > mkz2min ) then - v_kzw = sqrt(kzw2) - akzw(inc, iaz, jkp) = v_kzw -! -!linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 -! -!kzw2 = (bn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) -! Kds = kxw*Cdf1*rhp2/kzw3 -! - v_cdp = sqrt( cdf2 ) - v_wdp = v_kxw * v_cdp - v_wdi = kzw2*vueff(jk) + supRF(jk) ! supRF - diss due to FRF-FV3dycore for "all" vars - v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) - v_kzi = v_kzw*v_wdi/v_wdpc -! - ze1 = v_kzi*v_zmet(jk) - - if (ze1 .ge. 1.e-2) then - expdis = max(exp(-ze1), 0.01) - else - expdis = 1./(1.+ ze1) - endif - -! - wave_act(inc,iaz) = 1.0 - fmode = flux(inc,iaz) - - else ! kzw2 <= mkz2min large "Lz"-reflection - - expdis = 1.0 - v_kzw = mkzmin - - v_cdp = 0. ! no effects of reflected waves - wave_act(inc,iaz) = 0.0 - akzw(inc, iaz, jkp) = v_kzw - fmode = 0. - endif - - fdis = fmode*expdis -! -! saturated flux + wave dissipation - Keddy_gwsat in UGWP-V1 -! linsatdis = 1.0 , here: u'^2 ~ linsatdis* [v_cdp*v_cdp] -! -! fluxs= fden_bn(jkp)*cdf2*zcinc - fluxs= fden_bn(jkp)*sqrt(cdf2) - -! -! S2003 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz))**2/zcin -! WM2001 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz)) -! - zdep = wave_act(inc,iaz)* (fdis-fluxs) - if(zdep > 0.0 ) then -! subs on sat-limit - flux(inc,iaz) = fluxs - flux_z(inc,jkp) = fluxs - else -! assign dis-ve flux - flux(inc,iaz) = fdis - flux_z(inc,jkp) = fdis - endif - -! cgz = bnk(jk)/max(mkz2min, kzw2) - - dtau = flux_z(inc,jk)-flux_z(inc,jkp) - if (dtau .lt. 0) flux_z(inc,jkp) = flux_z(inc,jk) - -! if (dtau .ge. ucrit_maxdc) then -! flux_z(inc,jkp) = max(flux_z(inc,jk)-ucrit_maxdc, 0.) -! ze1 = zci(inc)-umfc-ucrit_maxdc -! write(6,287) dzdt(jk)/cgz, dtau/ucrit_maxdc, flux_z(inc,jkp)*1.e3, fluxs*1.e3, jk, zci(inc), ze1 -! -! endif -! 287 format(' dtau >ucrit_max', 4(2x, F12.7), I4, 2x, 2(2x,F8.3)) -! - - endif ! coriolis or CL condition-checkif => (v_cdp .le. ucrit_max) then - endif ! only for waves w/o CL-absorption wave_act=1 - - -! - enddo ! wave-inc-loop -! -! integrate over spectral modes fpu(y, z, azimuth) wave_act(jl,inc,iaz)*flux(jl,inc,iaz)*[d("zcinc")] -! - if (idebug_gwrms == 1) then - pwrms =0. - ptrms =0. -! new arrays - - do inc=1, nwav - if (wave_act(inc,iaz) > 0.) then - v_kzw =akzw(inc, iaz, jk) - ze1 = flux(inc,iaz)*v_kzw*zdci(inc)*wrk1(jk) - pwrms = pwrms + ze1 - ptrms = ptrms + ze1*wrk2(jk) - endif - enddo - Awrms(iaz, jk) = pwrms - Atrms(iaz, jk) = ptrms - endif - - - dfdz_v(iaz, jk) = 0.0 - fpu(iaz, jkp) = 0.0 - - do inc=1, nwav - if (wave_act(inc,iaz) > 0.) then - - zcinc =zdci(inc) - vc_zflx_mode = flux(inc,iaz) - fpu(iaz, jkp) = fpu(iaz,jkp) + vc_zflx_mode*zcinc - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! (heat deposition integration over spectral mode for each azimuth -! later sum over selected azimuths as "non-negative" scalars) -! cdf1 = sqrt( (zci(inc)-umfc)**2-c2f2) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! zdelp = wrk3(jk)*cdf1 *zcinc - zdelp = wrk3(jk)*abs(zci(inc)-umfc) *zcinc - vm_zflx_mode = flux_z(inc,jk) - dfdz_v(iaz, jk) = dfdz_v(iaz,jk) +(vm_zflx_mode-vc_zflx_mode)*zdelp ! heating >0 - endif - enddo !waves inc=1,nwav - - ze1 =fpu(iaz, jk) - if (fpu(iaz, jkp) > ze1 ) fpu(iaz, jkp) = ze1 -! -------------- - enddo ! end Azimuth do-loop - -! -! extra- eddy wave dissipation to limit GW-rms -! tx1 = sum(abs(dfdz_v(jk,1:nazd)))/bn2(jk) -! ze1=max(dked_min, tx1) -! ze2=min(dked_max, ze1) -! vueff(jkp) = ze2 + vueff(jkp) -! - - - enddo ! end Vertical do-loop -! -! top-layers constant interface-fluxes and zero-heat -! - fpu(1:nazd,ktop) = fpu(1:nazd, levs) - dfdz_v(1:nazd, levs) = 0.0 - -! --------------------------------------------------------------------- -! sum contribution for total zonal and meridional fluxes + -! energy dissipation -! --------------------------------------------------- -! -!======================================================================== -! at the source level and below taux = 0 (taux_E=-taux_W by assumption) -!======================================================================== - - - - do jk=ksrc, levs - taux(jk) = 0.0 - tauy(jk) = 0.0 - do iaz=1,nazd - taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) - tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) - pdtdt(jl,jk) = pdtdt(jl,jk)+ dfdz_v(iaz,jk) - enddo - enddo - jk = ktop; taux(jk)=0.; tauy(jk)=0. - do iaz=1,nazd - taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) - tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) - enddo - - if (idebug_gwrms == 1) then - - do jk=kp1, levs - do iaz=1,nazd - wrms(jl,jk) =wrms(jl,jk) + Awrms(iaz,jk) - trms(jl,jk) =trms(jl,jk) + Atrms(iaz,jk) - tauabs(jl,jk)=tauabs(jl,jk) + fpu(iaz,jk) - enddo - enddo - - endif -! - - do jk=ksrc,levs - jkp = jk + 1 - zdelp = wrk3(jk)*gw_eff - ze1 = (taux(jkp)-taux(jk))* zdelp - ze2 = (tauy(jkp)-tauy(jk))* zdelp - - if (abs(ze1) >= maxdudt ) then - ze1 = sign(maxdudt, ze1) - endif - if (abs(ze2) >= maxdudt ) then - ze2 = sign(maxdudt, ze2) - endif - pdudt(jl,jk) = -ze1 - pdvdt(jl,jk) = -ze2 -! -! Cx =0 based Cx=/= 0. above -! -! - if (knob_ugwp_doheat == 1) then -! -! ek1 =aum(jk)*aum(jk) +avm(jk)*avm(jk) -! ugw = aum(jk)- ze1*dtp; vgw = avm(jk)- ze2*dtp -! ek2 = ugw*ugw +vgw*vgw -! pdtdt(jl,jk) = rdtp2*max(ek1-ek2, 0.0) !=ze1*um + 0.5*ze1^2*dtp -! pdtdt(jl,jk) = max(ze1*aum(jk) + ze2*avm(jk), 0.) ! gw_eff => in "ze1 and ze2" - pdtdt(jl,jk) = max(pdtdt(jl,jk) , 0.)*gw_eff - endif - - if (abs(pdtdt(jl,jk)) >= maxdtdt ) pdtdt(jl,jk) = maxdtdt - ze1 = max(dked_min, pdtdt(jl,jk)/bn2(jk)) - dked(jl,jk) = min(dked_max, ze1) - - enddo -! -! add limiters/efficiency for "unbalanced ics" if it is needed -! - do jk=ksrc,levs - pdtdt(jl,jk) = pdtdt(jl,jk)*rcpd - enddo -! - dktur(1:levs) = dked(jl,1:levs) -! - do ist= 1, 3 - do jk=ksrc,levs-1 - adif(jk) = .25*(dktur(jk-1)+ dktur(jk+1)) + .5*dktur(jk) - enddo - dktur(ksrc:levs-1) = adif(ksrc:levs-1) - enddo - -! dked(jl, ksrc:levs-1) = dktur(ksrc:levs-1) -! dked(jl, levs) =dked(jl, levs-1) - -! -! perform "diffusive" 3-point smoothing of "u-v-t" -! from the surface to the "top" -! - if (knob_ugwp_dokdis == 2) then - - uold(1:levs) = aum(1:levs)+pdudt(jl,1:levs)*dtp - vold(1:levs) = avm(1:levs)+pdvdt(jl,1:levs)*dtp - told(1:levs) = atm(1:levs)+pdtdt(jl,1:levs)*dtp - - do jk=1,levs - zmetk= azmet(jk)*rhp - ktur = kvg(k) + 2.e-5*exp( zmetk) - dktur(jk) = dked(jl,jk) + ktur - enddo - - dzmetm= azmet(ksrc)- azmet(ksrc-1) - - do jk=2,levs-1 - dzmetf = (azmeti(jk+1)- azmeti(jk))*rhomid(jk) - ktur = .5*(dktur(jk-1)+dktur(jk)) *rhoint(jk)/dzmetf - kturp = .5*(dktur(jk+1)+dktur(jk))*rhoint(jk+1)/dzmetf - - dzmetp = azmet(jk+1)-azmet(jk) - Adif(jk) = ktur/dzmetm - Cdif(jk) = kturp/dzmetp - bdif = adif(jk)+cdif(jk) - if (rdtp < bdif ) then - Anstab(jk) = nint( bdif/rdtp + 1) - else - Anstab(jk) = 1 - endif - dzmetm = dzmetp - enddo - - nstab = maxval( Anstab(ksrc:levs-1)) - if (nstab .ge. 2) print *, 'nstab ', nstab - dtdif = dtp/real(nstab) - do ist= 1, nstab - do k=ksrc,levs-1 - Bdif = nstab*rdtp-Adif(k)-Cdif(k) - unew(k) = uold(k)*Bdif+ uold(k-1)*Adif(k) + uold(k)*Cdif(k) - vnew(k) = vold(k)*Bdif+ vold(k-1)*Adif(k) + vold(k)*Cdif(k) - tnew(k) = told(k)*Bdif+ told(k-1)*Adif(k) + told(k)*Cdif(k) - enddo - uold = unew*dtdif - vold = vnew*dtdif - told = tnew*dtdif - enddo -! -! create "smoothed" tendencies by molecular + GW-eddy diffusion -! - do k=ksrc,levs-1 - pdtdt(jl,jk)= rdtp*(told(k) - tm(jl,k)) - ze2 = rdtp*(uold(k) - aum(k)) - ze1 = rdtp*(vold(k) - avm(k)) - if (abs(pdtdt(jl,jk)) >= maxdtdt ) pdtdt(jl,jk) = maxdtdt - if (abs(ze1) >= maxdudt ) then - ze1 = sign(maxdudt, ze1) - endif - if (abs(ze2) >= maxdudt ) then - ze2 = sign(maxdudt, ze2) - endif - pdudt(jl, k) = ze2 - pdvdt(jl, k) = ze1 -! -! add eddy viscosity heating -! pdtdt(jl,jk) = pdtdt(jl,jk) - max(ze1*aum(jk) + ze2*avm(jk), 0.) *rcpd -! - enddo - - - ENDIF ! dissipative IF-loop for "abrupt" tendencies - - enddo ! J-loop -! - - - RETURN - -! -! Print/Debugging ----------------------------------------------------------------------- -! - 239 continue - if (kdt ==1 .and. mpi_id == master) then -! - print *, 'ugwp-vay: nazd-nw-ilaunch=', nazd, nwav,ilaunch, maxval(kvg), ' kvg ' - print *, 'ugwp-vay: zdci(inc)=' , maxval(zdci), minval(zdci) - print *, 'ugwp-vay: zcimax=' , maxval(zci) ,' zcimin=' , minval(zci) -! print *, 'ugwp-vay: tau_ngw=' , maxval(taub_src)*1.e3, minval(taub_src)*1.e3, tau_min - - print * - - endif - - if (kdt == 1 .and. mpi_id == master) then - print *, 'vgw done nstab ', nstab -! - print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax ugwp' - print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay ugwp' - print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec ugwp' - print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps ugwp' -! -! print *, ' ugwp -heating rates ' - endif - - - - return - end subroutine cires_ugwp_solv2_v1 - - -end module cires_ugwp_solv2_v1_mod diff --git a/physics/cires_ugwp_solvers.F90 b/physics/cires_ugwp_solvers.F90 deleted file mode 100644 index 6736daf6a..000000000 --- a/physics/cires_ugwp_solvers.F90 +++ /dev/null @@ -1,664 +0,0 @@ -! GW SOLVERS: -!=========== SOLVER_ORODIS; SOLVER_WMSDIS, SOLVER_LSATDIS -! + RF_DAMP if it is needed along with ugwp_tofd -!=========== -! Note in contrast to dycore vertical indices: surface=1 top=levs -! -! Collection of main friction-GWD solvers -! -! subroutine ugwp_oro -! -! subroutine gw_solver_linsatdis -! subroutine gw_solver_wmsdis -! subroutine rf_damp -! -! =========== -! -! - subroutine ugwp_oro(im, levs, dtp, kdt,me, lprnt, fcor, c2f2, & - u, v, tkin, pint, delp, pmid, pexner, gzint, gzmid, orostat, & - hpbl, axz, ayz, edis, kdis, dusfc, dvsfc, & - dusfc_mb, dvsfc_mb, dusfc_ogw, dvsfc_ogw, dusfc_lwb, dvsfc_lwb, & - zmtb, zlwb, zogw, tauf_ogw, tauz_ogw, axmtb, axlwb, axtms ) -!---------------------------------------------------------------------- -! COORDE-output: 6-hour inst: U, V, T, PMSL, PS, HT (ounce) -! 3D 6-hr aver: DYN-U, SSO-U, PBL-U, AF-U1.... -! 2D 6-hr aver: tau_SSO, tau_GWD, tau_BL; & -! tau_sso = tau_mtb + tau_tofd + tau_lwb +tau_ogw -! ZM 6-hr aver: tau_RES = PS*dH/dx -zonal mean -! Experiments: Midlat 80-200km -! LR_CTL; ; LR_NOSSO with TOFD/TMS; -! LR_NOGWD (MTN+TOFD); LR_GWD4 --- 4 times taub -!---------------------------------------------------------------------- - use machine , only : kind_phys - use ugwp_oro_init, only : cdmb, cleff, sigfac, hncrit, hpmin, hminmt - use ugwp_oro_init, only : gamm_std, sigma_std - use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 - - - use ugwp_common , only : pi, rad_to_deg, deg_to_rad, pi2 - - use cires_ugwp_module, only : kxw, max_kdis, max_axyz - - implicit none - logical :: lprnt - integer :: im, levs - integer :: me - integer :: kdt - real(kind_phys) :: dtp - real(kind_phys), dimension(im) :: hpbl ! pbl-height in meters - real(kind_phys), dimension(im) :: fcor, c2f2 - real(kind_phys), dimension(im, 14) :: orostat - real(kind_phys), dimension(im, levs) :: u, v, tkin, q - - real(kind_phys), dimension(im, levs) :: pmid, pexner, gzmid, delp - real(kind_phys), dimension(im, levs+1) :: pint, gzint - - - real(kind_phys), dimension(im, levs) :: axz, ayz, edis, kdis ! total 6-hr averaged tendencies - real(kind_phys), dimension(im, levs) :: krf2d - real(kind_phys), dimension(im, levs) :: tauz_ogw, axmtb, axlwb, axtms ! 3-sub components axogw = axz-(axmtb+axlwb+axtms) - real(kind_phys), dimension(im) :: tauf_ogw ! total-source momentum flux - - real(kind_phys), dimension(im) :: zmtb, zlwb, zogw - - real(kind_phys), dimension(im) :: dusfc, dvsfc ! total tausfc_sso - real(kind_phys), dimension(im) :: dusfc_mb, dvsfc_mb ! integrated tau_mtb - real(kind_phys), dimension(im) :: dusfc_ogw, dvsfc_ogw ! integrated tau_ogw - real(kind_phys), dimension(im) :: dusfc_lwb, dvsfc_lwb ! integrated tau_lwb - real(kind_phys), dimension(im) :: dusfc_tofd, dvsfc_tofd ! integrated tau_tofd - -! -! mu=hprime gamm=a/b sigma theta -! which stand for the standard deviation, the anisotropy, the slope and the orientation of the orography. -! - real(kind_phys) :: elvmax(im) - real(kind_phys) :: hprime(im) - - real(kind_phys) :: theta !the orienatation, angle - real(kind_phys) :: sigma !the slope dh/dx - real(kind_phys) :: gamm !the anisotropy see ifs-oro - - real(kind_phys) :: oc, oa4(4), clx4(4) !kim & doyle 2005 .... attempt to do TOFD ..? -! - integer, allocatable :: k_elev(:), k_mtb(:), k_ogw(:), k_lee(:), k_tofd(:) - - real(kind_phys) wk(im) - - real(kind_phys) eng0, eng1 -! -! -! - real(kind_phys), dimension(levs) :: up, vp, tp, qp, dp, zpm, pmid1, pex - - real(kind_phys), dimension(levs+1) :: taudz, rhoi, rim_z, pint1, zpi - real(kind_phys), dimension(levs) :: drtau, kdis_oro -! - real (kind_phys) :: elvp, elvpd, dtaux, dtauy - real(kind_phys) :: loss, mtb_fric, mbx, mby - real(kind_phys) :: sigflt - - real(kind_phys) :: zpbl = 2000. ! can be passed from PBL physics as in gwdps.f -! - logical icrilv(im) -! -!---- mountain/oro gravity wave drag +TOFD -! - real(kind=kind_phys), dimension(levs) :: utofd1, vtofd1, epstofd1, krf_tofd1 -! - real(kind=kind_phys), dimension(levs) :: drlee, drmtb, drlow, drogw - real(kind_phys) :: r_cpdt, acc_lim - real(kind_phys), dimension(im) :: tautot, tauogw, taumtb, taulee, taurf - real(kind_phys) :: xn, yn, umag, kxridge, & - tx1, tx2 - real(kind=kind_phys),dimension(levs+1):: tau_src - - integer :: npt, krefj, kdswj, kotr, i, j, k - integer :: ipt(im) - -! -! copy 1D -! - do i=1, im - hprime(i) = orostat(i, 1) - elvmax(i) = orostat(i, 14) -! - tautot(i) = 0.0 - tauogw(i) = 0.0 - taumtb(i) = 0.0 - taulee(i) = 0.0 - taurf(i) = 0.0 -! - dusfc(i) = 0.0 - dvsfc(i) = 0.0 - dusfc_mb(i) = 0.0 - dvsfc_mb(i) = 0.0 - dusfc_ogw(i) = 0.0 - dvsfc_ogw(i) = 0.0 - dusfc_lwb(i) = 0.0 - dvsfc_lwb(i) = 0.0 - dusfc_tofd(i) = 0.0 - dvsfc_tofd(i) = 0.0 - tauf_ogw(i) = 0.0 -! - zmtb(i) = -99. - zlwb(i) = -99. - zogw(i) = -99. - ipt(i) = 0 - enddo -! print *, maxval(hprime), maxval(elvmax), ' check hprime -elevmax ugwp_oro' -! -! 3-part of oro-effects + ked_oro -! - do k=1, levs - do i=1, im - axz(i,k) = 0.0 - ayz(i,k) = 0.0 - edis(i,k) = 0.0 - kdis(i,k) = 0.0 - krf2d(i,k) = 0.0 - tauz_ogw(i,k) = 0.0 - axmtb(i:,k) = 0.0 - axlwb(i,k) = 0.0 - axtms(i,k) = 0.0 - enddo - enddo - -! -! optional diag 3-parts of drag: [tx_ogw, tx_mtb, tx_lee] -! -! ----do we have orography for mtb and gwd calculation points ? -! - npt = 0 - do i = 1,im - if ( (elvmax(i) > hminmt) .and. (hprime(i) > hpmin) ) then - npt = npt + 1 - ipt(npt) = i - - endif - enddo - if (npt == 0) return ! no ororgraphy ====> gwd/mb calculation done - -! allocate(iwklm(npt), idxzb(npt), kreflm(npt)) - allocate( k_elev(npt), k_mtb(npt), k_ogw(npt), k_lee(npt), k_tofd(npt)) - do i=1,npt - k_ogw (i) = 2 - k_tofd(i) = 2 - k_lee (i) = 2 - k_mtb(i) = 0 - k_elev(i) = 2 - enddo -! -! controls through: use ugwp_oro_init -! main ORO-loop sigfac = n*sigma = [1.5, 2, 2.5, 4]*hprime -! - - - do i = 1, npt -! - j = ipt(i) - - elvpd = elvmax(j) - elvp = min (elvpd + sigfac * hprime(j), hncrit) - - sigma = orostat(j,13) - gamm = orostat(j,12) - theta = orostat(j,11)*deg_to_rad - - if (sigma == 0.0 ) then - sigma = sigma_std - gamm = gamm_std - theta = 0.0 - endif - - oc = orostat(j,2) - oa4(1) = orostat(j,3) - oa4(2) = orostat(j,4) - oa4(3) = orostat(j,5) - oa4(4) = orostat(j,6) - clx4(1) = orostat(j,7) - clx4(2) = orostat(j,8) - clx4(3) = orostat(j,9) - clx4(4) = orostat(j,10) -! -! do column-based diagnostics "more-efficient" for oro-places -! - - do k=1,levs - up(k) = u(j,k) - vp(k) = v(j,k) - tp(k) = tkin(j,k) - qp(k) = q(j,k) - dp(k) = delp(j,k) - - zpm(k) = gzmid(j,k) * rgrav - pmid1(k) = pmid(j,k) - pex(k) = pexner(j,k) - enddo - do k=1,levs+1 - zpi(k) = gzint(j,k) * rgrav - pint1(k) = pint(j,k) - enddo -! -! elvp- k-index: iwklm k_elvp = index for elvmax + 4*hprime, "elevation index" -! GFS-2017 - do k=1, levs-1 - if (elvp <= zpi(k+1) .and. elvp > zpi(k)) then - k_elev(i) = k+1 !......simply k+1 next interface level - exit - endif - enddo -! if (elvp .ge. 300. ) then -! write(6,333) elvp, zpi(1), elvpd, hprime(j), sigfac, hncrit -! pause -! endif -!333 format(6(3x, F10.3)) -! -! SSO effects: TOFD-drag/friction coefficients can be calculated -! - sigflt = hprime(j)*0.01 ! turb SSo(j) ...small-scale orography < 2-5 km .... - zpbl = hpbl(j) - - call ugwp_tofd1d(levs, sigflt, elvPd, zpi(1), zpbl, up, vp, zpm, & - utofd1, vtofd1, epstofd1, krf_tofd1) - - do k=1, levs - krf2d(j,k) = krf_tofd1(k) - axtms(j,k) = utofd1(k) -!------- -! nullify ORO-tendencies -! - drmtb(k) = 0.0 - drlee(k) = 0.0 - drtau(k) = 0.0 - drlow(k) = 0.0 - enddo - -!------- -! -! levels of k_mtb(i)/mtb + kdswj/dwlee + krefj/ogwd inside next "subs" -! zmtb, zlwb, zogw -! drmtb, drlow/drlee, drogw -!------- -! -! mtb : drmtb => 1-st order friction as well as TurbulentOro-Drag -! - call ugwp_drag_mtb( k_elev(i), levs, & - elvpd, elvp, hprime(j), sigma, theta, oc, oa4, clx4, gamm, zpbl, & - up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, k_mtb(i), drmtb, taumtb(j)) - - axmtb(j,1:levs) = drmtb(1:levs)*up(1:levs) -! -! print * , k_elev(i), k_mtb(i) , taumtb(j)*1.e3, ' k_elev, k_mtb , taumtb ' -! -! tautot = taulee+tauogw + rho*drlee = -d[taulee(z)]/dz -! - - - call ugwp_taub_oro(levs, k_mtb(i), kxw, taumtb(j), fcor(j), & - hprime(j) , sigma, theta, oc, oa4, clx4, gamm, elvp, & - up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, xn, yn, umag, & - tautot(j), tauogw(j), taulee(j), drlee, tau_src, & - kxridge, kdswj, krefj, kotr) - -! print *, k_mtb(i), kxw, taumtb(j), fcor(j),hprime(j), ' af ugwp_taub_oro ' -! print *, kdswj, krefj, kotr, ' kdswj, krefj, kotr ' - - - tauf_ogw(j) = tautot(j) - axlwb(j,1:levs) = drlee(1:levs) - - if ( k_mtb(i) > 0) zmtb(j) = zpi(k_mtb(i))- zpi(1) - if ( krefj > 0) zogw(j) = zpi(krefj) - zpi(1) - if ( kdswj > 0) zlwb(j) = zpi(kdswj) - zpi(1) -! if ( k_mtb(i) > 0 .and. zmtb(j) > zogw(j)) print *, ' zmtb > zogw ', zmtb(j), zogw(j) -! -! tau: tauogw, kxw/kxridge ATTENTION c2f2(j) = fcor(j)*fcor(j)/kxridge/kxridge -! - if ( (krefj > 1) .and. ( abs(tauogw(j)) > 0.) ) then -! - call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, kxw, & - fcor(j), kxridge, up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, & - xn, yn, umag, drtau, kdis_oro) -! - else - drtau = 0. - endif - - tauz_ogw(j,1:levs) = tau_src(1:levs) - - r_cpdt = rcpd2/dtp -! -! - do k = 1,levs -! -! project to x-dir & y=dir and do diagnostics -! & apply limiters and output separate oro-effects -! - drlow(k) = drtau(k) + drlee(k) - acc_lim = min(abs(drlow(k)), max_axyz) - drlow(k) = sign(acc_lim, drlow(k)) - - dtaux = drlow(k) * xn + utofd1(k) - dtauy = drlow(k) * yn + vtofd1(k) - - eng0 = up(k)*up(k)+vp(k)*vp(k) - eng1 = 0.0 -! - if (k < k_mtb(i) .and. drmtb(k) /= 0 ) then - loss = 1.0 / (1.0+drmtb(k)*dtp) - mtb_fric = drmtb(k)*loss -! - mbx = mtb_fric * up(k) - mby = mtb_fric * vp(k) -! - ayz(j,k) = -mby !+ ayz(j,k) - axz(j,k) = -mbx !+ axz(j,k) -! - eng1 = eng0*loss*loss +eng1 - dusfc(j) = dusfc(j) - mbx * dp(k) - dvsfc(j) = dvsfc(j) - mby * dp(k) - endif -! - ayz(j,k) = dtauy + ayz(j,k) - axz(j,k) = dtaux + axz(j,k) -! - tx1 = u(j,k) + dtaux*dtp - tx2 = v(j,k) + dtauy*dtp - eng1 = tx1*tx1 + tx2*tx2 + eng1 - - dusfc(j) = dusfc(j) + dtaux * dp(k) - dvsfc(j) = dvsfc(j) + dtauy * dp(k) - - edis(j,k) = max(eng0-eng1, 0.0) * r_cpdt !+ epstofd1(k) - kdis(j,k) = min(kdis_oro(k), max_kdis ) - - enddo -! - dusfc(j) = -rgrav * dusfc(j) - dvsfc(j) = -rgrav * dvsfc(j) -! -! oro-locations -! - enddo ! ipt - oro-loop .... "fraction of Land" in the grid box - deallocate(k_elev, k_mtb, k_ogw, k_lee, k_tofd ) -! - end subroutine ugwp_oro -! -! - subroutine gw_solver_linsatdis(im, levs, dtp, kdt, me, & - taub, klev, if_src, nf_src, nw, ch, naz, spf, xaz, yaz, & - fcor, c2f2, u, v, t, q, prsi, delp, prsl, prslk, phii, phil, & - ax, ay, eps, ked, tauz) - - use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 - use ugwp_common , only : pi, rad_to_deg, deg_to_rad, pi2 - - use cires_ugwp_module, only : kxw, max_kdis, max_axyz, max_eps - use cires_ugwp_module, only : kvg, ktg, krad, kion - - implicit none - integer :: im, levs - integer :: me, kdt, nw, naz, nf_src - real :: dtp - integer, dimension(im) :: klev, if_src - real, dimension(im) :: taub, fcor, c2f2 - - real, dimension(naz) :: xaz, yaz - real, dimension(nw ) :: ch, spf -!========================== - real, dimension(im, levs) :: u, v, t, delp, prsl, prslk, phil, q - real, dimension(im, levs+1) :: prsi , phii -!========================== - real, dimension(im, levs) :: ax, ay, eps, ked, tauz - - real, dimension(levs) :: u1, v1, t1, dp, pmid, zmid, pex1, & - q1, rho - real, dimension(levs+1) :: pint , zint, ui, vi, ti, & - bn2i, bvi, rhoi - integer :: i, j, k, ksrc - real, dimension(nw) :: taub_spect -! real, dimension(levs) :: ax1, ay1, eps1 -! real, dimension(levs+1) :: ked1, tau1 - real :: chm, ss - real, parameter :: dsp = 1./20. - logical :: pfirst=.true. - - save pfirst -128 Format (2x, I4, 4(2x, F10.3)) - -! do i=1, nw -! spf(i) = exp(-Ch(i)*dsp) -! enddo -! ss = sum(spf) -! spf(1:nw) = spf(1:nw)/ss - - if (pfirst ) then - j = 1 - ksrc = klev(j) - taub_spect(1:nw) = spf(1:nw)*taub(j) - print * - chm = 0. - do i=1, nw - write(6, 128) i, spf(i), taub_spect(i)*1.e3, ch(i), ch(i)-chm - chm = ch(i) - enddo - - print * - !pause - endif - - do j=1,im - if (if_src(j) == 1) then -! -! compute GW-effects -! prsi, delp, prsl, prslk, phii, phil -! - do k=1,levs - u1(k) = u(j,k) - v1(k) = v(j,k) - t1(k) = t(j,k) - q1(k) = q(j,k) ! H2O-index -1 in tracer-array - dp(k) = delp(j,k) - - zmid(k) = phil(j,k) * rgrav - pmid(k) = prsl(j,k) -! pex1(k) = prslk(j,k) - enddo - do k=1,levs+1 - zint(k) = phii(j,k) * rgrav - pint(k) = prsi(j,k) - enddo - - call mflow_tauz(levs, u1, v1, t1, q1, dp, zmid, zint, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) -! - ksrc = klev(j) - taub_spect(1:nw) = spf(1:nw)*taub(j)/rhoi(ksrc) - if (pfirst .and. j ==1 ) then - - print *, maxval(taub_spect)/kxw*bvi(ksrc)/ch(1), ' Urms ' - print *, maxval(zmid), minval(zmid) , ' zmid ' - print *, maxval(zint), minval(zint) , ' zint ' - print *, maxval(rho), minval(rho) , ' rho ' - print *, maxval(rhoi), minval(rhoi) , ' rhoi ' - print *, maxval(ti), minval(ti) , ' tempi ' - print *, maxval(ui), minval(ui) , ' ui ' - print *, maxval(u1), minval(u1) , ' ++++ u1 ' - print *, maxval(vi), minval(vi) , ' vi ' - print *, maxval(v1), minval(v1) , ' ++++ v1 ' - print *, maxval(pint), minval(pint) , ' pint ' - !pause - endif -! - call ugwp_lsatdis_naz(levs, ksrc, nw, naz, kxw, taub_spect, & - ch, xaz, yaz, fcor(j), c2f2(j), dp, & - zmid, zint, pmid, pint, rho, ui, vi, ti, & - kvg, ktg, krad, kion, bn2i, bvi, rhoi, & - ax(j,1:levs), ay(j,1:levs), eps(j,1:levs), & - ked(j,1:levs), tauz(j,1:levs)) -! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax1, ay1, eps1, ked1, tau1) - - if (pfirst .and. j ==1 ) then - - print *, maxval(taub_spect)/kxw*bvi(ksrc)/ch(1), ' Urms ' - print *, maxval(zmid), minval(zmid) , ' zmid ' - print *, maxval(zint), minval(zint) , ' zint ' - print *, maxval(rho), minval(rho) , ' rho ' - print *, maxval(rhoi), minval(rhoi) , ' rhoi ' - print *, maxval(ti), minval(ti) , ' rhoi ' - print *, maxval(ui), minval(ui) , ' ui ' - print *, maxval(vi), minval(vi) , ' vi ' - print *, maxval(pint), minval(pint) , ' pint ' - !pause - endif -! -! ax(j,:) = ax1 -! ay(j,:) = ay1 -! eps(j,:) = eps1 -! ked(j,:) = ked1(1:levs) -! tauz(j,:) = tau1(1:levs) - endif - - enddo - pfirst = .false. -! -! spectral solver for discrete spectra of GWs in N-azimiths -! Linear saturation with background dissipation -! - end subroutine gw_solver_linsatdis -! - subroutine gw_solver_wmsdis(im, levs, dtp, kdt, me, & - taub, klev, if_src, nf_src, nw, ch, naz, spf, xaz, yaz, & - fcor, c2f2, u, v, t, q, prsi, delp, prsl, prslk, phii, phil, & - ax, ay, eps, ked, tauz) -! use para_taub, only : tau_ex - use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 - use ugwp_common , only : pi, rad_to_deg, deg_to_rad, pi2 - - use cires_ugwp_module, only : kxw, max_kdis, max_axyz, max_eps - use cires_ugwp_module, only : kvg, ktg, krad, kion - - implicit none - integer :: im, levs, me, kdt, nw, naz, nf_src - real :: dtp - - integer, dimension(im) :: klev, if_src - real, dimension(im) :: taub, fcor, c2f2 - - real, dimension(naz) :: xaz, yaz - real, dimension(nw ) :: ch, spf -!========================== - real, dimension(im, levs) :: u, v, t, delp, prsl, prslk, phil, q - real, dimension(im, levs+1) :: prsi , phii -!========================== - real, dimension(im, levs) :: ax, ay, eps, ked, tauz - - real, dimension(levs) :: u1, v1, t1, dp, pmid, zmid, pex1, q1, rho - real, dimension(levs+1) :: pint , zint, ui, vi, ti, bn2i, bvi, rhoi - - integer :: i, j, k, ksrc - real, dimension(nw) :: taub_spect -! real, dimension(levs) :: ax1, ay1, eps1 -! real,dimension(levs+1) :: ked1, tau1 - real :: tau_ex - -! print *, nf_src, 'nf_src ... gw_solver_wmsdis ' -! print *, if_src, 'if_src ... gw_solver_wmsdis ' - - do j=1,im - if (if_src(j) == 1) then -! -! compute gw-effects -! prsi, delp, prsl, prslk, phii, phil -! - do k=1,levs - u1(k) = u(j,k) - v1(k) = v(j,k) - t1(k) = t(j,k) - q1(k) = q(j,k) ! h2o-index -1 in tracer-array - dp(k) = delp(j,k) - - zmid(k) = phil(j,k) *rgrav - pmid(k) = prsl(j,k) -! pex1(k) = prslk(j,k) - enddo - do k=1,levs+1 - zint(k) = phii(j,k)*rgrav - pint(k) = prsi(j,k) - enddo - - call mflow_tauz(levs, u1, v1, t1, q1, dp, zmid, zint, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) -! -! any extras bkg-arrays -! - ksrc = klev(j) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! -! more work for spectral setup for different "slopes" -! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - tau_ex = taub(j) - taub_spect(1:nw) = spf(1:nw)/rhoi(ksrc) *tau_ex ! check it ....*tau_ex(j) - -! -! call FVS93_ugwps(nw, ch, dch, taub_spect, spnorm, nslope, bn2i(ksrc), bvi(ksrc), bnrho(ksrc)) -! -! print *, ' bf ugwp_wmsdis_naz ksrc', ksrc, zmid(ksrc) - - call ugwp_wmsdis_naz(levs, ksrc, nw, naz, kxw, tau_ex, ch, xaz, yaz, & - fcor(j), c2f2(j), dp, zmid, zint, pmid, pint, & - rho, ui, vi, ti, kvg, ktg, krad, kion, bn2i, bvi, & - rhoi, ax(j,1:levs), ay(j,1:levs), eps(j,1:levs), & - ked(j,1:levs), tauz(j,1:levs)) -! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax1, ay1, eps1, ked1, tau1) - -! print *, ' after ugwp_wmsdis_naz ksrc', ksrc, zint(ksrc) - -! subroutine ugwp_wmsdis_naz(levs, ksrc, nw, naz, kxw, taub_lat, ch, xaz, yaz, & -! fcor, c2f2, dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & -! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax, ay, eps, ked) - -! ax(j,:) = ax1 -! ay(j,:) = ay1 -! eps(j,:) = eps1 -! ked(j,:) = ked1(1:levs) -! tauz(j,:) = tau1(1:levs) - - endif - - enddo -! -! ugwp_wmsdis_naz everything similar to linsat , except spectral saturation -! -! - return - end subroutine gw_solver_wmsdis -! -! - subroutine rf_damp(im, levs, levs_rf, dtp, rfdis, rfdist, u, v, ax, ay, eps) - use ugwp_common, only : rcpd2 - - implicit none - - integer :: im, levs, levs_rf - real :: dtp - real, dimension(levs) :: rfdis, rfdist - real, dimension(im, levs) :: u, v, ax, ay, eps - real :: ud, vd, rdtp - integer :: i, k - - rdtp = 1.0 / dtp - - do k= levs_rf, levs - do i=1,im - ud = rfdis(k)*u(i,k) - vd = rfdis(k)*u(i,k) - ax(i,k) = rfdist(k)*u(i,k) - ay(i,k) = rfdist(k)*v(i,k) - eps(i,k) = rcpd2*(u(i,k)*u(i,k) +v(i,k)*v(i,k) -ud*ud -vd*vd) - enddo - enddo - end subroutine rf_damp -! diff --git a/physics/cires_ugwp_triggers.F90 b/physics/cires_ugwp_triggers.F90 index c345a8e85..4a8b97590 100644 --- a/physics/cires_ugwp_triggers.F90 +++ b/physics/cires_ugwp_triggers.F90 @@ -1,473 +1,5 @@ - subroutine ugwp_triggers - implicit none - write(6,*) ' physics-based triggers for UGWP ' - end subroutine ugwp_triggers -! - SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & - cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - use ugwp_common , only : deg_to_rad - - implicit none - integer :: nx, ny - real :: lon(nx), lat(ny) - real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) - real :: rlatc(ny-1), brcos(ny), brcos2(ny) - real :: earth_r, ra1, ra2, dx, dy, dlat - real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - integer :: j -! -! specify common constants and -! geometric factors to compute deriv-es etc ... -! coriolis coslat tan etc... -! - earth_r = 6370.e3 - ra1 = 1.0 / earth_r - ra2 = ra1*ra1 -! - rlat = lat*deg_to_rad - rlon = lon*deg_to_rad - tanlat = atan(rlat) - cosv = cos(rlat) - dy = rlat(2)-rlat(1) - dx = rlon(2)-rlon(1) -! - do j=1, ny-1 - rlatc(j) = 0.5 * (rlat(j)+rlat(j+1)) - enddo -! - do j=2, ny-1 - brcos(j) = 1.0 / cos(rlat(j))*ra1 - enddo - - brcos(1) = brcos(2) - brcos(ny) = brcos(ny-1) - brcos2 = brcos*brcos -! - dlam1 = brcos / (dx+dx) - dlam2 = brcos2 / (dx*dx) - - dlat = ra1 / (dy+dy) - - divJp = dlat*cosv - divJM = dlat*cosv -! - do j=2, ny-1 - divJp(j) = dlat*cosv(j+1)/cosv(j) - divJM(j) = dlat*cosv(j-1)/cosv(j) - enddo - divJp(1) = divjp(2) !*divjp(1)/divjp(2) - divJp(ny) = divjp(1) - divJM(1) = divjM(2) !*divjM(1)/divjM(2) - divJM(ny) = divjM(1) -! - return - end SUBROUTINE subs_diag_geo -! - subroutine get_xy_pt(V, Vx, Vy, nx, ny, dlam1, dlat) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! compute for each Vert-column: grad(V) -! periodic in X and central diff ... -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - implicit none - integer :: nx, ny - real :: V(nx, ny), dlam1(ny), dlat - real :: Vx(nx, ny), Vy(nx, ny) - integer :: i, j - do i=2, nx-1 - Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) - enddo - Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) - Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) - - do j=2, ny-1 - Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) - enddo - Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) - Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) - - end subroutine get_xy_pt - - subroutine get_xyd_wind( V, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) -! -! compute for each Vert-column: grad(V) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - implicit none - integer :: nx, ny - real :: V(nx, ny), dlam1(ny), dlat - real :: Divjp(ny), Divjm(ny) - real :: Vx(nx, ny), Vy(nx, ny), Vyd(nx, ny) - integer :: i, j - do i=2, nx-1 - Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) - enddo - Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) - Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) - - do j=2, ny-1 - Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) - enddo - Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) - Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) -!~~~~~~~~~~~~~~~~~~~~ -! 1/cos*d(vcos)/dy -!~~~~~~~~~~~~~~~~~~~~ - do j=2, ny-1 - Vyd(:,j) = divJP(j)*V(:,j+1)-V(:, j-1)*divJM(j) - enddo - Vyd(:, 1) = Vyd(:,2) - Vyd(:,ny) = Vyd(:,ny-1) - - end subroutine get_xyd_wind - - subroutine trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS - real, dimension(nx, ny, nz) :: trig3d_fgf -! -! locals -! - real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty - integer :: k, i, j - - real, parameter :: cappa=2./7., pref=1.e5 - real, dimension(nx, ny) :: pt, w1, w2 - - real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) - real :: rlatc(ny-1), brcos(ny), brcos2(ny) - - real :: dx, dy, dlat - real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - - - call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & - cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - - do k=1, nz - w1(:,:) = P3d(:,:,k) - w2(:,:) = T(:,:,k) - - pt = w2*(pref/w1)**cappa - call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) - w1(:,:) = V(:,:, K) - call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) - w1(:,:) = U(:,:, K) - call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) - - trig3d_fgf(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty - - enddo - end subroutine trig3d_fjets - - subroutine trig3d_okubo( nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_okw) - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS - real, dimension(nx, ny, nz) :: trig3d_okw -! -! locals -! - real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty - integer :: k, i, j - - real, parameter :: cappa=2./7., pref=1.e5 - real, dimension(nx, ny) :: pt, w1, w2, d1 - - real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) - real :: rlatc(ny-1), brcos(ny), brcos2(ny) - - real :: dx, dy, dlat - real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - - call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, & - cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - - do k=1, nz - w1(:,:) = P3d(:,:,k) - w2(:,:) = T(:,:,k) - - pt = w2*(pref/w1)**cappa - call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) - w1(:,:) = V(:,:, K) - call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) - w1(:,:) = U(:,:, K) - call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) - - trig3d_okw(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty - w1 = (Ux -Vy)*(Ux-Vy) + (Vx +Uy)*(Vx+Uy) ! S2 - W2 = (Vx - Uyd)*(Vx - Uyd) - D1 = Ux + Vyd - trig3d_okw(:,:,k) = W1 -W2 -! trig3d_okw(:, :, k) =S2 -W2 -! trig3d_okw(:, :, k) =D1*D1 + 4*(Vx*Uyd -Ux*Vyd) ! ocean -! trig3d_okw(:, :, k) = trig3d_okw(:,:,k) + D1*D1 + 2.*D1*sqrt(abs(W1-W2)) ! S2 =W1Ted-luk - enddo - end subroutine trig3d_okubo -! - subroutine trig3d_dconv(nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_conv, & - dcheat3d, precip2d, cld_klevs2d, scheat3d) - - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS - real, dimension(nx, ny, nz) :: trig3d_conv - - real, dimension(nx, ny, nz) :: dcheat3d, scheat3d - real, dimension(nx, ny ) :: precip2d - integer,dimension(nx, ny, 3 ):: cld_klevs2d - integer :: k - end subroutine trig3d_dconv - - subroutine cires_3d_triggers( nx, ny, nz, lon, lat, pmid, & - U, V, W, T, Q, delp, delz, p3d, PS, HS, Hyam, Hybm, Hyai, Hybi, & - trig3d_okw, trig3d_fgf, trig3d_conv, & - dcheat3d, precip2d, cld_klevs2d, scheat3d) - - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) -! -! reversed ??? Hyai, Hybi , pmid -! - real, dimension(nz+2) :: Hyai, Hybi - real, dimension(nz+1) :: Hyam, Hybm -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, W, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS, HS - real, dimension(nx, ny, nz) :: trig3d_okw, trig3d_fgf, trig3d_conv - real, dimension(nx, ny, nz) :: dcheat3d, scheat3d - real, dimension(nx, ny ) :: precip2d - integer,dimension(nx, ny, 3 ):: cld_klevs2d - real :: dzkm, zkm - integer :: k -!================================================================================== -! fgf and OW-triggers -! read PRECIP + SH/DC conv heating + cloud-top-bot-middle from "separate" file !!! -! -!=================================================================================== - - call trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_fgf) - call trig3d_okubo( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_okw) - call trig3d_dconv(nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_conv, & - dcheat3d, precip2d, cld_klevs2d, scheat3d) -!===================================================================================================== -! output of triggers: trig3d_fgf, trig3d_okw, trig3d_conv, cheat3d, precip2d, cld_klevs2d, scheat3d -! -! Bulk momentum flux=/ 0 and levels for launches -! -!===================================================================================================== - 111 format(i6, 4(3x, F8.3), ' trigger-grid ') - - do k=1, nz-1 - zkm = -7.*alog(pmid(k)*1.e-3) - dzkm = zkm +7.*alog(pmid(k+1)*1.e-3) - write(6,111) k, hybi(k), pmid(k), zkm, dzkm !' triggers ' - enddo - - end subroutine cires_3d_triggers -!================================================================================== -! tot-flux launch 0 or 1 # of Launches -! specify time-dep bulk sources: taub, klev, if_src, nf_src -! -!================================================================================== - subroutine get_spectra_tau_convgw & - (nw, im, levs, dcheat, scheat, precip, icld, xlatd, sinlat, coslat,taub, klev, if_src, nf_src) ! -! temporarily can put GEOS-5/MERRA-2 GW-lat dependent function -! - integer :: nw, im, levs - integer,dimension(im,3) :: icld - real, dimension(im, levs) :: dcheat, scheat - real, dimension(im) :: precip, xlatd, sinlat, coslat - real, dimension(im) :: taub - integer, dimension(im) :: klev, if_src - integer :: nf_src -! -! locals - real, parameter :: precip_max = 100. ! mm/day - real, parameter :: tau_amp = 35.e-3 ! 35 mPa - - integer :: i, k, klow, ktop, kmid - real :: dtot, dmax, daver -! - nf_src = 0 - if_src(1:im) = 0 - taub(1:im) = 0.0 - do i=1, im - klow = icld(i,1) - ktop = icld(i,2) - kmid= icld(i,3) - if (klow == -99 .and. ktop == -99) then - cycle - else - klev(i) = ktop - k = klow - klev(i) = k - dmax = abs(dcheat(i,k) + scheat(i,k)) - do k=klow+1, ktop - dtot =abs(dcheat(i,k) + scheat(i,k)) - if ( dtot > dmax) then - klev(i) = k - dmax = dtot - endif - enddo -! -! klev as max( dcheat(i,k) + scheat) -! vertical width of conv-heating -! -! counts/triiger=1 & taub(i) -! - nf_src = nf_src +1 - if_src(i) = 1 - taub(i) = tau_amp* precip(i)/precip_max*coslat(i) - endif - - enddo -! -! 100 mb launch and MERRA-2 slat-forcing -! - call Slat_geos5(im, xlatd, taub) - nf_src =im - do i=1, im - if_src(i) = 1 - klev(i) = 127-45 - enddo - -! with info on precip/clouds/dc_heat create Bulk -! taub(im), klev(im) -! -! print *, ' get_spectra_tau_convgw ' - end subroutine get_spectra_tau_convgw -! - subroutine get_spectra_tau_nstgw(nw, im, levs, trig_fgf, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) - integer :: nw, im, levs - real, dimension(im, levs) :: trig_fgf -! real, dimension(im, levs+1) :: pint - real, dimension(im) :: xlatd, sinlat, coslat - real, dimension(im) :: taub - integer, dimension(im) :: klev, if_src - integer :: nf_src -! locals - real, parameter :: tlim_fgf = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent - real, parameter :: tau_amp = 35.e-3 ! 35 mPa - real, parameter :: pmax = 750.e2, pmin = 100.e2 - integer, parameter :: klow =127-92, ktop=127-45 - integer, parameter :: kwidth = ktop-klow+1 - integer :: i, k, kex - real :: dtot, dmax, daver - real :: fnorm, tau_min - nf_src = 0 - if_src(1:im) = 0 - taub(1:im) = 0.0 - fnorm = 1.0 / float(kwidth) - tau_min = tau_amp*fnorm - do i=1, im -! -! only trop-c fjets so find max(trig_fgf) => klev -! use abs-values to scale tau_amp -! - - k = klow - klev(i) = k - dmax = abs(trig_fgf(i,k)) - kex = 0 - if (dmax >= tlim_fgf) kex = kex+1 - do k=klow+1, ktop - dtot = abs(trig_fgf(i,k)) - if (dtot >= tlim_fgf) kex = kex+1 - if ( dtot > dmax) then - klev(i) = k - dmax = dtot - endif - enddo - - if (dmax .ge. tlim_fgf) then - nf_src = nf_src +1 - if_src(i) = 1 - taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) - endif - - enddo -! -! print *, ' get_spectra_tau_nstgw ' - call Slat_geos5(im, xlatd, taub) - nf_src =im - do i=1, im - if_src(i) = 1 - klev(i) = 127-45 - enddo -! - end subroutine get_spectra_tau_nstgw -! - subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) - integer :: nw, im, levs - real, dimension(im, levs) :: trig_okw -! real, dimension(im, levs+1) :: pint - real, dimension(im) :: xlatd, sinlat, coslat - real, dimension(im) :: taub - integer, dimension(im) :: klev, if_src - integer :: nf_src -! locals - real, parameter :: tlim_okw = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent - real, parameter :: tau_amp = 35.e-3 ! 35 mPa - real, parameter :: pmax = 750.e2, pmin = 100.e2 - integer, parameter :: klow =127-92, ktop=127-45 - integer, parameter :: kwidth = ktop-klow+1 - integer :: i, k, kex - real :: dtot, dmax, daver - real :: fnorm, tau_min - - nf_src = 0 - if_src(1:im) = 0 - taub(1:im) = 0.0 - fnorm = 1./float(kwidth) - tau_min = tau_amp*fnorm - print *, ' get_spectra_tau_okwgw ' - do i=1, im - k = klow - klev(i) = k - dmax = abs(trig_okw(i,k)) - kex = 0 - if (dmax >= tlim_okw) kex = kex+1 - do k=klow+1, ktop - dtot = abs(trig_okw(i,k)) - if (dtot >= tlim_fgf ) kex = kex+1 - if ( dtot > dmax) then - klev(i) = k - dmax = dtot - endif - enddo -! - if (dmax >= tlim_okw) then - nf_src = nf_src + 1 - if_src(i) = 1 - taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) - endif - - enddo - print *, ' get_spectra_tau_okwgw ' - end subroutine get_spectra_tau_okw -! -! -! -!>\ingroup cires_ugwp_run -!> @{ -!! -!! - subroutine slat_geos5_tamp(im, tau_amp, xlatdeg, tau_gw) + subroutine slat_geos5_tamp_v0(im, tau_amp, xlatdeg, tau_gw) !================= ! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* !================= @@ -498,9 +30,9 @@ subroutine slat_geos5_tamp(im, tau_amp, xlatdeg, tau_gw) tau_gw(i) = tau_amp*flat_gw enddo ! - end subroutine slat_geos5_tamp + end subroutine slat_geos5_tamp_v0 - subroutine slat_geos5(im, xlatdeg, tau_gw) + subroutine slat_geos5_v0(im, xlatdeg, tau_gw) !================= ! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* !================= @@ -537,9 +69,10 @@ subroutine slat_geos5(im, xlatdeg, tau_gw) tau_gw(i) = tau_amp*flat_gw enddo ! - end subroutine slat_geos5 - subroutine init_nazdir(naz, xaz, yaz) - use ugwp_common , only : pi2 + end subroutine slat_geos5_v0 +! + subroutine init_nazdir_v0(naz, xaz, yaz) + use ugwp_common_v0 , only : pi2 implicit none integer :: naz real, dimension(naz) :: xaz, yaz @@ -563,4 +96,4 @@ subroutine init_nazdir(naz, xaz, yaz) xaz(4) = 0.0 yaz(4) =-1.0 !S endif - end subroutine init_nazdir + end subroutine init_nazdir_v0 diff --git a/physics/cires_ugwp_triggers_v1.F90 b/physics/cires_ugwp_triggers_v1.F90 deleted file mode 100644 index 8cfd57cb7..000000000 --- a/physics/cires_ugwp_triggers_v1.F90 +++ /dev/null @@ -1,584 +0,0 @@ -module cires_ugwp_triggers_v1 - - -contains - - - subroutine ugwp_triggers - implicit none - write(6,*) ' physics-based triggers for UGWP ' - end subroutine ugwp_triggers -! - SUBROUTINE subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, con_pi, earth_r, & - cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - - implicit none - integer :: nx, ny - real :: lon(nx), lat(ny) - real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) - real :: rlatc(ny-1), brcos(ny), brcos2(ny) - real :: ra1, ra2, dx, dy, dlat - real :: con_pi, earth_r - real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - integer :: j - real :: deg_to_rad -! -! specify common constants and -! geometric factors to compute deriv-es etc ... -! coriolis coslat tan etc... -! - deg_to_rad = con_pi/180.0 - ra1 = 1.0 / earth_r - ra2 = ra1*ra1 -! - rlat = lat*deg_to_rad - rlon = lon*deg_to_rad - tanlat = atan(rlat) - cosv = cos(rlat) - dy = rlat(2)-rlat(1) - dx = rlon(2)-rlon(1) -! - do j=1, ny-1 - rlatc(j) = 0.5 * (rlat(j)+rlat(j+1)) - enddo -! - do j=2, ny-1 - brcos(j) = 1.0 / cos(rlat(j))*ra1 - enddo - - brcos(1) = brcos(2) - brcos(ny) = brcos(ny-1) - brcos2 = brcos*brcos -! - dlam1 = brcos / (dx+dx) - dlam2 = brcos2 / (dx*dx) - - dlat = ra1 / (dy+dy) - - divJp = dlat*cosv - divJM = dlat*cosv -! - do j=2, ny-1 - divJp(j) = dlat*cosv(j+1)/cosv(j) - divJM(j) = dlat*cosv(j-1)/cosv(j) - enddo - divJp(1) = divjp(2) !*divjp(1)/divjp(2) - divJp(ny) = divjp(1) - divJM(1) = divjM(2) !*divjM(1)/divjM(2) - divJM(ny) = divjM(1) -! - return - end SUBROUTINE subs_diag_geo -! - subroutine get_xy_pt(V, Vx, Vy, nx, ny, dlam1, dlat) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! compute for each Vert-column: grad(V) -! periodic in X and central diff ... -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - implicit none - integer :: nx, ny - real :: V(nx, ny), dlam1(ny), dlat - real :: Vx(nx, ny), Vy(nx, ny) - integer :: i, j - do i=2, nx-1 - Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) - enddo - Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) - Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) - - do j=2, ny-1 - Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) - enddo - Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) - Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) - - end subroutine get_xy_pt - - subroutine get_xyd_wind( V, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) -! -! compute for each Vert-column: grad(V) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - implicit none - integer :: nx, ny - real :: V(nx, ny), dlam1(ny), dlat - real :: Divjp(ny), Divjm(ny) - real :: Vx(nx, ny), Vy(nx, ny), Vyd(nx, ny) - integer :: i, j - do i=2, nx-1 - Vx(i,:) = dlam1(:)*(V(i+1,:)-V(i-1,:)) - enddo - Vx(1,:) = dlam1(:)*(V(2,:)-V(nx,:)) - Vx(nx,:) = dlam1(:)*(V(1,:)-V(nx-1,:)) - - do j=2, ny-1 - Vy(:,j) = dlat*(V(:,j+1)-V(:, j-1)) - enddo - Vy(:, 1) = dlat*2.*(V(:,2)-V(:,1)) - Vy(:,ny) = dlat*2.*(V(:,ny)-V(:,ny-1)) -!~~~~~~~~~~~~~~~~~~~~ -! 1/cos*d(vcos)/dy -!~~~~~~~~~~~~~~~~~~~~ - do j=2, ny-1 - Vyd(:,j) = divJP(j)*V(:,j+1)-V(:, j-1)*divJM(j) - enddo - Vyd(:, 1) = Vyd(:,2) - Vyd(:,ny) = Vyd(:,ny-1) - - end subroutine get_xyd_wind - - subroutine trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, & - con_pi, con_rerth, pmid, trig3d_fgf) - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) - real :: con_pi, con_rerth -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS - real, dimension(nx, ny, nz) :: trig3d_fgf -! -! locals -! - real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty - integer :: k, i, j - - real, parameter :: cappa=2./7., pref=1.e5 - real, dimension(nx, ny) :: pt, w1, w2 - - real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) - real :: rlatc(ny-1), brcos(ny), brcos2(ny) - - real :: dx, dy, dlat - real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - - - call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, con_pi, con_rerth, & - cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - - do k=1, nz - w1(:,:) = P3d(:,:,k) - w2(:,:) = T(:,:,k) - - pt = w2*(pref/w1)**cappa - call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) - w1(:,:) = V(:,:, K) - call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) - w1(:,:) = U(:,:, K) - call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) - - trig3d_fgf(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty - - enddo - end subroutine trig3d_fjets - - subroutine trig3d_okubo( nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_okw) - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) - real :: con_pi, con_rerth -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS - real, dimension(nx, ny, nz) :: trig3d_okw -! -! locals -! - real, dimension(nx, ny) :: ux, uy, uyd, vy, vx, vyd, ptx, pty - integer :: k, i, j - - real, parameter :: cappa=2./7., pref=1.e5 - real, dimension(nx, ny) :: pt, w1, w2, d1 - - real :: rlon(nx), rlat(ny) , cosv(ny), tanlat(ny) - real :: rlatc(ny-1), brcos(ny), brcos2(ny) - - real :: dx, dy, dlat - real :: dlam1(ny), dlam2(ny), divJp(ny), divJm(ny) - - call subs_diag_geo(nx, ny, lat, lon, rlat, rlon, dy, dx, con_pi, con_rerth, & - cosv, rlatc, brcos, brcos2, dlam1, dlam2, dlat, divJp, divJm) - - do k=1, nz - w1(:,:) = P3d(:,:,k) - w2(:,:) = T(:,:,k) - - pt = w2*(pref/w1)**cappa - call get_xy_pt(Pt, ptx, pty, nx, ny, dlam1, dlat) - w1(:,:) = V(:,:, K) - call get_xyd_wind( w1, Vx, Vy, Vyd, nx, ny, dlam1, dlat, divJp, divJm) - w1(:,:) = U(:,:, K) - call get_xyd_wind( w1, Ux, Uy, Uyd, nx, ny, dlam1, dlat, divJp, divJm) - - trig3d_okw(:,:,k) = -ptx*ptx*ux - pty*pty*vy -(vx+uyd)*ptx*pty - w1 = (Ux -Vy)*(Ux-Vy) + (Vx +Uy)*(Vx+Uy) ! S2 - W2 = (Vx - Uyd)*(Vx - Uyd) - D1 = Ux + Vyd - trig3d_okw(:,:,k) = W1 -W2 -! trig3d_okw(:, :, k) =S2 -W2 -! trig3d_okw(:, :, k) =D1*D1 + 4*(Vx*Uyd -Ux*Vyd) ! ocean -! trig3d_okw(:, :, k) = trig3d_okw(:,:,k) + D1*D1 + 2.*D1*sqrt(abs(W1-W2)) ! S2 =W1Ted-luk - enddo - end subroutine trig3d_okubo -! - subroutine trig3d_dconv(nx, ny, nz, U, V, T, Q, P3d, PS, delp, delz, lon, lat, pmid, trig3d_conv, & - dcheat3d, precip2d, cld_klevs2d, scheat3d) - - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS - real, dimension(nx, ny, nz) :: trig3d_conv - - real, dimension(nx, ny, nz) :: dcheat3d, scheat3d - real, dimension(nx, ny ) :: precip2d - integer,dimension(nx, ny, 3 ):: cld_klevs2d - integer :: k - end subroutine trig3d_dconv - - subroutine cires_3d_triggers( nx, ny, nz, lon, lat, pmid, & - U, V, W, T, Q, delp, delz, p3d, PS, HS, Hyam, Hybm, Hyai, Hybi, & - con_pi, con_rerth, trig3d_okw, trig3d_fgf, trig3d_conv, & - dcheat3d, precip2d, cld_klevs2d, scheat3d) - - implicit none - integer :: nx, ny, nz - real :: lon(nx), lat(ny) - real :: con_pi, con_rerth -! -! reversed ??? Hyai, Hybi , pmid -! - real, dimension(nz+2) :: Hyai, Hybi - real, dimension(nz+1) :: Hyam, Hybm -! - real, dimension(nz) :: pmid - real, dimension(nx, ny, nz) :: U, V, W, T, Q, delp, delz, p3d - real, dimension(nx, ny ) :: PS, HS - real, dimension(nx, ny, nz) :: trig3d_okw, trig3d_fgf, trig3d_conv - real, dimension(nx, ny, nz) :: dcheat3d, scheat3d - real, dimension(nx, ny ) :: precip2d - integer,dimension(nx, ny, 3 ):: cld_klevs2d - real :: dzkm, zkm - integer :: k -!================================================================================== -! fgf and OW-triggers -! read PRECIP + SH/DC conv heating + cloud-top-bot-middle from "separate" file !!! -! -!=================================================================================== - - call trig3d_fjets( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, & - con_pi, con_rerth, pmid, trig3d_fgf) - call trig3d_okubo( nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_okw) - call trig3d_dconv(nx, ny, nz, U, V, T, Q, P3D, PS, delp, delz, lon, lat, pmid, trig3d_conv, & - dcheat3d, precip2d, cld_klevs2d, scheat3d) -!===================================================================================================== -! output of triggers: trig3d_fgf, trig3d_okw, trig3d_conv, cheat3d, precip2d, cld_klevs2d, scheat3d -! -! Bulk momentum flux=/ 0 and levels for launches -! -!===================================================================================================== - 111 format(i6, 4(3x, F8.3), ' trigger-grid ') - - do k=1, nz-1 - zkm = -7.*alog(pmid(k)*1.e-3) - dzkm = zkm +7.*alog(pmid(k+1)*1.e-3) - write(6,111) k, hybi(k), pmid(k), zkm, dzkm !' triggers ' - enddo - - end subroutine cires_3d_triggers -!================================================================================== -! tot-flux launch 0 or 1 # of Launches -! specify time-dep bulk sources: taub, klev, if_src, nf_src -! -!================================================================================== - subroutine get_spectra_tau_convgw & - (nw, im, levs, dcheat, scheat, precip, icld, xlatd, sinlat, coslat,taub, klev, if_src, nf_src) -! -! temporarily can put GEOS-5/MERRA-2 GW-lat dependent function -! - integer :: nw, im, levs - integer,dimension(im,3) :: icld - real, dimension(im, levs) :: dcheat, scheat - real, dimension(im) :: precip, xlatd, sinlat, coslat - real, dimension(im) :: taub - integer, dimension(im) :: klev, if_src - integer :: nf_src -! -! locals - real, parameter :: precip_max = 100. ! mm/day - real, parameter :: tau_amp = 35.e-3 ! 35 mPa - - integer :: i, k, klow, ktop, kmid - real :: dtot, dmax, daver -! - nf_src = 0 - if_src(1:im) = 0 - taub(1:im) = 0.0 - do i=1, im - klow = icld(i,1) - ktop = icld(i,2) - kmid= icld(i,3) - if (klow == -99 .and. ktop == -99) then - cycle - else - klev(i) = ktop - k = klow - klev(i) = k - dmax = abs(dcheat(i,k) + scheat(i,k)) - do k=klow+1, ktop - dtot =abs(dcheat(i,k) + scheat(i,k)) - if ( dtot > dmax) then - klev(i) = k - dmax = dtot - endif - enddo -! -! klev as max( dcheat(i,k) + scheat) -! vertical width of conv-heating -! -! counts/triiger=1 & taub(i) -! - nf_src = nf_src +1 - if_src(i) = 1 - taub(i) = tau_amp* precip(i)/precip_max*coslat(i) - endif - - enddo -! -! 100 mb launch and MERRA-2 slat-forcing -! - call Slat_geos5(im, xlatd, taub) - nf_src =im - do i=1, im - if_src(i) = 1 - klev(i) = 127-45 - enddo - -! with info on precip/clouds/dc_heat create Bulk -! taub(im), klev(im) -! -! print *, ' get_spectra_tau_convgw ' - end subroutine get_spectra_tau_convgw -! - subroutine get_spectra_tau_nstgw(nw, im, levs, trig_fgf, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) - integer :: nw, im, levs - real, dimension(im, levs) :: trig_fgf -! real, dimension(im, levs+1) :: pint - real, dimension(im) :: xlatd, sinlat, coslat - real, dimension(im) :: taub - integer, dimension(im) :: klev, if_src - integer :: nf_src -! locals - real, parameter :: tlim_fgf = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent - real, parameter :: tau_amp = 35.e-3 ! 35 mPa - real, parameter :: pmax = 750.e2, pmin = 100.e2 - integer, parameter :: klow =127-92, ktop=127-45 - integer, parameter :: kwidth = ktop-klow+1 - integer :: i, k, kex - real :: dtot, dmax, daver - real :: fnorm, tau_min - nf_src = 0 - if_src(1:im) = 0 - taub(1:im) = 0.0 - fnorm = 1.0 / float(kwidth) - tau_min = tau_amp*fnorm - do i=1, im -! -! only trop-c fjets so find max(trig_fgf) => klev -! use abs-values to scale tau_amp -! - - k = klow - klev(i) = k - dmax = abs(trig_fgf(i,k)) - kex = 0 - if (dmax >= tlim_fgf) kex = kex+1 - do k=klow+1, ktop - dtot = abs(trig_fgf(i,k)) - if (dtot >= tlim_fgf) kex = kex+1 - if ( dtot > dmax) then - klev(i) = k - dmax = dtot - endif - enddo - - if (dmax .ge. tlim_fgf) then - nf_src = nf_src +1 - if_src(i) = 1 - taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) - endif - - enddo -! -! print *, ' get_spectra_tau_nstgw ' - call Slat_geos5(im, xlatd, taub) - nf_src =im - do i=1, im - if_src(i) = 1 - klev(i) = 127-45 - enddo -! - end subroutine get_spectra_tau_nstgw -! - subroutine get_spectra_tau_okw(nw, im, levs, trig_okw, xlatd, sinlat, coslat, taub, klev, if_src, nf_src) - integer :: nw, im, levs - real, dimension(im, levs) :: trig_okw -! real, dimension(im, levs+1) :: pint - real, dimension(im) :: xlatd, sinlat, coslat - real, dimension(im) :: taub - integer, dimension(im) :: klev, if_src - integer :: nf_src -! locals - real, parameter :: tlim_okw = 100. ! trig_fgf > tlim_fgf, launch waves should scale-dependent - real, parameter :: tau_amp = 35.e-3 ! 35 mPa - real, parameter :: pmax = 750.e2, pmin = 100.e2 - integer, parameter :: klow =127-92, ktop=127-45 - integer, parameter :: kwidth = ktop-klow+1 - integer :: i, k, kex - real :: dtot, dmax, daver - real :: fnorm, tau_min - - nf_src = 0 - if_src(1:im) = 0 - taub(1:im) = 0.0 - fnorm = 1./float(kwidth) - tau_min = tau_amp*fnorm - print *, ' get_spectra_tau_okwgw ' - do i=1, im - k = klow - klev(i) = k - dmax = abs(trig_okw(i,k)) - kex = 0 - if (dmax >= tlim_okw) kex = kex+1 - do k=klow+1, ktop - dtot = abs(trig_okw(i,k)) - if (dtot >= tlim_fgf ) kex = kex+1 - if ( dtot > dmax) then - klev(i) = k - dmax = dtot - endif - enddo -! - if (dmax >= tlim_okw) then - nf_src = nf_src + 1 - if_src(i) = 1 - taub(i) = tau_min*float(kex) !* precip(i)/precip_max*coslat(i) - endif - - enddo - print *, ' get_spectra_tau_okwgw ' - end subroutine get_spectra_tau_okw -! -! -! -!>\ingroup cires_ugwp_run -!> @{ -!! -!! - subroutine slat_geos5_tamp_v1(im, tau_amp, xlatdeg, tau_gw) -!================= -! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* -!================= - implicit none - integer :: im - real :: tau_amp, xlatdeg(im), tau_gw(im) - real :: latdeg, flat_gw, tem - integer :: i - -! -! if-lat -! - do i=1, im - latdeg = abs(xlatdeg(i)) - if (latdeg < 15.3) then - tem = (latdeg-3.0) / 8.0 - flat_gw = 0.75 * exp(-tem * tem) - if (flat_gw < 1.2 .and. latdeg <= 3.0) flat_gw = 0.75 - elseif (latdeg < 31.0 .and. latdeg >= 15.3) then - flat_gw = 0.10 - elseif (latdeg < 60.0 .and. latdeg >= 31.0) then - tem = (latdeg-60.0) / 23.0 - flat_gw = 0.50 * exp(- tem * tem) - elseif (latdeg >= 60.0) then - tem = (latdeg-60.0) / 70.0 - flat_gw = 0.50 * exp(- tem * tem) - endif - tau_gw(i) = tau_amp*flat_gw - enddo -! - end subroutine slat_geos5_tamp_v1 - - subroutine slat_geos5(im, xlatdeg, tau_gw) -!================= -! GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* -!================= - implicit none - integer :: im - real :: xlatdeg(im) - real :: tau_gw(im) - real :: latdeg - real, parameter :: tau_amp = 100.e-3 - real :: trop_gw, flat_gw - integer :: i -! -! if-lat -! - trop_gw = 0.75 - do i=1, im - latdeg = xlatdeg(i) - if (-15.3 < latdeg .and. latdeg < 15.3) then - flat_gw = trop_gw*exp(-( (abs(latdeg)-3.)/8.0)**2) - if (flat_gw < 1.2 .and. abs(latdeg) <= 3.) flat_gw = trop_gw - else if (latdeg > -31. .and. latdeg <= -15.3) then - flat_gw = 0.10 - else if (latdeg < 31. .and. latdeg >= 15.3) then - flat_gw = 0.10 - else if (latdeg > -60. .and. latdeg <= -31.) then - flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) - else if (latdeg < 60. .and. latdeg >= 31.) then - flat_gw = 0.50*exp(-((abs(latdeg)-60.)/23.)**2) - else if (latdeg <= -60.) then - flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) - else if (latdeg >= 60.) then - flat_gw = 0.50*exp(-((abs(latdeg)-60.)/70.)**2) - end if - tau_gw(i) = tau_amp*flat_gw - enddo -! - end subroutine slat_geos5 - subroutine init_nazdir(con_pi, naz, xaz, yaz) - implicit none - real :: con_pi - integer :: naz - real, dimension(naz) :: xaz, yaz - integer :: idir - real :: phic, drad - real :: pi2 - pi2 = 2.0*con_pi - drad = pi2/float(naz) - if (naz.ne.4) then - do idir =1, naz - Phic = drad*(float(idir)-1.0) - xaz(idir) = cos(Phic) - yaz(idir) = sin(Phic) - enddo - else -! if (naz.eq.4) then - xaz(1) = 1.0 !E - yaz(1) = 0.0 - xaz(2) = 0.0 - yaz(2) = 1.0 !N - xaz(3) =-1.0 !W - yaz(3) = 0.0 - xaz(4) = 0.0 - yaz(4) =-1.0 !S - endif - end subroutine init_nazdir - - -end module cires_ugwp_triggers_v1 - diff --git a/physics/cires_ugwp_utils.F90 b/physics/cires_ugwp_utils.F90 deleted file mode 100644 index 63a5b3238..000000000 --- a/physics/cires_ugwp_utils.F90 +++ /dev/null @@ -1,152 +0,0 @@ -! - subroutine um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, bn2, uhm, vhm, bn2hm, rhohm) -! - use ugwp_common, only : bnv2min, grav, gocp, fv, rdi - implicit none -! -! mass-averaged variables between klow-ktop -! - integer, intent(in) :: nz, klow, ktop - real, dimension(nz), intent(in) :: up, vp, tp, qp, dp, zpm, pmid - real, dimension(nz+1), intent(in) :: pint, zpi - real, dimension(nz), intent(out) :: bn2 - - real :: vtj, rhok, bnv2, rdz - real :: vtkp, vtk, dzp, rhm,dphm - - real, intent(out) :: uhm, vhm, bn2hm, rhohm - - integer :: k -! - dphm = 0.0 !pint(k+1)-pint(k)) - - uhm = 0.0 ! dphm*u1(k) - vhm = 0.0 ! dphm*v1(k) - rhm = 0.0 ! - bn2hm = 0.0 ! -! - do k=klow, ktop - vtj = tp(k) * (1.+fv*qp(k)) - vtk = vtj - vtkp = tp(k+1) * (1.+fv*qp(k+1)) - rhok = rdi * pmid(k) / vtj ! density kg/m**3 - rdz = 1.0 / (zpm(k+1)-zpm(k)) -! dry -! bnv2 = grav * (rdz * ( tp(k+1)-tp(k)) +grcp) /tp(k) -! -! wet -! - bnv2 = grav * (rdz * ( vtkp- vtk) +gocp) /vtk -! if (bnv2 < 0) print *, k, bnv2, ' bnv2 < 0 ', klow, ktop - bnv2 = max(bnv2, bnv2min ) - dzp = pint(k+1)-pint(k) - - dphm = dphm + dzp - uhm = uhm + up(k)*dzp - vhm = vhm + vp(k)*dzp - rhm = rhm + rhok*dzp - bn2hm = bn2hm + bnv2 * dzp - bn2(k) = bnv2 - enddo - - uhm = uhm/dphm - vhm = vhm/dphm - rhm = rhm/dphm - bn2hm = bn2hm/dphm - rhohm = rhm/dphm -! -! print *, ' MF-BV ', bn2hm, bn2(ktop), bn2(klow) -! - end subroutine um_flow -! -! - subroutine mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) - - use ugwp_common, only : bnv2min, grav, gocp, fv, rdi - - implicit none - - integer :: levs - real, dimension(levs) :: up, vp, tp, qp, dp, zpm, pmid - real, dimension(levs+1) :: pint, rho, zpi - real, dimension(levs) :: zdelpi, zdelpm - real :: zul, bvl - real, dimension(levs+1) :: ui, vi, bn2i, bvi, rhoi, ti, qi - - real :: vtj, rhok, bnv2, rdz - real :: vtkp, vtk, dzp - real :: vtji - integer :: k -! -! get interface values from surf to top -! - do k=2,levs - vi(k) = 0.5 *(vp(k-1) + vp(k)) - ui(k) = 0.5 *(up(k-1) + up(k)) - ti(k) = 0.5 *(tp(k-1) + tp(k)) - qi(k) = 0.5 *(qp(k-1) + qp(k)) - enddo - - k=1 - ti(k) = tp(k) - ui(k) = up(k) - vi(k) = vp(k) - qi(k) = qp(k) - k= levs - ti(k+1) = tp(k) - ui(k+1) = up(k) - vi(k+1) = vp(k) - qi(k+1)=qp(k) - - do k=1,levs-1 - vtj = tp(k) * (1.+fv*qp(k)) - vtji = ti(k) * (1.+fv*qi(k)) - rho(k) = rdi * pmid(k) / vtj ! density kg/m**3 - rhoi(k) = rdi * pint(k) / vtji - vtk = vtj - vtkp = tp(k+1) * (1.+fv*qp(k+1)) - rdz = 1. / ( zpm(k+1)-zpm(k)) - bnv2 = grav * (rdz * ( vtkp- vtk) +gocp) /vtji - bn2i(k) = max(bnv2, bnv2min ) - bvi(k) = sqrt( bn2i(k) ) - vtk = vtkp - enddo - k = levs - vtj = tp(k) ! * (1.+fv*qp(k)) - vtji = ti(k) !* (1.+fv*qi(k)) - rho(k) = rdi * pmid(k) / vtj - rhoi(k) = rdi * pint(k) / vtji - bn2i(k) = bn2i(k-1) - bvi(k) = sqrt( bn2i(k) ) - k = levs+1 - rhoi(k) = rdi * pint(k) / ti(k) - bn2i(k) = bn2i(k-1) - bvi(k) = sqrt( bn2i(k) ) -! do k=1,levs -! write(6, 121) k, zpm(k)*1.e-3, zpi(k)*1.e-3, bvi(k), rho(k), rhoi(k) -! enddo - 121 format(i5, 2x, 3(2x, F10.3), 2(2x, E10.3)) - - end subroutine mflow_tauz - -! - subroutine get_unit_vector(u, v, u_n, v_n, mag) - implicit none - real, intent(in) :: u, v - real, intent(out) :: u_n, v_n, mag -! - - mag = sqrt(u*u + v*v) - - if (mag > 0.0) then - u_n = u/mag - v_n = v/mag - else - u_n = 0. - v_n = 0. - end if - - end subroutine get_unit_vector -! diff --git a/physics/cires_ugwpv1_triggers.F90 b/physics/cires_ugwpv1_triggers.F90 index 3c42e573b..838ead1ee 100644 --- a/physics/cires_ugwpv1_triggers.F90 +++ b/physics/cires_ugwpv1_triggers.F90 @@ -11,42 +11,6 @@ module cires_ugwpv1_triggers !> @{ !! !! - subroutine slat_geos5_tamp_v0(im, tau_amp, xlatdeg, tau_gw) -!================= -! V0: GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* -!================= - implicit none - integer :: im - real(kind=kind_phys) :: tau_amp, xlatdeg(im), tau_gw(im) - real(kind=kind_phys) :: latdeg, flat_gw, tem - integer :: i - -! -! if-lat -! - do i=1, im - latdeg = abs(xlatdeg(i)) - if (latdeg < 15.3) then - tem = (latdeg-3.0) / 8.0 - flat_gw = 0.75 * exp(-tem * tem) - if (flat_gw < 1.2 .and. latdeg <= 3.0) flat_gw = 0.75 - elseif (latdeg < 31.0 .and. latdeg >= 15.3) then - flat_gw = 0.10 - elseif (latdeg < 60.0 .and. latdeg >= 31.0) then - tem = (latdeg-60.0) / 23.0 - flat_gw = 0.50 * exp(- tem * tem) - elseif (latdeg >= 60.0) then - tem = (latdeg-60.0) / 70.0 - flat_gw = 0.50 * exp(- tem * tem) - endif - tau_gw(i) = tau_amp*flat_gw - enddo -! - end subroutine slat_geos5_tamp_v0 -! - - -! subroutine slat_geos5_tamp_v1(im, tau_amp, xlatdeg, tau_gw) !================= ! V1: GEOS-5 & MERRA-2 lat-dependent GW-source function tau(z=Zlaunch) =rho* diff --git a/physics/cires_vert_lsatdis.F90 b/physics/cires_vert_lsatdis.F90 deleted file mode 100644 index 362bed8ef..000000000 --- a/physics/cires_vert_lsatdis.F90 +++ /dev/null @@ -1,524 +0,0 @@ - subroutine ugwp_lsatdis_naz(levs, ksrc, nw, naz, kxw, taub_spect, ch, xaz, yaz, & - fcor, c2f2, dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & - kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax, ay, eps, ked, tau1) -! -! call ugwp_lsatdis_naz(levs, ksrc, nw, naz, kxw, taub_spect, ch, xaz, yaz, & -! fcor(j), c2f2(j), dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & -! kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax1, ay1, eps1, ked1) - use ugwp_common, only : rcpd, grav, rgrav - implicit none -! - integer :: levs, nw, naz, ksrc - real :: kxw - real, dimension(nw) :: taub_spect, ch - real, dimension(naz) :: xaz, yaz - real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi, zint, pint - real, dimension(levs ) :: dp, rho, pmid, zmid - real :: fcor, c2f2 - real, dimension(levs+1) :: kvg, ktg, kion, krad, kmol - -! output/locals - real, dimension(levs ) :: ax, ay, eps - real, dimension(levs+1) :: ked , tau1 - - real, dimension(levs+1 ) :: uaz - real, dimension(levs, naz ) :: epsd - real, dimension(levs+1, naz ) :: atau, kedd - real, dimension(levs+1 ) :: taux, tauy - real, dimension(levs ) :: dzirho , dzpi - real :: usrc -! - integer :: iaz, k -! - atau=0.0 ; epsd=0.0 ; kedd=0.0 - - do k=1,levs - dzpi(k) = -(pint(k+1)-pint(k))/rho(k)*rgrav - dzirho(k) = 1./rho(k)/dzpi(k) ! grav/abs(dp(k)) still hydrostatic "UGWP" - enddo - - LOOP_IAZ: do iaz =1, naz - usrc = ui(ksrc)*xaz(iaz) +vi(ksrc)*yaz(iaz) - do k=1,levs+1 - uaz(k) =ui(k)*xaz(iaz) +vi(k)*yaz(iaz) -usrc - enddo -! -! if (nw .le. 4) call stochastic ..ugwp_lsatdis_az1 only 4-waves ch_ngw1, fuw_ngw1, eff_ngw1=1 -! -! multi-wave scheme -! - if (nw .gt. 4) then - call ugwp_lsatdis_az1(levs, ksrc, nw, kxw, ch, taub_spect, & - fcor, c2f2, zmid, zint, rho, uaz, ti, bn2i, bvi, rhoi, dzirho, dzpi, & - kvg, ktg, krad, kion, kmol, epsd(:, iaz), kedd(:,iaz), atau(:, iaz) ) - - endif -! - ENDDO LOOP_IAZ ! Azimuth of GW propagation directions -! -! sum over azimuth and project aTau(z, iza) =>(taux and tauy) -! for scalars for "wave-drag vector" -! - eps =0. ; ked =0. - do k=ksrc, levs - eps(k) = sum(epsd(k,:))*rcpd - enddo - - do k=ksrc, levs+1 - taux(k) = sum( atau(k,:)*xaz(:)) - tauy(k) = sum( atau(k,:)*yaz(:)) - ked(k) = sum(kedd(k,:)) - enddo - - tau1(ksrc:levs) = taux(ksrc:levs) - tau1(1:ksrc-1) = tau1(ksrc) -! -! end solver: gw_azimuth_solver_LS81 -! sign Ax in rho*dU/dt = -d(rho*tau)/dz -! [(k) - (k+1)] - ax =0. ; ay = 0. - do k=ksrc, levs - ax(k) = dzirho(k)*(taux(k)-taux(k+1)) - ay(k) = dzirho(k)*(tauy(k)-tauy(k+1)) - enddo - call ugwp_limit_1d(ax, ay, eps, ked, levs) - return - -! - print * - print *, ' Ax: ', maxval(Ax(ksrc:levs))*86400., minval(Ax(ksrc:levs))*86400. - print *, ' Ay: ', maxval(Ay(ksrc:levs))*86400., minval(Ay(ksrc:levs))*86400. - print *, 'Eps: ', maxval(Eps(ksrc:levs))*86400., minval(Eps(ksrc:levs))*86400. - print *, 'Ked: ', maxval(Ked(ksrc:levs))*1., minval(Ked(ksrc:levs))*1. -! print *, 'Atau ', maxval(atau(ksrc:levs, 1:Naz))*1.e3, minval(atau(ksrc:levs, 1:Naz))*1.e3 -! print *, 'taux_gw: ', maxval(taux( ksrc:levs))*1.e3, minval(taux( ksrc:levs))*1.e3 - print * -!----------------------------------------------------------------------- -! Here we can apply "ad-hoc" or/and "stability-based" limiters on -! (axy_gw, ked_gw and eps_gw) and check vert-inegrated conservation laws: -! energy and momentum and after that => final update gw-phys tendencies -!----------------------------------------------------------------------- - - end subroutine ugwp_lsatdis_naz -! - subroutine ugwp_lsatdis_az1(levs, ksrc, nw, kxw, ch, taub_sp, & - fcor, c2f2, zm, zi, rho, um, tm, bn2, bn, rhoi, & - dzirho, dzpi, kvg, ktg, krad, kion, kmol, eps, ked, tau ) - -! call ugwp_lsatdis_az1(levs, ksrc, nw, kxw, ch, taub_spect, & -! fcor, c2f2, zmid, zint, rho, uaz, ti, bn2i, bvi, rhoi, dzirho, dzpi, & -! kvg, ktg, krad, kion, kmol, epsd(:, iaz), kedd(:,iaz), atau(:, iaz) ) - - use cires_ugwp_module, only : F_coriol, F_nonhyd, F_kds, linsat, linsat2 - use cires_ugwp_module, only : iPr_ktgw, iPr_spgw, iPr_turb, iPr_mol - use cires_ugwp_module, only : rhp4, rhp2, rhp1, khp, cd_ulim -! - implicit NONE -! - integer, intent(in) :: nw ! number of GW modes in given direction - integer, intent(in) :: levs ! vertical layers - integer, intent(in) :: ksrc ! level of GW-launch layer - - real , intent(in) :: kxw ! horizontal wavelength - real , intent(in) :: ch(nw) ! horizontal phase velocities - real , intent(in) :: taub_sp(nw) ! spectral distribution of the mom-flux -! - real, intent(in) :: fcor, c2f2 ! Corilois factors - - real , intent(in) :: um(levs+1) - real , intent(in) :: tm(levs+1) -!in - real, intent(in), dimension(levs) :: rho, zm - real, intent(in), dimension(levs+1) :: rhoi, zi - real, intent(in), dimension(levs+1) :: bn2, bn - real, intent(in), dimension(levs) :: dzpi, dzirho - real, intent(in), dimension(levs+1) :: kvg, ktg, krad, kion, kmol -!======================================================================== -!out - real, dimension(levs+1) :: tau, ked - real, dimension(levs) :: eps - -!========================================================================= -!local - real :: Fd1, Fd2 - real, dimension(levs) :: a_mkz - real, dimension(levs+1,nw) :: sp_tau, sp_ked, sp_kth - real, dimension(levs,nw) :: sp_eps - - real, dimension(levs,nw) :: sp_mkz, sp_etot - real, dimension(levs,nw) :: sp_ek, sp_ep - - - real, dimension(levs) :: swg_ep, swg_ek, swg_et, swg_kz - - real, dimension(nw) :: rtaus ! spectral distribution at ksrc - real :: sum_rtaus ! total flux in iaz-azimuth - real :: Chnorm, Cx, Cs, Cxs, Cx2sat - real :: Fdis, Fdisat - real :: Cdf2, Cdf1 ! (Cd*cd-f*f) and sqrt -! -! two-level => upward integration for wave-filtering (dissip + breaking) -! - real :: taus, tauk, tau_lin - real :: etws, etwk, etw_lin - real :: epss, epsk - real :: kds, kdk - real :: kzw, kzw2, kzw3, kzi, kzs - real :: wfd, wfi ! -! -! for GW dissipation on the rotational sphere -! - real :: Betadis ! Ep/Ek ratio - real :: BetaM, BetaT ! 0.5 or 1./1+b and 1-1/(1+b) - real :: wfdM, wfdT, wfiM, wfiT, wdop2 - - real :: dzi, keff, keff_m, keff_t, keffs - - real :: sf2k2, cf2 - real :: Lzkm, Lzsat - - integer :: i, k, igw - integer :: ksat1, ksat2 - - real :: zsat1, zsat2 - real :: kx2_nh - - real :: rab1, rab2, rab3, rab4, cd_ulim2 - - integer :: Ind_out(nw, levs+1) - -! - logical, parameter :: dbg_print = .false. -! -!=================================================================== -! Nullify arrays -! tau, eps, ked -!==================================================================== - - tau = 0.0 - eps = 0.0 - ked = 0.0 - Ind_out(1:nw,:) = 0 -! -! GW-spectral arrays ..... sp_etot ....sp_tau -! - sp_tau = 0. - sp_eps = 0. - sp_ked = 0. - sp_mkz = -99. - sp_etot = 0. - sp_ek = 0. - sp_ep = 0. - sp_kth = 0. -! - swg_et = 0. - swg_ep = 0. - swg_ek = 0. - swg_kz = 0. - cd_ulim2 = cd_ulim*cd_ulim - cf2 = F_coriol*c2f2 - kx2_nh = F_nonhyd*kxw*kxw - - if (dbg_print) then - write(6,*) linsat , ' eff-linsat & kx ', kxw - write(6,*) maxval(ch), minval(ch), ' ch ' - write(6,*) - write(6,*) maxval(rhoi), minval(rhoi), 'rhoi ' - write(6,*) zi(ksrc) , ' zi(ksrc) ' - write(6,*) cd_ulim, ' crit-level cd_ulim ' - write(6,*) F_coriol, ' F_coriol' - write(6,*) F_nonhyd, ' F_nonhyd ' - write(6,*) maxval(Bn), minval(BN), ' BN-BV ' - write(6,*) Um(ksrc), ' Um-ksrc ', cd_ulim2 , 'cd_ulim2 ', c2f2, ' c2f2 ' - !pause - endif - -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! Loop_GW: over GW-spectra -! of individual non-interactive modes -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! - Loop_GW: do i=1, nw -! - Kds = 0.0 -! -! src-level -! - Cx = ch(i) - Um(ksrc) - Cdf2 = Cx*Cx - cf2 - taus = taub_sp(i) ! momentum flux for i-mode w/o rhoi(ksrc) - kzw = Bn(ksrc) / Ch(i) ! ch(i) > 0. Cx(i) < 0. critica - etws = taus*kzw / kxw - rtaus(i) = taus*rhoi(ksrc) -! - IF( Cx <= cd_ulim .or. Cdf2 <= cd_ulim2) THEN - Ind_out(i, ksrc) =-1 ! -1 - diagnostic index for critical levels - cycle Loop_GW ! got to the next mode of GW-spectra - ELSE -! - kzw2 = Bn2(ksrc)/Cdf2 - rhp4 - kx2_nh -! - if (kzw2 <= 0.) then - Ind_out(i, ksrc) =-2 ! -2 - diagnostic index for reflected waves - cycle Loop_GW ! no wave reflection in GW-LSD scheme - endif - - kzw = sqrt(kzw2) - kzw3 = kzw2*kzw - etws = taus*kzw/kxw -! -! Here Linsat == Fr_critical -! - Cx2sat = Linsat2*Cdf2 - if (etws >= cx2sat) then - Kds = kxw*Cx*rhp2/kzw3 - etws = cx2sat - taus = etws*kxw/kzw - Ind_out(i, ksrc) =-3 ! -3 - dignostic index for saturated waves - endif -! - betadis = cdf2/(Cx*Cx+cf2) - betaM = 1.0 /(1.0+betadis) - betaT = 1.0 - BetaM -! - Cxs = Cx - kzs = kzw -! keffs = (kvg(ksrc)+kds)*iPr_turb*.5*khp -! sp_kth(ksrc, i) = rhoi(ksrc)*keffs*(Tm(ksrc)+Tm(ksrc-1)) - rtaus(i) = taus*rhoi(ksrc) - sp_tau(ksrc, i) = rtaus(i) - sp_etot(ksrc, i) = etws - sp_mkz(ksrc, i) = kzw - sp_ek(ksrc, i) = etws*betam - sp_ep(ksrc, i) = etws*betaT ! can be transferred to (T'**2) T-rms - -! - ENDIF ! vertical propagation of i-mode to the next upper layer = (ksrc+1) -! -! Loop_Zint .................................. VERTICAL "INTERFACE" LOOP from ksrc => ktop_GW -! - Loop_Zi: do k=ksrc+1, levs -! - Cx = ch(i)-Um(k) ! Um(k) is defined at the interface pressure levels - Cdf2 = Cx*Cx -cf2 - if( Cx <= cd_ulim .or. Cdf2 <= 0.) then - Ind_out(i, k) =-1 ! 1 - diagnostic index for critical levels - ! print*,'crit level C-U ',int(Cx),int(sqrt(cf2)),' Um ',Um(k) - cycle Loop_GW - endif - - cdf1 =sqrt(Cdf2) - wdop2 = (kxw*Cx)* (kxw*Cx) - kzw2 = (Bn2(k)-wdop2)/Cdf2 - rhp4 - kx2_nh ! full lin DS-NIGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) - - if (kzw2 < 0.) then - Ind_out(i, k) =-2 ! 2 - diagnostic index for reflected waves - cycle Loop_GW - endif - kzw = sqrt(kzw2) - kzw3 =kzw2*kzw -! - keff_m = kvg(k)*kzw2 + kion(k) -! keff_t = kturb(k)*iPr_turb + kmol(k)*iPr_mol - keff_t = ktg(k)*kzw2 + krad(k) -! -! - betadis = cdf2 / (Cx*Cx+cf2) - betaM = 1.0 / (1.0+betadis) - betaT = 1.0 - BetaM - -! -!imaginary frequencies of momentum and heat with "kds at (k-1) level" -! - wfiM = kds*kzw2*F_kds + keff_m - wfiT = kds*iPr_ktgw*F_kds * kzw2 + keff_t -! - wfdM = wfiM/(kxw*Cdf1)*BetaM - wfdT = wfiT/(kxw*Cx)*BetaT -! exp-l: "kzi*dz" - kzi = 2.*kzw*(wfdM+wfdT)*dzpi(k) ! 2-factor energy-momentum (U')^2 -!------------------------------------------------------- -! dissipative factor: Fdis -! we can replace WKB-solver by Numerical integration of -! tau_gw == etot_gw/kzw*kxw -! d(rho*tau_gw) = -kdis*rho*tau_gw -! |tau_gw| <= |tau_gwsat| -! linear limit for single mode -! generalization for the "broad" spectra -! or treating single mode breaking -! over finite "vertical"-depth with "efficiency" -! Now: time-step + hor-l scale -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Fdis = exp(-kzi) -! -! -! dissipative "wave rms" by WKB -! - etwk = etws*rhoi(k-1)/rhoi(k)*Fdis*kzw/kzs -! - Cx2sat = Linsat2*Cdf2 -! -! Linear saturation -! - if (etwk.ge.cx2sat) then - - Ind_out(i, k) =-3 ! 3 - dignostic index for saturated waves -! ! saturate energy and "trigger" keddy - etw_lin = etwk - etwk = cx2sat - Kds = kxw*Cdf1*rhp2/kzw3 - tauk = etwk*kxw/kzw - -!=================================================================================== -! WAM/case with high Kds tau_lin = (etw_lin-etwk)*kxw/kzw !tau_loss by sat theory -! Lzsat = 6,28/kzw Zsat1 = Zi(k)-.5*Lzsat -! Zsat2 = Zi(k)+.5*Lzsat -! in WAM triggering from "kds = 0 m2/s" => "200 m2/s" for Lzw ~ 10 km -! -! call sat_domain(zi, Zsat1, Zsat2, pver, ksat1, ksat2) -! -! to avoid it do the new diss-n factor with eddy "kds" added to the -! background keff_m and keff_t -! -! can be taken out for the strato-mesosphere in GFS -! wfiM = kds*kzw2 + keff_m -! wfiT = kds*iPr_ktgw * kzw2 +keff_t -! wfdM = wfiM/(kxw*Cdf1)*BetaM -! wfdT = wfiT/(kxw*Cx)*BetaT -! kzi = 2.*kzw*(wfdM+wfdT)*dzpi(k) -! Fdisat = exp(-kzi) -! etwk = etws*rhoi(k-1)/rhoi(k)*Fdis*(kzw/Kzs) -! updated breaking in the Lzsat-domain: zsat1 < zi < zsat2 -! ================================================================================= - else - kds = 0.0 - tauk = etwk*kxw/kzw ! = Ekin*kx/kz - ENDIF -!-------------------------------------- -! -! Fill in spectral arrays(levs, nw) -! -!-------------------------------------- - sp_ked(k,i) = kds ! defined at interfaces - sp_tau(k, i) = tauk*rhoi(k) ! defined at interfaces - -! keff = (kds + kvg(k))*iPr_turb*0.5*KHP -! sp_kth(k, i) = rhoi(k)*keff*(Tm(k)+Tm(k-1)) ! defined at mid-layers - - sp_etot(k, i) = etwk ! defined at interfaces - sp_mkz(k, i) = kzw ! defined at interfaces - sp_ek(k, i) = etwk*betam ! defined at interfaces - sp_ep(k, i) = etwk*betaT ! can be transferred to (T'**2) -! -! - if (sp_tau(k,i) > sp_tau(k-1,i)) then - sp_tau(k,i) = sp_tau(k-1,i) ! prevent "possible" numerical "noise" - endif -! -! updates for "eps and keff" from -! - rab1 =.5*(cx+cxs)*dzirho(k) -! heating -! due to wave dissipation -! - sp_eps(k,i) = rab1*(sp_tau(k-1,i)- sp_tau(k,i)) ! defined at mid-layers -! -! cooling term due to eddy heat conduction =0 if Keff_cond =>0, -! usually updated by 1D-heat implict tridiagonal solver -! explicit local solver ---->sp_kth(k,i) = Kt*(dT/dz+ R/Cp*T/Hp~>g/cp) -! -! sp_eps(k,i)=sp_eps(k,i)+dzirho(k)*(sp_kth(k,i)- sp_kth(k-1,i)) -! - kzs = kzw - cxs = cX - taus = tauk - etws = etwk -! keffs = keff - - enddo Loop_Zi ! ++++++++++++++ vertical layer -! -! ................................! stop ' in solver single-mode' -! - enddo Loop_GW ! i-mode of GW-spectra -! - sum_rtaus =sum(rtaus) ! total momentum flux at k=ksrc - -! print *, sum_rtaus, ' tau-src ', nint(zi(ksrc)*1.e-3) -! print *, maxval(ch), minval(ch), ' Ch ', ngwv, ' N-modes ' -! -!============================================================================== -! Perform spectral integartion (sum) & apply "efficiency/inremittency" factors -! -! eff_factor: ~ 1./[number of modes in 1-direction of model columns] -! -!============================================================================== - do k=ksrc, levs - - ked(k) =0. - Eps(k) = 0. - Tau(k) = 0. - swg_et(k) =0. - swg_ep(k) =0. - swg_ek(k) =0. - - do i=1,nw - Ked(k) = Ked(k)+sp_ked(k,i) - Eps(k) = Eps(k)+sp_eps(k,i) - Tau(k) = Tau(k)+sp_tau(k,i) -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! GW-energy + GW-en flux ~ Cgz*E, diagnostics-only -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - swg_et(k) = swg_et(k)+sp_etot(k,i) !*eff_fact - swg_ep(k) = swg_ep(k)+sp_ep(k,i) !*eff_fact - swg_ek(k) = swg_ek(k)+sp_ek(k,i) !*eff_fact - enddo - - enddo -! fill in below the "source" level ..... [1:ksrc-1] -! - do k=1, ksrc-1 -! no loss of the total momentum flux - ked(k) =0. - eps(k) = 0. - tau(k) = tau(ksrc) -! lin-theory diagnostics-only - swg_et(k) =swg_et(ksrc)*rhoi(ksrc)/rhoi(k) - swg_ep(k) =swg_ep(ksrc)*rhoi(ksrc)/rhoi(k) - swg_ek(k) =swg_ek(ksrc)*rhoi(ksrc)/rhoi(k) - enddo -! - RETURN -! -! diagnostics below -! -345 FORMAT(2x, F8.2, 4(2x, F10.3), 2x, F8.2) - if (dbg_print) then - print * - print *, ' Zkm EK m2/s2 Ked m2/s Eps m2/s3 tau-Mpa ' - do k=ksrc, levs -! Fd1 = maxval(Fdis_modes(1:nw,k)) -! Fd2 = minval(Fdis_modes(1:nw,k)) - write(6, 345) Zi(k)*1.e-3, sqrt(swg_ek(k)), Ked(k), Eps(k), Tau(k)*1.e3, Um(k) !, Fd1, Fd2 - enddo - print * - write(6,*) nw , ' nwaves-linsat ' - write(6,*) maxval(sp_ked), minval(sp_ked), 'ked ' - write(6,*) maxval(sp_tau), minval(sp_tau), 'sp_tau ' - !pause - endif - -! - end subroutine ugwp_lsatdis_az1 -! - subroutine ugwp_limit_1d(ax, ay,eps, ked, levs) - use cires_ugwp_module, only : max_kdis, max_eps, max_axyz - implicit none - integer :: levs - real, dimension(levs) :: ax, ay,eps - real, dimension(levs+1) :: ked - real, parameter :: xtiny = 1.e-30 - where (abs(ax) > max_axyz ) ax = ax/abs(ax+xtiny)*max_axyz - where (abs(ay) > max_axyz ) ay = ay/abs(ay+xtiny)*max_axyz - where (abs(eps) > max_eps ) eps = eps/abs(eps+xtiny)*max_eps - where (ked > max_kdis ) ked = max_kdis - end subroutine ugwp_limit_1d diff --git a/physics/cires_vert_orodis.F90 b/physics/cires_vert_orodis.F90 deleted file mode 100644 index 0d3cce194..000000000 --- a/physics/cires_vert_orodis.F90 +++ /dev/null @@ -1,1018 +0,0 @@ -! subroutine ugwp_drag_mtb -! subroutine ugwp_taub_oro -! subroutine ugwp_oro_lsatdis -! - subroutine ugwp_drag_mtb( iemax, nz, & - elvpd, elvp, hprime , sigma, theta, oc, oa4, clx4, gam, zpbl, & - up, vp, tp, qp, dp, zpm, zpi, pmid, pint, idxzb, drmtb,taumtb) - - use ugwp_common, only : bnv2min, grav, grcp, fv, rad_to_deg, dw2min, velmin, rdi - use ugwp_oro_init,only : nridge, cdmb, fcrit_mtb, frmax, frmin, strver - - implicit none -!======================== -! several versions for drmtb => high froude mountain blocking -! version 1 => vay_2018 ; -! version 2 => kdn_2005 ; Kim & Doyle in NRL-2005 -! version 3 => ncep/gfs-2017 -gfs_2017 with lm1997 -!======================== - -! character(len=8) :: strver = 'vay_2018' -! real, parameter :: Fcrit_mtb = 0.7 - - integer, intent(in) :: nz - integer, intent(in) :: iemax ! standard ktop z=elvpd + 4 * hprime - real , intent(out) :: taumtb - - integer , intent(out) :: idxzb - real, dimension(nz), intent(out) :: drmtb - - real, intent(in) :: elvp, elvpd !elvp = min (elvpd + sigfac * hprime(j), hncrit=10000meters) - real, intent(in) :: hprime , sigma, theta, oc, oa4(4), clx4(4), gam - real, intent(in) :: zpbl - - real, dimension(nz), intent(in) :: up, vp, tp, qp, dp, zpm, pmid - real, dimension(nz+1), intent(in) :: zpi, pint -! - real, dimension(nz+1) :: zpi_zero - real, dimension(nz) :: zpm_zero - real :: vtj, rhok, bnv2, rdz, vtkp, vtk, dzp - - real, dimension(nz) :: bn2, uds, umf, cosang, sinang - - integer :: k, klow, ktop, kpbl - real :: uhm, vhm, bn2hm, rhohm, & - mtb_fix, umag, bnmag, frd_src, & - zblk, who_iz_normal, rlm97, & - phiang, ang, pe, ek, & - cang, sang, ss2, cs2, zlen, dbtmp, & - hamp, bgamm, cgamm - -!================================================== -! -! elvp + hprime <=>elvp + nridge*hprime, ns =2 -! ns = sigfac -! tau_parel & tau_normal along major "axes" -! -! options to block the "flow", choices for [klow, ktop] -! -! 1-directional (normal) & 2-directional "blocking" -! -!================================================== -! no - blocking: drmtb(1:nz) = 0.0 -!================= - idxzb = -1 - drmtb(1:nz) = 0.0 - taumtb = 0.0 - klow = 2 - - ktop = iemax - hamp = nridge*hprime - -! reminder: cdmb = 4.0 * 192.0/float(imx)*cdmbgwd(1) Lellipse= a/2=sigma/hprime - - mtb_fix = cdmb*sigma/hamp !hamp ~ 2*hprime and 1/sigfac = 0.25 is inside 1/hamp - - if (mtb_fix == 0.) then - print *, cdmb, sigma, hamp - print *, ' MTB == 0' - stop - endif - - if (strver == 'vay_2018') then - - zpm_zero = zpm - zpi(1) - zpi_zero = zpi - zpi(1) - - do k=1, nz-1 - if (hamp .le. zpi_zero(k+1) .and. (hamp .gt. zpi_zero(k) ) ) then - ktop = k+1 !......simply k+1 next interface level - exit - endif - enddo -! print *, klow, ktop, ' klow-ktop ' - call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - bn2, uhm, vhm, bn2hm, rhohm) - - umag = max(sqrt(uhm*uhm + vhm*vhm), velmin) !velmin=dw2min =1.0 m/s - if (bn2hm .le. 0.0) then - print *, ' unstable MF for MTB -RETURN ' - RETURN ! unstable PBL - endif - bnmag =sqrt(bn2hm) - - frd_src = min(hamp*bnmag/umag, frmax) ! frmax =10. - -! print *, frd_src, Fcrit_mtb/frd_src, ' no-Blocking > 1 ' -! - if ( frd_src .le. Fcrit_mtb) RETURN ! no-blocking, although on small ridges with weak winds can be blocking -! -! zblk > 0 -! Fcrit_mtb > Fcrit_ogw h_clip = Fr_mtb*U/N ! h_hill minus h_clip = zblk -! - zblk = hamp*(1. - Fcrit_mtb/frd_src) - idxzb =1 - do k = 2, ktop - - if ( zblk < zpm_zero(k) .and. zblk >= zpm_zero(k-1)) then - idxzb = k - exit - endif - enddo -! - if (idxzb == 1) RETURN ! first surface level block is not "important" - - if (idxzb > 1) then ! let start with idxzb = 2....and up with LM1997 -! -! several options to compute MTB-drag: a) IFS_1997 ; b) WRF_KD05 ; c) SJM_2000 -! - bgamm = 1.0 - 0.18*gam -0.04*gam*gam - cgamm = 0.48*gam +0.3*gam*gam - - do k = 1, idxzb-1 - zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) - - umag = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) - - phiang = atan(vp(k)/umag) -! theta -90/90 - ang = theta - phiang - cang = cos(ang) ; sang = sin(ang) - - who_iz_normal = max(cang, gam*sang ) !gfs-2018 - - cs2 = cang* cang ; ss2 = 1.-cs2 - - rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! ... (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it -! - if (rlm97 > 2.0 ) rlm97 = 2.0 ! zero mtb-friction at this level -! - - who_iz_normal = bgamm*cs2 + cgamm*ss2 ! LM1997/IFS - - dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal - if (dbtmp < 0) dbtmp = 0.0 -! -! several approximation can be made to implement MTB-drag -! as a "nonlinear level dependent"-drag or "constant"-drag -! uds(k) == umag = const between the 1-layer and idxzb -! - - drmtb(k) = dbtmp * abs(umag) ! full mtb-drag = -drmtb(k) * uds = -kr*u - taumtb = taumtb - drmtb(k)*umag *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) -! -! 2-wave appr for anisotropic drmtb_Bellipse(k) and drmtb_Aell(k) can be used -! with Umag-projections on A & B ellipse axes -! mtb_fix =0.25*cdmb*sigma/hprime, -! in SM-2000 mtb_fix~ 1/8*[cdmb_A, cdmb_B]*sigma/hprimesum ( A+B) = 1/4. -! -!333 format(i4, 7(2x, F10.3)) -! write(6,333) , k, zpm_zero(k), zblk, hamp*Fcrit_mtb/frd_src, taumtb*1.e3, drmtb(k) , -drmtb(k)*up(k)*1.e5 - enddo -! - endif - endif ! strver=='vay_2018' -! -! -! - if (strver == 'kdn_2005' .or. strver == 'wrf_2018' ) then - - print *, ' kdn_2005 with # of hills ' -! -! compute flow-blocking stress based on WRF 'gwdo2d' -! - endif -! -! - if (strver == 'gfs_2018') then - - ktop = iemax; klow = 2 - - call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - bn2, uhm, vhm, bn2hm, rhohm) - if (bn2hm <= 0.0) RETURN ! unstable PBL -!--------------------------------------------- -! -!'gfs_2018' .... does not rely on Fr_crit -! and Fr-regimes -!----gfs17 for mtn ignores "averaging of the flow" -! for MTB-part it is only works with "angles" -! no projections on [uhm, vhm] -direction -! kpbl can be used for getting high values of iemax-hill -!----------------------------------------------------------- - zpm_zero = zpm - zpi(1) - zpi_zero = zpi - zpi(1) - do k=1, nz-1 - if (zpbl .le. zpm_zero(k+1) .and. (zpbl .ge. zpm_zero(k) ) ) then - kpbl = k+1 - exit - endif - enddo - - do k = iemax, 1, -1 - - uds(k) = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) - phiang = atan(vp(k)/uds(k)) - ang = theta - phiang - cosang(k) = cos(ang) - sinang(k) = sin(ang) - - if (idxzb == 0) then - pe = pe + bn2(k) * (elvp - zpm(k)) *(zpi(k+1) - zpi(k)) - umf(k) = uds(k) * cosang(k) ! normal to main axis - ek = 0.5 * umf(k) * umf(k) -! -! --- dividing stream lime is found when pe =>exceeds ek first from the "top" -! - if (pe >= ek) idxzb = k - exit - endif - enddo - -! idxzb = min(kpbl, idxzb) -! -! -! -! last: mtb-drag -! - if (idxzb > 1) then - zblk = zpm(idxzb) - print *, zpm(idxzb)*1.e-3, ' mtb-gfs18 block-lev km ', idxzb, iemax, int(elvp) - do k = idxzb-1, 1, -1 -! - zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) - cs2 = cosang(k)* cosang(k) - ss2 = 1.-cs2 - rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it - - who_iz_normal = max(cosang(k), gam*sinang(k)) -! -! high res-n higher mtb 0.125 => 3.5 ; (negative of db -- see sign at tendency) -! - dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal - - drmtb(k) = dbtmp * abs(uds(k)) ! full mtb-drag = -drmtb(k) * uds = -kr*u -! - taumtb = taumtb - drmtb(k) * uds(k) *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) -! - enddo - endif - endif ! strver=='gfs17' -! -! - end subroutine ugwp_drag_mtb -! -! -! ugwp_taub_oro - Computes [taulin, taufrb, drlee(levs) ] -! -! - subroutine ugwp_taub_oro(levs, izb, kxw, tau_izb, fcor, & - hprime , sigma, theta, oc, oa4, clx4, gamm, & - elvp, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, xn, yn, umag, & - tautot, tauogw, taulee, drlee, tau_src, kxridge, kdswj, krefj, kotr) -! - use ugwp_common, only : bnv2min, grav, pi, pi2, dw2min, velmin - use cires_ugwp_module, only : frcrit, ricrit, linsat - use ugwp_oro_init, only : hpmax, cleff, frmax - use ugwp_oro_init, only : nwdir, mdir, fdir - use ugwp_oro_init, only : efmin, efmax , gmax, cg, ceofrc - use ugwp_oro_init, only : fcrit_sm, fcrit_gfs, frmin, frmax - use ugwp_oro_init, only : coro, nridge, odmin, odmax - use ugwp_oro_init, only : strver -! - use ugwp_oro_init, only : mkz2min, lzmax, zbr_pi -! --- -! -! define oro-GW fluxes: taulin, taufrb amd if kdswj > 0 (LWB-lee wave breaking) -! approximate for drlee-momentum tendency -! --- - implicit none -! - integer, intent(in) :: levs, izb - real , intent(in) :: tau_izb ! integrated (1:izb) drag -Kr_mtb*U, or Zero - integer, intent(out) :: kdswj, krefj, kotr - integer :: klwb - real, intent(in) :: kxw, fcor - real, intent(in) :: hprime, sigma, theta, oc, gamm, elvp - -! - real, intent(in) :: oa4(4), clx4(4) - - real, dimension(levs), intent(in) :: up, vp, tp, qp, dp - real, dimension(levs+1), intent(in) :: zpi, pint - real, dimension(levs ), intent(in) :: zpm, pmid -! - real,dimension(levs), intent(out) :: drlee - real,dimension(levs+1), intent(out) :: tau_src -! - real, intent(out) :: tauogw, tautot, taulee - real :: taulin, tauhcr, taumtb - real, intent(out) :: xn, yn, umag, kxridge -! -! -! locals -! four possible versions to compute "taubase as a function of Fr-number" -! character :: strver='smc_2000' ! 'kd_2005', 'gfs_2017', 'vay_2018' -! - real, dimension(levs+1) :: zpi_zero - - real :: oa, clx, odir, cl4p(4), clxp - - real :: uhm, vhm, bn2hm, rhohm, bnv - - real :: elvpMTB, wdir - real :: tem, efact, coefm, kxlinv, gfobnv - - real :: fr, frlin, frlin2, frlin3, frlocal, dfr - real :: betamax, betaf, frlwb, frmtb - integer :: klow, ktop, kph - - integer :: i, j, k, nwd, ind4, idir - - real :: sg_ridge, kx2, umd2 - real :: mkz, mkz2, zbr_mkz, mkzi - - real :: hamp ! clipped hprime*elvmax/elv_clip > hprime - real :: hogw ! hprime or hamp for free-prop OGWs z > z(krefj) - real :: hdsw ! empirical like DNS amplitudes for Lee-dsw trapped waves - real :: hcrit - real :: hblk ! blocking div-stream height - - real :: coef_h2, frnorm - - - real, dimension(levs) :: bn2 - real :: rho(levs) - real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi - real, dimension(levs+1) :: umd, phmkz - real :: c2f2, umag2, dzwidth, udir - real :: hogwi, hdswi, hogwz, hdswz ! height*height wave-amp - real :: uogwi, udswi, uogwz, udswz ! wind2 wave-rms - real, dimension(levs+1) :: dtrans, deff - real :: pdtrans - logical :: do_klwb_phase = .false. ! phase-crireria for LLWB of SM00 - logical :: do_dtrans = .true. ! dissipative saturation to deposit momentum - ! between ZMTB => ZHILL -!----------------------------------------------------------------------------- -! -! downslope/lee/GW wave regimes kdswj: between ZMTB and ZOGW(krefj) -! ZMTB < ZOGW = ns*HPRIME < ELVP -! define krefj as a level for OGWs above ZMTB and "2-3-4*hprime" + ZMTB -! we rely on the concept of the "CLIPPED-SG" mountain above ZMTB & new -! inverse Froude number for the "mean flow" averaged from ZMTB to ZOGW -! here we can use "elvp" as only for hprime adjustment ...elvp/elvp_MTB -! -!"empirical" specification of tauwave = taulee+tauogw in [ZMTB : ns*HPRIME] -! can be based on numerical runs like WRF-model -! for Frc < Fr< [Frc : 2.5-3 Frc] -! see suggestions proposed in SM-2000 and Eckermann et al. (2010) -!----------------------------------------------------------------------------- - tautot = 0. ; taulin = 0. ; taulee = 0. ; drlee(1:levs) = 0. ; tau_src = 0.0 - krefj = 1 ; kotr = levs+1; kdswj = 1 - xn = 1.0 ; yn = 0. ; umag = velmin; kxridge = kxw - - dtrans = 0. ; deff =0. - klow = 2 - elvpMTB = elvp -! -! clipped mountain H-zmtb for estimating wave-regimes new Fr and MF above ZMTB -! - if (izb > 0 ) then - klow = izb - elvpMTB = max(elvp - zpi(izb), 0.0) - endif - if (elvpMTB <=0 ) print *, ' blocked flow ' - if (elvpMTB <=0 ) return ! "blocked flow" from the surface to elvMAX - - zpi_zero(:) = zpi(:) - zpi(1) - hblk = zpi_zero(klow) - - sg_ridge = max( nridge*hprime * (elvp/elvpMTB), hblk+hprime*0.333) - -! -! enhance sg_ridge by elvp/elvpMTB >1 and H_clip = H-hiilnew - zblk later for hamp -! - sg_ridge = min(sg_ridge, hpmax) - -! print *, 'sg_ridge ', sg_ridge - - do k=1, levs - if (sg_ridge .gt. zpi_zero(k) .and. ( sg_ridge .le. zpi_zero(k+1) ) ) then - ktop = k+1 - exit - endif - enddo - - krefj = ktop ! the mountain top index for sg_ridge = ns*hprime - -! if ( izb > 0 .and. krefj .le. izb) then -! print *, izb, krefj, sg_ridge, zpi_zero(izb), ' izb >ktop ' -! endif - -! -! here ktop displays sg_ridge-position not elvP !!!! klow =2 to avoid for 127-126L -! instability due to extreme "thin" layer...128L-model needs cruder vertical resolution -! - call um_flow(levs, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - bn2, uhm, vhm, bn2hm, rhohm) - - call get_unit_vector(uhm, vhm, xn, yn, umag) - - if (bn2hm <= 0.0) RETURN ! "unstable/neutral" hill need different treatment - bnv = sqrt(bn2hm) - hamp = sg_ridge-zpi_zero(klow) ! hamp >= nridge*hprime due higher SG-elevations - zblk or first layer - hogw = hamp - hdsw = hamp - - - fr = bnv * hamp /umag - fr = min(fr, frmax) - kxridge = max(sigma/hamp, kxw) ! to get rid from "SSO-errors" kxw-provides max-value for kx - kx2 = kxridge*kxridge - umag = max( umag, velmin) - c2f2 = fcor*fcor/kx2 - umag2 = umag*umag - c2f2 - - if (umag2 <= 0.0) RETURN ! Coriolis cut-off at high-mid latitudes for low kx - - mkz2 = bn2hm/umag2 - kx2 ! we add Coriolis corrections for crude model resolutions "low-kx" - ! and non-stationary waves coro, fcor for small umag - ! bn2hm/[(coro-umag)^2 -fc2/kx2] - kx2, cf = fc/kx => 2 m/s to 11 m/s for 60deg - IF (mkz2 < mkz2min .or. krefj <= 2 ) THEN -! -! case then no effects of wave-orography -! - krefj = 1 ; kdswj = 1; kotr = levs ; klwb = 1 - tautot = 0. - tauogw = 0. - taulee = 0. - drlee = 0. ; tau_src(1:levs+1) = 0. - return - ENDIF -!========================================================================= -! find orographic asymmetry and convexity :'oa/clx' for clipped SG-hill -! nwd 1 2 3 4 5 6 7 8 -! wd w s sw nw e n ne se -! make sure that SM_00 and KD_05 oro-characteristics can match each other -! OD-KDO5 = Gamma=a/b [0:2] ; hsg = 2.*hprime -! OC-KD05 mount sharpness sigma^4 "height to half-width"[0:1] -! alph-SM00 fraction of h2d contributed to hprime [0:1] -! -! OA-KDO5 OA > dwstream OA=0 sym OA < 0 upstram [-1. 0. 1] -! delt-SM00 dw/up asymmetry -1 < delta < 1 -! Gamma-LM97 anisotropy of the orography g2 =(dh/dx)^2/(dh/dy)^2 -!.. -!A parametrization of low-level wave breaking which includes a dependence on -!the degree of 2-dimensionality of SG; it is active over a finite range of Fr -!========================================================================= - wdir = atan2(uhm,vhm) + pi - idir = mod( int(fdir*wdir),mdir) + 1 - - nwd = nwdir(idir) - ind4 = mod(nwd-1,4) + 1 - if (ind4 < 1 ) ind4 = 1 - if (ind4 > 4 ) ind4 = 4 - - oa = ( 1-2*int( (nwd-1)/4 )) * oa4(ind4) - clx = clx4(ind4) - cl4p(1) = clx4(2) - cl4p(2) = clx4(1) - cl4p(3) = clx4(4) - cl4p(4) = clx4(3) - clxp = cl4p(ind4) - - odir = clxp/max(clx, 1.e-5) ! WRF-based definition for "odir" - - odir = min(odmax, odir) - odir = max(odmin, odir) - - - if (strver == 'smc_2000' .or. strver == 'vay_2018') then -!========================================================================= -! -! thrree-piece def-n for tautot(Fr): 0-Fr_lin - Fr_lee -Fr_mtb -! taulin/tauogw taulee taumtb -! here tau_src(levs+1): approximate wave flux from surface to LLWB -! Following attempts of Scinocca +McFarlane, 2000 & Eckermann etal.(2010) -!========================================================================= -! -! if (mkz2 < 0)... mkzi = sqrt(-mkz2) trapped wave regime don't a case in UGWP-V1 -! wave flux ~ rho_src*kx_src/mkz_src*wind_rms -! bn2, uhm, vhm, bn2hm, rhohm -! -! IF (mkz2.ge. mkz2min .and. krefj > 2 ) THEN -! -! wave regimes -! - mkz = sqrt(mkz2) - frlwb = fcrit_sm ! should be higher than LOGW to get zblk < zlwb - frlin = fcrit_sm - frlin2 = 1.5*fcrit_sm - frlin3 = 3.0*fcrit_sm - - hcrit = fcrit_sm*umag/bnv - hogw = min(hamp, hcrit) - hdsw = min(hamp, frlwb*umag/bnv) ! no trapped-wave solution - - coef_h2 = kxridge * rhohm * bnv * umag - - taulin = coef_h2 * hamp*hamp - tauhcr = coef_h2 * hcrit*hcrit - - IF (fr < frlin ) then - tauogw = taulin - taulee = 0.0 - taumtb = 0.0 - else if (fr .ge. frlin ) then - tauogw = tauhcr - taulin = coef_h2 * hamp*hamp - taumtb = tau_izb ! integrated form MTB -! -! SM-2000 approach for taulee, shall we put limits on BetaMax_max ~ 20 or Betaf ?? -! - frnorm = fr/fcrit_sm ! frnorm below [1.0 to 3.0] - BetaMax = 1.0 + 2.0*OC ! alpha of SM00 or OC-mountain sharphess KD05 OC=[10, 0] - - if ( fr <= frlin2 ) then - Betaf= 2.*BetaMax*(frNorm-1.0) - taulee = (1. + Betaf )*taulin - tauhcr - else if ( (fr > frlin2).and.(fr <= frlin3))then - Betaf=-1.+ 1./frnorm/frnorm + & - (BetaMax + 0.555556)*(2.0 - 0.666*frnorm)* (2.0 - 0.666*frnorm) - taulee = (1. + Betaf )*taulin - tauhcr -!============== -! Eck-2010 WRF-alternatve through Dp_surf = P'*grad(h(x,y)) -! 1 < Fr < 2.5 tauwave = taulee+tauogw = tau_dp*(fr)**(-0.9) -! Fr > 2.5 tauwave = tau_dp*(2.5)**(-0.9) -! to apply it need tabulated Dp(fr, Dlin) Dp=function(Dlin, U, N, h) -! -!============== - else - taulee = 0.0 - hdsw = 0.0 - endif - ENDIF - - tautot = tauogw + taulee + taumtb*0. - - IF (taulee > 0.0 ) THEN - - hdsw = sqrt(tautot/coef_h2) ! averaged value for hdsw - mixture of lee+ogw with mkz/kxridge -! -! compute vertical profile "drlee" with the low-level wave breaking & "locally" trapped waves -! make "empirical" height above elvp that may represent DSW-wave breaking & trapping -! here we will assign tau_sso(z) profile between: zblk(zsurf) - zlwb - ztop_sso = ns*sridge -! - call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) - - kph = max(izb, 2) ! kph marks the low-level of wave solutions - klwb = kph ! klwb above blocking marks wave-breaking - kotr = levs+1 ! kotr marks mkz2(z) <= 0., reflection level - - if (do_dtrans) pdtrans = log(tautot/tauogw)/(zpi(krefj) - zpi(kph)) - - udir = max(ui(krefj)*xn +vi(krefj)*yn, velmin) - hogwi = hogw*hogw* rhohm/rhoi(krefj) * umag/udir * bnv/bvi(krefj) - umd(krefj) = udir - - udir = max(ui(kph)*xn +vi(kph)*yn, velmin) - hdswi = hdsw*hdsw* rhohm/rhoi(kph) * umag/udir * bnv/bvi(kph) - umd(kph) = udir - ! what we can put between k =[kph:krefj] - phmkz(:) = 0.0 ! - phmkz(kph-1) = fr ! initial Phase of the low-level wave -! -! now transfer tau_layer => tau_level assuming tau_layer = tau_level -! kx*rho_layer*bn_layer*u_layer* HL*HL = kx*rho_top*bn_top*u_top * HT*HT -! apply it for both hdsw & hogw with linear saturation-solver for Cx =0 -! - loop_lwb_otr: do k=kph+1, krefj ! levs - - umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) - umd2 =(coro- umd(k))*(coro- umd(k)) - umd2 = max(umd2, dw2min) -c2f2 - - - if (umd2 <= 0.0) then -! -! critical layer -! - klwb = k - kotr = k - exit loop_lwb_otr - endif - - mkz2 = bn2i(k)/umd2 - kx2 - - if ( mkz2 >= mkz2min ) then -! -! find klwb having some "kinematic" phase "break-down" crireria SM00 or LM97 -! at finest vertical resolution we can meet "abrupt" mkz -! mkzmax = 6.28/(2*dz), mkzmin = 6.28/ztrop=18km -! to regularize SG-solution mkz = max(mkzmax, min(mkz,in, mkz)) -! - mkz = sqrt(mkz2) - hdswz = hdswi* rhoi(k-1)/rhoi(k) * umd(k-1)/umd(k) * bvi(k-1)/bvi(k) - udswz = hdswz *bn2i(k) -!=========================================================================================== -!linsat wave ampl.: mkz*sqrt(hdswz) <= 1.0 or udswz <= linsat2*umd2 -! -! tautot = tausat = rhoi(k) *udswz_sat * kxridge/mkz -! by k = krefj tautot = tauogw(krefj) -!=========================================================================================== - if (do_klwb_phase) then - phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) - if( ( phmkz(k) .ge. zbr_pi).and.(klwb == kph)) then - klwb = min(k, krefj) - exit loop_lwb_otr - endif - endif - else ! mkz2 < mkz2min - kotr = k ! trapped/reflected waves / - exit loop_lwb_otr - endif - enddo loop_lwb_otr -! -! define tau_src(1:zblk:klwb) = sum(tau_oro+tau_dsw+tau_ogw) and define drlee -! tau_trapped ??? -! - if (do_klwb_phase) then - do k=kph, kotr-1 - - if (klwb > kph .and. k < klwb) then - drlee(k) = (tautot -tauogw)/(zpi(kph) - zpi(klwb)) ! negative Ax*rho - tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) - drlee(k) = drlee(k)/rho(k) - else if ( k >= klwb .and. k < kotr) then - tau_src(k) = tauogw - drlee(k) = 0.0 - endif - enddo - kdswj = klwb ! assign to the "low-level" wave breaking - endif -! -! simplest exponential transmittance d(tau)/dz = - pdtrans *tau(z) -! more complicated is dissipative saturation pdtrans =/= constant -! - if (do_dtrans) then - do k=kph, krefj - tau_src(k)= tautot*exp(-pdtrans*(zpi(k)-zpi(kph))) - drlee(k) = -tau_src(k)/rho(k) * pdtrans - enddo - endif - - - ENDIF !taulee > 0.0 - - - endif !strver -! - -!========================================================================= - if (strver == 'gfs_2018' .or. strver == 'kd_2005') then -!========================================================================= -! -! orowaves: OGW+DSW/Lee -! - efact = (oa + 2.0) ** (ceofrc*fr) - efact = min( max(efact,efmin), efmax ) - coefm = (1. + clx) ** (oa+1.) - - kxlinv = min (kxw, coefm * cleff) ! does not exceed 42km ~4*dx - kxlinv = coefm * cleff - tem = fr * fr * oc - gfobnv = gmax * tem / ((tem + cg)*bnv) ! g/n0 -!========================================================================= -! source fluxes: taulin, taufrb -!========================================================================= - tautot = kxlinv * rhohm * umag * umag *umag* gfobnv * efact - - coef_h2 = kxlinv *rhohm * bnv*umag - taulin = coef_h2 *hamp*hamp - hcrit = fcrit_gfs*umag/bnv - tauhcr = coef_h2 *hcrit*hcrit - - IF (fr <= fcrit_gfs) then - tauogw = taulin - tautot = taulin - taulee = 0. - drlee(:) = 0. - ELSE !fr > fcrit_gfs - tauogw = tauhcr - taulee = max(tautot - tauogw, 0.0) - if (taulee > 0.0 ) hdsw = sqrt(taulee/coef_h2) -! approximate drlee(k) between [izb, klwb] -! find klwb and decrease taulee(izb) => taulee(klwb) = 0. -! above izb tau - if (mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0) then - - mkz = sqrt(mkz2) - call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) - - kph = max(izb, 2) - phmkz(:) = 0.0 - klwb = max(izb, 1) - kotr = levs+1 - phmkz(kph-1) = fr ! initial Phase of the Lee-OGW - - loop_lwb_gfs18: do k=kph, levs - - umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) - umd2 =(coro- umd(k))*(coro- umd(k)) - umd2 = max(umd2, velmin*velmin) - mkz2 = bn2i(k)/umd2 - kx2 - if ( mkz2 > mkz2min ) then - mkz = sqrt(mkz2) - frlocal = max(hdsw*bvi(k)/umd(k), frlwb) - phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) - if( ( phmkz(k) >= zbr_pi ) .and. (frlocal > frlin)) klwb = k - else - kotr = k - exit loop_lwb_gfs18 - endif - enddo loop_lwb_gfs18 -! -! - do k=kph, kotr-1 - - if (klwb > kph .and. k < klwb) then - drlee(k) = -(tautot -tauogw)/(zpi(kph) - zpi(klwb)) - tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) - drlee(k) = drlee(k)/rho(k) - else if ( k >= klwb .and. k < kotr) then - tau_src(k) = tauogw - drlee(k) = 0.0 - endif - enddo - kdswj = klwb ! assign to the "low-level" wave breaking - endif ! mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0 - ENDIF !fr > fcrit_gfs - - - ENDIF !strbase='gfs2017' .or. strbase='kd_2005' - - -! output : taulin, taufrb, taulee, xn, yn, umag, kxw/kxridge -! print *, krefj, levs, tauogw, tautot , ' ugwp_taub_oro ' -! - end subroutine ugwp_taub_oro -! -!-------------------------------------- -! -! call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, kxw, & -! fcor(j), c2f2(j), up, vp, tp, qp, dp, zpm, zpi, pmid1, pint1, & -! xn, yn, umag, drtau, kdis_oro) - - subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & - kxw, fcor, kxridge, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - xn, yn, umag, drtau, kdis) - - use ugwp_common, only : bnv2min, grav, pi, pi2, dw2min, velmin, rgrav - use cires_ugwp_module, only : frcrit, ricrit, linsat, hps, rhp1, rhp2 - use cires_ugwp_module, only : kvg, ktg, krad, kion - use ugwp_oro_init, only : coro , fcrit_sm , fcrit_sm2 - implicit none -! - integer, intent(in) :: krefj, levs - real , intent(in) :: tauogw, tautot, kxw - real , intent(in) :: fcor - - real , dimension(levs+1) :: tau_src - - real, dimension(levs) , intent(in) :: up, vp, tp, qp, dp, zpm - real, dimension(levs+1), intent(in) :: zpi, pmid, pint - real , intent(in) :: xn, yn, umag - real , intent(in) :: kxridge - - - real, dimension(levs), intent(out) :: drtau, kdis -! -! locals -! - real :: uref, udir, uf2, ufd, uf2p - real, dimension(levs+1) :: tauz - real, dimension(levs) :: rho - real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi - - integer :: i, j, k, kcrit, kref - real :: kx2, kx2w, kxs - real :: mkzm, mkz, dkz, mkz2, ch, kzw3 - real :: wfdM, wfdT, wfiM, wfiT - real :: fdis, mkzi, keff_m, keff_t - real :: betadis, betam, betat, cdfm, cdft - real :: fsat, hsat, hsat2, kds , c2f2 - - drtau(1:levs) = 0.0 - kdis (1:levs) = 0.0 - - ch = coro - - kx2w = kxw*kxw - kx2 = kxridge*kxridge - if( kx2 < kx2w ) kx2 = kx2w - kxs = sqrt(kx2) - c2f2 = fcor*fcor/kx2 -! -! non-hydrostatic LinSatDis for Ch = 0 (with set of horizontal wavenumber kxw) -! -! print *, krefj, levs, tauogw, tautot , ' orolsatdis ' - call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) -!=============================================================================== -! for stationary oro-GWs only "single"-azimuth cd = 0 -(-Udir) = Udir > 0 -! rotational/non-hyrostatic effects are important only for high-res runs -! Udir = 0, Udir < 0 are not -! future"revisions" shear effects for d mkz /dt = -kxw*dU/dz -! horizontal wavelength spectra mkz2 = l2 -kxw(n)*kxw(n) -! stochastic "tauogw'-setup+ sigma_tau ; -! 3D-wave effects 1+ (k/l)^2 and NS vs EW orowaves -! target is to get "multiple"-saturation levels for OGWs -!=============================================================================== - tauz(1:krefj) = tauogw ! constant flux for OGW-packet or single mode - ! sign of tauz > 0...and its attenuate with Z - k = krefj - uref = ui(k)*xn +vi(k)*yn - ch ! stationary waves - uf2 = uref*uref - c2f2 - if (uf2 > 0) then - mkz2 = bn2i(k)/uf2 -kx2 - if (mkz2.gt.0) then - mkzm = sqrt(mkz2) - else - return ! wave reflection mkz2 <=0. - endif - else - return ! wave absorption uf2 <= 0. - endif -! -! upward solver for single "mode" with tauz(levs+1) =0. at the top -! - kds = 0.1* kvg(krefj) ! eddy wave diffusion from the previous layer - kcrit = levs - do k= krefj+1, levs -! -! 2D-wave propagation along reference-wind direction -! udir = 0 critical wind for coro =0 -! cdop = -uref .... upwind waves travel against MF -! - udir = ui(k)*xn +vi(k)*yn - uf2 = udir*udir - c2f2 - - - if (uf2 < dw2min .or. udir <= 0.0) then - kcrit =K - tauz(kcrit:levs) = 0. - exit ! vert-level loop - endif -! -! wave-based solution -! - mkz2 = bn2i(k)/uf2 -kx2 - if (mkz2 > 0) then - mkzm = sqrt(mkz2) -! -! do dissipative flux vs saturation: kvg, ktg, krad, kion -! - kzw3 = mkzm*mkz2 -! - keff_m = kvg(k)*mkz2 + kion(k) -! keff_t = kturb(k)*iPr_turb + kmol(k)*iPr_mol - keff_t = ktg(k)*mkz2 + krad(k) -! -! - uf2p = uf2 + 2.0*c2f2 - betadis = uf2/uf2p - betaM = 1.0 / (1.0+betadis) ! if c2f2 = 0. betaM = betaT =0.5 ekw = epw - betaT = 1.0- BetaM - -! -!imaginary frequencies of momentum and heat with "kds at (k-1) level" -! - wfiM = kds*mkz2 + keff_m - wfiT = kds*mkz2 + keff_t -! - cdfm = sqrt(uf2)*kxs - cdft = abs(udir)*kxs - wfdM = wfiM/cdfm *BetaM - wfdT = wfiT/Cdft *BetaT - mkzi = 2.0*mkzm*(wfdM+wfdT) - - fdis = tauz(k-1)*exp(-mkzi*(zpi(k)-zpi(k-1)) ) - tauz(k) = fdis - hsat2 = fcrit_sm2 * uf2 *bn2i(k) - fsat = rhoi(k)* hsat2 * sqrt(uf2) * bvi(k) - if (fdis > fsat) then - tauz(k) = min(fsat, tauz(k-1)) -!================================================================= -! two definitions for eddy mixing of MF: -! a) wave damping-Lindzen : Ked ~ kx/(2H)*(u-c)^4/N^3 -! b) heat-based turbulence: 4/3 Richardson Ked ~eps^1/3 *Lt^4/3 -!================================================================= - kds = rhp2*kxs*uf2*uf2/bn2i(k)/bvi(k) - kdis(k) = kds - endif - else - tauz(k:levs) = 0. ! wave is reflected above - kds = 0. - endif - enddo - - do k=krefj+1, kcrit - drtau(k) = rgrav*(tauz(k+1)-tauz(k))/dp(k) - enddo -! -! - end subroutine ugwp_oro_lsatdis -! -! - subroutine ugwp_tofd(im, levs, sigflt, elvmax, zpbl, u, v, zmid, & - utofd, vtofd, epstofd, krf_tofd) - use machine , only : kind_phys - use ugwp_common , only : rcpd2 - use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd -! - implicit none -! - integer :: im, levs - real(kind_phys), dimension(im, levs) :: u, v, zmid - real(kind_phys), dimension(im) :: sigflt, elvmax, zpbl - real(kind_phys), dimension(im, levs) :: utofd, vtofd, epstofd, krf_tofd -! -! locals -! - integer :: i, k - real :: sgh = 30. - real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, zexp, krf -! - utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 -! - - do i=1, im - - zdec = max(n_tofd*sigflt(i), zpbl(i)) - zdec = min(ze_tofd, zdec) - rzdec = 1.0/zdec - sgh2 = max(sigflt(i)*sigflt(i), sgh*sgh) - - do k=1, levs - zmet = zmid(i,k) - if (zmet > ztop_tofd) cycle - ekin = u(i,k)*u(i,k) + v(i,k)*v(i,k) - umag = sqrt(ekin) - zarg = zmet*rzdec - zexp = exp(-zarg*sqrt(zarg)) - krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *zexp - utofd(i,k) = -krf*u(i,k) - vtofd(i,k) = -krf*v(i,k) - epstofd(i,k)= rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" - ! to update momentum and temp-re - krf_tofd(i,k) = krf - enddo - enddo -! - end subroutine ugwp_tofd -! -! - subroutine ugwp_tofd1d(levs, sigflt, elvmax, zsurf, zpbl, u, v, & - zmid, utofd, vtofd, epstofd, krf_tofd) - use machine , only : kind_phys - use ugwp_common , only : rcpd2 - use ugwp_oro_init, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd -! - implicit none - integer :: levs - real(kind_phys), dimension(levs) :: u, v, zmid - real(kind_phys) :: sigflt, elvmax, zpbl, zsurf - real(kind_phys), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd -! -! locals -! - integer :: i, k - real :: sghmax = 5. - real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, ztexp, krf -! - utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 -! - zdec = max(n_tofd*sigflt, zpbl) ! ntimes*sgh_turb or Zpbl - zdec = min(ze_tofd, zdec) ! cannot exceed 18 km - rzdec = 1.0/zdec - sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! 25 meters dz-of the first layer - - do k=1, levs - zmet = zmid(k)-zsurf - if (zmet > ztop_tofd) cycle - ekin = u(k)*u(k) + v(k)*v(k) - umag = sqrt(ekin) - zarg = zmet*rzdec - ztexp = exp(-zarg*sqrt(zarg)) - krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *ztexp - - utofd(k) = -krf*u(k) - vtofd(k) = -krf*v(k) - epstofd(k) = rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" - ! to update momentum and temp-re; epstofd(k) can be skipped - krf_tofd(k) = krf - enddo -! - end subroutine ugwp_tofd1d diff --git a/physics/cires_vert_orodis_v1.F90 b/physics/cires_vert_orodis_v1.F90 deleted file mode 100644 index 852c114b0..000000000 --- a/physics/cires_vert_orodis_v1.F90 +++ /dev/null @@ -1,1047 +0,0 @@ -module cires_vert_orodis_v1 - - -contains - - -! subroutine ugwp_drag_mtb -! subroutine ugwp_taub_oro -! subroutine ugwp_oro_lsatdis -! - subroutine ugwp_drag_mtb( iemax, nz, & - elvpd, elvp, hprime , sigma, theta, oc, oa4, clx4, gam, zpbl, & - up, vp, tp, qp, dp, zpm, zpi, pmid, pint, idxzb, drmtb,taumtb) - - use ugwp_common_v1, only : bnv2min, grav, grcp, fv, rad_to_deg, dw2min, velmin, rdi - use ugwp_oro_init_v1, only : nridge, cdmb, fcrit_mtb, frmax, frmin, strver - - implicit none -!======================== -! several versions for drmtb => high froude mountain blocking -! version 1 => vay_2018 ; -! version 2 => kdn_2005 ; Kim & Doyle in NRL-2005 -! version 3 => ncep/gfs-2017 -gfs_2017 with lm1997 -!======================== -! real, parameter :: Fcrit_mtb = 0.7 - - integer, intent(in) :: nz - integer, intent(in) :: iemax ! standard ktop z=elvpd + 4 * hprime - real , intent(out) :: taumtb - - integer , intent(out) :: idxzb - real, dimension(nz), intent(out) :: drmtb - - real, intent(in) :: elvp, elvpd !elvp = min (elvpd + sigfac * hprime(j), hncrit=10000meters) - real, intent(in) :: hprime , sigma, theta, oc, oa4(4), clx4(4), gam - real, intent(in) :: zpbl - - real, dimension(nz), intent(in) :: up, vp, tp, qp, dp, zpm, pmid - real, dimension(nz+1), intent(in) :: zpi, pint - - ! character(len=*), intent(out) :: errmsg - ! integer, intent(out) :: errflg -! - real, dimension(nz+1) :: zpi_zero - real, dimension(nz) :: zpm_zero - real :: vtj, rhok, bnv2, rdz, vtkp, vtk, dzp - - real, dimension(nz) :: bn2, uds, umf, cosang, sinang - - integer :: k, klow, ktop, kpbl - real :: uhm, vhm, bn2hm, rhohm, & - mtb_fix, umag, bnmag, frd_src, & - zblk, who_iz_normal, rlm97, & - phiang, ang, pe, ek, & - cang, sang, ss2, cs2, zlen, dbtmp, & - hamp, bgamm, cgamm - - - ! Initialize CCPP error handling variables - ! errmsg = '' - ! errflg = 0 - -!================================================== -! -! elvp + hprime <=>elvp + nridge*hprime, ns =2 -! ns = sigfac -! tau_parel & tau_normal along major "axes" -! -! options to block the "flow", choices for [klow, ktop] -! -! 1-directional (normal) & 2-directional "blocking" -! -!================================================== -! no - blocking: drmtb(1:nz) = 0.0 -!================= - idxzb = -1 - drmtb(1:nz) = 0.0 - taumtb = 0.0 - klow = 2 - - ktop = iemax - hamp = nridge*hprime - -! reminder: cdmb = 4.0 * 192.0/float(imx)*cdmbgwd(1) Lellipse= a/2=sigma/hprime - - mtb_fix = cdmb*sigma/hamp !hamp ~ 2*hprime and 1/sigfac = 0.25 is inside 1/hamp - - ! if (mtb_fix == 0.) then - ! write(errmsg,'(*(a))') cdmb, sigma, hamp, ' MTB == 0' - ! errflg = 1 - ! return - ! endif - - if (strver == 'vay_2018') then - - zpm_zero = zpm - zpi(1) - zpi_zero = zpi - zpi(1) - - do k=1, nz-1 - if (hamp .le. zpi_zero(k+1) .and. (hamp .gt. zpi_zero(k) ) ) then - ktop = k+1 !......simply k+1 next interface level - exit - endif - enddo -! print *, klow, ktop, ' klow-ktop ' - call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - bn2, uhm, vhm, bn2hm, rhohm) - - umag = max(sqrt(uhm*uhm + vhm*vhm), velmin) !velmin=dw2min =1.0 m/s - ! if (bn2hm .le. 0.0) then - ! write(errmsg,'(*(a))') 'unstable MF for MTB - RETURN ' - ! errflg = 1 - ! return ! unstable PBL - ! end if - - bnmag =sqrt(bn2hm) - - frd_src = min(hamp*bnmag/umag, frmax) ! frmax =10. - -! print *, frd_src, Fcrit_mtb/frd_src, ' no-Blocking > 1 ' -! - if ( frd_src .le. Fcrit_mtb) RETURN ! no-blocking, although on small ridges with weak winds can be blocking -! -! zblk > 0 -! Fcrit_mtb > Fcrit_ogw h_clip = Fr_mtb*U/N ! h_hill minus h_clip = zblk -! - zblk = hamp*(1. - Fcrit_mtb/frd_src) - idxzb =1 - do k = 2, ktop - - if ( zblk < zpm_zero(k) .and. zblk >= zpm_zero(k-1)) then - idxzb = k - exit - endif - enddo -! - if (idxzb == 1) RETURN ! first surface level block is not "important" - - if (idxzb > 1) then ! let start with idxzb = 2....and up with LM1997 -! -! several options to compute MTB-drag: a) IFS_1997 ; b) WRF_KD05 ; c) SJM_2000 -! - bgamm = 1.0 - 0.18*gam -0.04*gam*gam - cgamm = 0.48*gam +0.3*gam*gam - - do k = 1, idxzb-1 - zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) - - umag = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) - - phiang = atan(vp(k)/umag) -! theta -90/90 - ang = theta - phiang - cang = cos(ang) ; sang = sin(ang) - - who_iz_normal = max(cang, gam*sang ) !gfs-2018 - - cs2 = cang* cang ; ss2 = 1.-cs2 - - rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! ... (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it -! - if (rlm97 > 2.0 ) rlm97 = 2.0 ! zero mtb-friction at this level -! - - who_iz_normal = bgamm*cs2 + cgamm*ss2 ! LM1997/IFS - - dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal - if (dbtmp < 0) dbtmp = 0.0 -! -! several approximation can be made to implement MTB-drag -! as a "nonlinear level dependent"-drag or "constant"-drag -! uds(k) == umag = const between the 1-layer and idxzb -! - - drmtb(k) = dbtmp * abs(umag) ! full mtb-drag = -drmtb(k) * uds = -kr*u - taumtb = taumtb - drmtb(k)*umag *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) -! -! 2-wave appr for anisotropic drmtb_Bellipse(k) and drmtb_Aell(k) can be used -! with Umag-projections on A & B ellipse axes -! mtb_fix =0.25*cdmb*sigma/hprime, -! in SM-2000 mtb_fix~ 1/8*[cdmb_A, cdmb_B]*sigma/hprimesum ( A+B) = 1/4. -! -!333 format(i4, 7(2x, F10.3)) -! write(6,333) , k, zpm_zero(k), zblk, hamp*Fcrit_mtb/frd_src, taumtb*1.e3, drmtb(k) , -drmtb(k)*up(k)*1.e5 - enddo -! - endif - endif ! strver=='vay_2018' -! -! -! - if (strver == 'kdn_2005' .or. strver == 'wrf_2018' ) then - - print *, ' kdn_2005 with # of hills ' -! -! compute flow-blocking stress based on WRF 'gwdo2d' -! - endif -! -! - if (strver == 'gfs_2018') then - - ktop = iemax; klow = 2 - - call um_flow(nz, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - bn2, uhm, vhm, bn2hm, rhohm) - if (bn2hm <= 0.0) RETURN ! unstable PBL -!--------------------------------------------- -! -!'gfs_2018' .... does not rely on Fr_crit -! and Fr-regimes -!----gfs17 for mtn ignores "averaging of the flow" -! for MTB-part it is only works with "angles" -! no projections on [uhm, vhm] -direction -! kpbl can be used for getting high values of iemax-hill -!----------------------------------------------------------- - zpm_zero = zpm - zpi(1) - zpi_zero = zpi - zpi(1) - do k=1, nz-1 - if (zpbl .le. zpm_zero(k+1) .and. (zpbl .ge. zpm_zero(k) ) ) then - kpbl = k+1 - exit - endif - enddo - - do k = iemax, 1, -1 - - uds(k) = max(sqrt(up(k)*up(k) + vp(k)*vp(k)), velmin) - phiang = atan(vp(k)/uds(k)) - ang = theta - phiang - cosang(k) = cos(ang) - sinang(k) = sin(ang) - - if (idxzb == 0) then - pe = pe + bn2(k) * (elvp - zpm(k)) *(zpi(k+1) - zpi(k)) - umf(k) = uds(k) * cosang(k) ! normal to main axis - ek = 0.5 * umf(k) * umf(k) -! -! --- dividing stream lime is found when pe =>exceeds ek first from the "top" -! - if (pe >= ek) idxzb = k - exit - endif - enddo - -! idxzb = min(kpbl, idxzb) -! -! -! -! last: mtb-drag -! - if (idxzb > 1) then - zblk = zpm(idxzb) - print *, zpm(idxzb)*1.e-3, ' mtb-gfs18 block-lev km ', idxzb, iemax, int(elvp) - do k = idxzb-1, 1, -1 -! - zlen = sqrt( (zblk - zpm_zero(k) ) / ( zpm_zero(k) +hprime )) - cs2 = cosang(k)* cosang(k) - ss2 = 1.-cs2 - rlm97 =(gam * cs2 + ss2)/ (cs2 + gam * ss2) ! (cs2 + gam * ss2) / (gam * cs2 + ss2) ! check it - - who_iz_normal = max(cosang(k), gam*sinang(k)) -! -! high res-n higher mtb 0.125 => 3.5 ; (negative of db -- see sign at tendency) -! - dbtmp = mtb_fix* max(0., 2.- rlm97)*zlen*who_iz_normal - - drmtb(k) = dbtmp * abs(uds(k)) ! full mtb-drag = -drmtb(k) * uds = -kr*u -! - taumtb = taumtb - drmtb(k) * uds(k) *rdi * pmid(k)/tp(k)*(zpi(k+1)-zpi(k)) -! - enddo - endif - endif ! strver=='gfs17' -! -! - end subroutine ugwp_drag_mtb -! -! -! ugwp_taub_oro - Computes [taulin, taufrb, drlee(levs) ] -! -! - subroutine ugwp_taub_oro(levs, izb, kxw, tau_izb, fcor, & - hprime , sigma, theta, oc, oa4, clx4, gamm, & - elvp, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, xn, yn, umag, & - tautot, tauogw, taulee, drlee, tau_src, kxridge, kdswj, krefj, kotr) -! - use ugwp_common_v1, only : bnv2min, grav, pi, pi2, dw2min, velmin - use ugwp_common_v1, only : mkz2min, mkzmin - use cires_ugwp_module_v1, only : frcrit, ricrit, linsat - use ugwp_oro_init_v1, only : hpmax, cleff, frmax - use ugwp_oro_init_v1, only : nwdir, mdir, fdir - use ugwp_oro_init_v1, only : efmin, efmax , gmax, cg, ceofrc - use ugwp_oro_init_v1, only : fcrit_sm, fcrit_gfs, frmin, frmax - use ugwp_oro_init_v1, only : coro, nridge, odmin, odmax - use ugwp_oro_init_v1, only : strver -! - use ugwp_oro_init_v1, only : zbr_pi -! --- -! -! define oro-GW fluxes: taulin, taufrb amd if kdswj > 0 (LWB-lee wave breaking) -! approximate for drlee-momentum tendency -! --- - implicit none -! - integer, intent(in) :: levs, izb - real , intent(in) :: tau_izb ! integrated (1:izb) drag -Kr_mtb*U, or Zero - integer, intent(out) :: kdswj, krefj, kotr - integer :: klwb - real, intent(in) :: kxw, fcor - real, intent(in) :: hprime, sigma, theta, oc, gamm, elvp - -! - real, intent(in) :: oa4(4), clx4(4) - - real, dimension(levs), intent(in) :: up, vp, tp, qp, dp - real, dimension(levs+1), intent(in) :: zpi, pint - real, dimension(levs ), intent(in) :: zpm, pmid -! - real,dimension(levs), intent(out) :: drlee - real,dimension(levs+1), intent(out) :: tau_src -! - real, intent(out) :: tauogw, tautot, taulee - real :: taulin, tauhcr, taumtb - real, intent(out) :: xn, yn, umag, kxridge -! -! -! locals -! four possible versions to compute "taubase as a function of Fr-number" -! character :: strver='smc_2000' ! 'kd_2005', 'gfs_2017', 'vay_2018' -! - real, dimension(levs+1) :: zpi_zero - - real :: oa, clx, odir, cl4p(4), clxp - - real :: uhm, vhm, bn2hm, rhohm, bnv - - real :: elvpMTB, wdir - real :: tem, efact, coefm, kxlinv, gfobnv - - real :: fr, frlin, frlin2, frlin3, frlocal, dfr - real :: betamax, betaf, frlwb, frmtb - integer :: klow, ktop, kph - - integer :: i, j, k, nwd, ind4, idir - - real :: sg_ridge, kx2, umd2 - real :: mkz, mkz2, zbr_mkz, mkzi - - real :: hamp ! clipped hprime*elvmax/elv_clip > hprime - real :: hogw ! hprime or hamp for free-prop OGWs z > z(krefj) - real :: hdsw ! empirical like DNS amplitudes for Lee-dsw trapped waves - real :: hcrit - real :: hblk ! blocking div-stream height - - real :: coef_h2, frnorm - - - real, dimension(levs) :: bn2 - real :: rho(levs) - real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi - real, dimension(levs+1) :: umd, phmkz - real :: c2f2, umag2, dzwidth, udir - real :: hogwi, hdswi, hogwz, hdswz ! height*height wave-amp - real :: uogwi, udswi, uogwz, udswz ! wind2 wave-rms - real, dimension(levs+1) :: dtrans, deff - real :: pdtrans - logical :: do_klwb_phase = .false. ! phase-crireria for LLWB of SM00 - logical :: do_dtrans = .true. ! dissipative saturation to deposit momentum - ! between ZMTB => ZHILL -!----------------------------------------------------------------------------- -! -! downslope/lee/GW wave regimes kdswj: between ZMTB and ZOGW(krefj) -! ZMTB < ZOGW = ns*HPRIME < ELVP -! define krefj as a level for OGWs above ZMTB and "2-3-4*hprime" + ZMTB -! we rely on the concept of the "CLIPPED-SG" mountain above ZMTB & new -! inverse Froude number for the "mean flow" averaged from ZMTB to ZOGW -! here we can use "elvp" as only for hprime adjustment ...elvp/elvp_MTB -! -!"empirical" specification of tauwave = taulee+tauogw in [ZMTB : ns*HPRIME] -! can be based on numerical runs like WRF-model -! for Frc < Fr< [Frc : 2.5-3 Frc] -! see suggestions proposed in SM-2000 and Eckermann et al. (2010) -!----------------------------------------------------------------------------- - tautot = 0. ; taulin = 0. ; taulee = 0. ; drlee(1:levs) = 0. ; tau_src = 0.0 - krefj = 1 ; kotr = levs+1; kdswj = 1 - xn = 1.0 ; yn = 0. ; umag = velmin; kxridge = kxw - - dtrans = 0. ; deff =0. - klow = 2 - elvpMTB = elvp -! -! clipped mountain H-zmtb for estimating wave-regimes new Fr and MF above ZMTB -! - if (izb > 0 ) then - klow = izb - elvpMTB = max(elvp - zpi(izb), 0.0) - endif - if (elvpMTB <=0 ) print *, ' blocked flow ' - if (elvpMTB <=0 ) return ! "blocked flow" from the surface to elvMAX - - zpi_zero(:) = zpi(:) - zpi(1) - hblk = zpi_zero(klow) - - sg_ridge = max( nridge*hprime * (elvp/elvpMTB), hblk+hprime*0.333) - -! -! enhance sg_ridge by elvp/elvpMTB >1 and H_clip = H-hiilnew - zblk later for hamp -! - sg_ridge = min(sg_ridge, hpmax) - -! print *, 'sg_ridge ', sg_ridge - - do k=1, levs - if (sg_ridge .gt. zpi_zero(k) .and. ( sg_ridge .le. zpi_zero(k+1) ) ) then - ktop = k+1 - exit - endif - enddo - - krefj = ktop ! the mountain top index for sg_ridge = ns*hprime - -! if ( izb > 0 .and. krefj .le. izb) then -! print *, izb, krefj, sg_ridge, zpi_zero(izb), ' izb >ktop ' -! endif - -! -! here ktop displays sg_ridge-position not elvP !!!! klow =2 to avoid for 127-126L -! instability due to extreme "thin" layer...128L-model needs cruder vertical resolution -! - call um_flow(levs, klow, ktop, up, vp, tp, qp, dp, zpm, zpi, pmid, pint, & - bn2, uhm, vhm, bn2hm, rhohm) - - call get_unit_vector(uhm, vhm, xn, yn, umag) - - if (bn2hm <= 0.0) RETURN ! "unstable/neutral" hill need different treatment - bnv = sqrt(bn2hm) - hamp = sg_ridge-zpi_zero(klow) ! hamp >= nridge*hprime due higher SG-elevations - zblk or first layer - hogw = hamp - hdsw = hamp - - - fr = bnv * hamp /umag - fr = min(fr, frmax) - kxridge = max(sigma/hamp, kxw) ! to get rid from "SSO-errors" kxw-provides max-value for kx - kx2 = kxridge*kxridge - umag = max( umag, velmin) - c2f2 = fcor*fcor/kx2 - umag2 = umag*umag - c2f2 - - if (umag2 <= 0.0) RETURN ! Coriolis cut-off at high-mid latitudes for low kx - - mkz2 = bn2hm/umag2 - kx2 ! we add Coriolis corrections for crude model resolutions "low-kx" - ! and non-stationary waves coro, fcor for small umag - ! bn2hm/[(coro-umag)^2 -fc2/kx2] - kx2, cf = fc/kx => 2 m/s to 11 m/s for 60deg - IF (mkz2 < mkz2min .or. krefj <= 2 ) THEN -! -! case then no effects of wave-orography -! - krefj = 1 ; kdswj = 1; kotr = levs ; klwb = 1 - tautot = 0. - tauogw = 0. - taulee = 0. - drlee = 0. ; tau_src(1:levs+1) = 0. - return - ENDIF -!========================================================================= -! find orographic asymmetry and convexity :'oa/clx' for clipped SG-hill -! nwd 1 2 3 4 5 6 7 8 -! wd w s sw nw e n ne se -! make sure that SM_00 and KD_05 oro-characteristics can match each other -! OD-KDO5 = Gamma=a/b [0:2] ; hsg = 2.*hprime -! OC-KD05 mount sharpness sigma^4 "height to half-width"[0:1] -! alph-SM00 fraction of h2d contributed to hprime [0:1] -! -! OA-KDO5 OA > dwstream OA=0 sym OA < 0 upstram [-1. 0. 1] -! delt-SM00 dw/up asymmetry -1 < delta < 1 -! Gamma-LM97 anisotropy of the orography g2 =(dh/dx)^2/(dh/dy)^2 -!.. -!A parametrization of low-level wave breaking which includes a dependence on -!the degree of 2-dimensionality of SG; it is active over a finite range of Fr -!========================================================================= - wdir = atan2(uhm,vhm) + pi - idir = mod( int(fdir*wdir),mdir) + 1 - - nwd = nwdir(idir) - ind4 = mod(nwd-1,4) + 1 - if (ind4 < 1 ) ind4 = 1 - if (ind4 > 4 ) ind4 = 4 - - oa = ( 1-2*int( (nwd-1)/4 )) * oa4(ind4) - clx = clx4(ind4) - cl4p(1) = clx4(2) - cl4p(2) = clx4(1) - cl4p(3) = clx4(4) - cl4p(4) = clx4(3) - clxp = cl4p(ind4) - - odir = clxp/max(clx, 1.e-5) ! WRF-based definition for "odir" - - odir = min(odmax, odir) - odir = max(odmin, odir) - - - if (strver == 'smc_2000' .or. strver == 'vay_2018') then -!========================================================================= -! -! thrree-piece def-n for tautot(Fr): 0-Fr_lin - Fr_lee -Fr_mtb -! taulin/tauogw taulee taumtb -! here tau_src(levs+1): approximate wave flux from surface to LLWB -! Following attempts of Scinocca +McFarlane, 2000 & Eckermann etal.(2010) -!========================================================================= -! -! if (mkz2 < 0)... mkzi = sqrt(-mkz2) trapped wave regime don't a case in UGWP-V1 -! wave flux ~ rho_src*kx_src/mkz_src*wind_rms -! bn2, uhm, vhm, bn2hm, rhohm -! -! IF (mkz2.ge. mkz2min .and. krefj > 2 ) THEN -! -! wave regimes -! - mkz = sqrt(mkz2) - frlwb = fcrit_sm ! should be higher than LOGW to get zblk < zlwb - frlin = fcrit_sm - frlin2 = 1.5*fcrit_sm - frlin3 = 3.0*fcrit_sm - - hcrit = fcrit_sm*umag/bnv - hogw = min(hamp, hcrit) - hdsw = min(hamp, frlwb*umag/bnv) ! no trapped-wave solution - - coef_h2 = kxridge * rhohm * bnv * umag - - taulin = coef_h2 * hamp*hamp - tauhcr = coef_h2 * hcrit*hcrit - - IF (fr < frlin ) then - tauogw = taulin - taulee = 0.0 - taumtb = 0.0 - else if (fr .ge. frlin ) then - tauogw = tauhcr - taulin = coef_h2 * hamp*hamp - taumtb = tau_izb ! integrated form MTB -! -! SM-2000 approach for taulee, shall we put limits on BetaMax_max ~ 20 or Betaf ?? -! - frnorm = fr/fcrit_sm ! frnorm below [1.0 to 3.0] - BetaMax = 1.0 + 2.0*OC ! alpha of SM00 or OC-mountain sharphess KD05 OC=[10, 0] - - if ( fr <= frlin2 ) then - Betaf= 2.*BetaMax*(frNorm-1.0) - taulee = (1. + Betaf )*taulin - tauhcr - else if ( (fr > frlin2).and.(fr <= frlin3))then - Betaf=-1.+ 1./frnorm/frnorm + & - (BetaMax + 0.555556)*(2.0 - 0.666*frnorm)* (2.0 - 0.666*frnorm) - taulee = (1. + Betaf )*taulin - tauhcr -!============== -! Eck-2010 WRF-alternatve through Dp_surf = P'*grad(h(x,y)) -! 1 < Fr < 2.5 tauwave = taulee+tauogw = tau_dp*(fr)**(-0.9) -! Fr > 2.5 tauwave = tau_dp*(2.5)**(-0.9) -! to apply it need tabulated Dp(fr, Dlin) Dp=function(Dlin, U, N, h) -! -!============== - else - taulee = 0.0 - hdsw = 0.0 - endif - ENDIF - - tautot = tauogw + taulee + taumtb*0. - - IF (taulee > 0.0 ) THEN - - hdsw = sqrt(tautot/coef_h2) ! averaged value for hdsw - mixture of lee+ogw with mkz/kxridge -! -! compute vertical profile "drlee" with the low-level wave breaking & "locally" trapped waves -! make "empirical" height above elvp that may represent DSW-wave breaking & trapping -! here we will assign tau_sso(z) profile between: zblk(zsurf) - zlwb - ztop_sso = ns*sridge -! - call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) - - kph = max(izb, 2) ! kph marks the low-level of wave solutions - klwb = kph ! klwb above blocking marks wave-breaking - kotr = levs+1 ! kotr marks mkz2(z) <= 0., reflection level - - if (do_dtrans) pdtrans = log(tautot/tauogw)/(zpi(krefj) - zpi(kph)) - - udir = max(ui(krefj)*xn +vi(krefj)*yn, velmin) - hogwi = hogw*hogw* rhohm/rhoi(krefj) * umag/udir * bnv/bvi(krefj) - umd(krefj) = udir - - udir = max(ui(kph)*xn +vi(kph)*yn, velmin) - hdswi = hdsw*hdsw* rhohm/rhoi(kph) * umag/udir * bnv/bvi(kph) - umd(kph) = udir - ! what we can put between k =[kph:krefj] - phmkz(:) = 0.0 ! - phmkz(kph-1) = fr ! initial Phase of the low-level wave -! -! now transfer tau_layer => tau_level assuming tau_layer = tau_level -! kx*rho_layer*bn_layer*u_layer* HL*HL = kx*rho_top*bn_top*u_top * HT*HT -! apply it for both hdsw & hogw with linear saturation-solver for Cx =0 -! - loop_lwb_otr: do k=kph+1, krefj ! levs - - umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) - umd2 =(coro- umd(k))*(coro- umd(k)) - umd2 = max(umd2, dw2min) -c2f2 - - - if (umd2 <= 0.0) then -! -! critical layer -! - klwb = k - kotr = k - exit loop_lwb_otr - endif - - mkz2 = bn2i(k)/umd2 - kx2 - - if ( mkz2 >= mkz2min ) then -! -! find klwb having some "kinematic" phase "break-down" crireria SM00 or LM97 -! at finest vertical resolution we can meet "abrupt" mkz -! mkzmax = 6.28/(2*dz), mkzmin = 6.28/ztrop=18km -! to regularize SG-solution mkz = max(mkzmax, min(mkz,in, mkz)) -! - mkz = sqrt(mkz2) - hdswz = hdswi* rhoi(k-1)/rhoi(k) * umd(k-1)/umd(k) * bvi(k-1)/bvi(k) - udswz = hdswz *bn2i(k) -!=========================================================================================== -!linsat wave ampl.: mkz*sqrt(hdswz) <= 1.0 or udswz <= linsat2*umd2 -! -! tautot = tausat = rhoi(k) *udswz_sat * kxridge/mkz -! by k = krefj tautot = tauogw(krefj) -!=========================================================================================== - if (do_klwb_phase) then - phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) - if( ( phmkz(k) .ge. zbr_pi).and.(klwb == kph)) then - klwb = min(k, krefj) - exit loop_lwb_otr - endif - endif - else ! mkz2 < mkz2min - kotr = k ! trapped/reflected waves / - exit loop_lwb_otr - endif - enddo loop_lwb_otr -! -! define tau_src(1:zblk:klwb) = sum(tau_oro+tau_dsw+tau_ogw) and define drlee -! tau_trapped ??? -! - if (do_klwb_phase) then - do k=kph, kotr-1 - - if (klwb > kph .and. k < klwb) then - drlee(k) = (tautot -tauogw)/(zpi(kph) - zpi(klwb)) ! negative Ax*rho - tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) - drlee(k) = drlee(k)/rho(k) - else if ( k >= klwb .and. k < kotr) then - tau_src(k) = tauogw - drlee(k) = 0.0 - endif - enddo - kdswj = klwb ! assign to the "low-level" wave breaking - endif -! -! simplest exponential transmittance d(tau)/dz = - pdtrans *tau(z) -! more complicated is dissipative saturation pdtrans =/= constant -! - if (do_dtrans) then - do k=kph, krefj - tau_src(k)= tautot*exp(-pdtrans*(zpi(k)-zpi(kph))) - drlee(k) = -tau_src(k)/rho(k) * pdtrans - enddo - endif - - - ENDIF !taulee > 0.0 - - - endif !strver -! - -!========================================================================= - if (strver == 'gfs_2018' .or. strver == 'kd_2005') then -!========================================================================= -! -! orowaves: OGW+DSW/Lee -! - efact = (oa + 2.0) ** (ceofrc*fr) - efact = min( max(efact,efmin), efmax ) - coefm = (1. + clx) ** (oa+1.) - - kxlinv = min (kxw, coefm * cleff) ! does not exceed 42km ~4*dx - kxlinv = coefm * cleff - tem = fr * fr * oc - gfobnv = gmax * tem / ((tem + cg)*bnv) ! g/n0 -!========================================================================= -! source fluxes: taulin, taufrb -!========================================================================= - tautot = kxlinv * rhohm * umag * umag *umag* gfobnv * efact - - coef_h2 = kxlinv *rhohm * bnv*umag - taulin = coef_h2 *hamp*hamp - hcrit = fcrit_gfs*umag/bnv - tauhcr = coef_h2 *hcrit*hcrit - - IF (fr <= fcrit_gfs) then - tauogw = taulin - tautot = taulin - taulee = 0. - drlee(:) = 0. - ELSE !fr > fcrit_gfs - tauogw = tauhcr - taulee = max(tautot - tauogw, 0.0) - if (taulee > 0.0 ) hdsw = sqrt(taulee/coef_h2) -! approximate drlee(k) between [izb, klwb] -! find klwb and decrease taulee(izb) => taulee(klwb) = 0. -! above izb tau - if (mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0) then - - mkz = sqrt(mkz2) - call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) - - kph = max(izb, 2) - phmkz(:) = 0.0 - klwb = max(izb, 1) - kotr = levs+1 - phmkz(kph-1) = fr ! initial Phase of the Lee-OGW - - loop_lwb_gfs18: do k=kph, levs - - umd(k) = max(ui(k)*xn +vi(k)*yn, velmin) - umd2 =(coro- umd(k))*(coro- umd(k)) - umd2 = max(umd2, velmin*velmin) - mkz2 = bn2i(k)/umd2 - kx2 - if ( mkz2 > mkz2min ) then - mkz = sqrt(mkz2) - frlocal = max(hdsw*bvi(k)/umd(k), frlwb) - phmkz(k) = phmkz(k-1) + mkz*(zpm(k)-zpm(k-1)) - if( ( phmkz(k) >= zbr_pi ) .and. (frlocal > frlin)) klwb = k - else - kotr = k - exit loop_lwb_gfs18 - endif - enddo loop_lwb_gfs18 -! -! - do k=kph, kotr-1 - - if (klwb > kph .and. k < klwb) then - drlee(k) = -(tautot -tauogw)/(zpi(kph) - zpi(klwb)) - tau_src(k) = tautot + (zpi(k) - zpi(klwb))*drlee(k) - drlee(k) = drlee(k)/rho(k) - else if ( k >= klwb .and. k < kotr) then - tau_src(k) = tauogw - drlee(k) = 0.0 - endif - enddo - kdswj = klwb ! assign to the "low-level" wave breaking - endif ! mkz2 > mkz2min.and. krefj > 2 .and. taulee > 0.0 - ENDIF !fr > fcrit_gfs - - - ENDIF !strbase='gfs2017' .or. strbase='kd_2005' - - -! output : taulin, taufrb, taulee, xn, yn, umag, kxw/kxridge -! print *, krefj, levs, tauogw, tautot , ' ugwp_taub_oro ' -! - end subroutine ugwp_taub_oro -! -!-------------------------------------- -! -! call ugwp_oro_lsatdis( krefj, levs, tauogw(j), tautot(j), tau_src, & -! con_pi, con_g, kxw, fcor(j), c2f2(j), up, vp, tp, qp, dp, zpm, zpi, & -! pmid1, pint1, xn, yn, umag, drtau, kdis_oro) - - subroutine ugwp_oro_lsatdis( krefj, levs, tauogw, tautot, tau_src, & - pi, grav, kxw, fcor, kxridge, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, xn, yn, umag, drtau, kdis) - - use ugwp_common_v1, only : dw2min, velmin - use cires_ugwp_module_v1, only : frcrit, ricrit, linsat, hps, rhp1, rhp2 - use cires_ugwp_module_v1, only : kvg, ktg, krad, kion - use ugwp_oro_init_v1, only : coro , fcrit_sm , fcrit_sm2 - implicit none -! - integer, intent(in) :: krefj, levs - real , intent(in) :: tauogw, tautot, kxw - real , intent(in) :: fcor - - real , dimension(levs+1) :: tau_src - - real, intent(in) :: pi, grav - - real, dimension(levs) , intent(in) :: up, vp, tp, qp, dp, zpm - real, dimension(levs+1), intent(in) :: zpi, pmid, pint - real , intent(in) :: xn, yn, umag - real , intent(in) :: kxridge - - - real, dimension(levs), intent(out) :: drtau, kdis -! -! locals -! - real :: bnv2min, pi2, rgrav - real :: uref, udir, uf2, ufd, uf2p - real, dimension(levs+1) :: tauz - real, dimension(levs) :: rho - real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi - - integer :: i, j, k, kcrit, kref - real :: kx2, kx2w, kxs - real :: mkzm, mkz, dkz, mkz2, ch, kzw3 - real :: wfdM, wfdT, wfiM, wfiT - real :: fdis, mkzi, keff_m, keff_t - real :: betadis, betam, betat, cdfm, cdft - real :: fsat, hsat, hsat2, kds , c2f2 - - pi2 = 2.0*pi - bnv2min = (pi2/1800.)*(pi2/1800.) - rgrav = 1.0/grav - - drtau(1:levs) = 0.0 - kdis (1:levs) = 0.0 - - ch = coro - - kx2w = kxw*kxw - kx2 = kxridge*kxridge - if( kx2 < kx2w ) kx2 = kx2w - kxs = sqrt(kx2) - c2f2 = fcor*fcor/kx2 -! -! non-hydrostatic LinSatDis for Ch = 0 (with set of horizontal wavenumber kxw) -! -! print *, krefj, levs, tauogw, tautot , ' orolsatdis ' - call mflow_tauz(levs, up, vp, tp, qp, dp, zpm, zpi, & - pmid, pint, rho, ui, vi, ti, bn2i, bvi, rhoi) -!=============================================================================== -! for stationary oro-GWs only "single"-azimuth cd = 0 -(-Udir) = Udir > 0 -! rotational/non-hyrostatic effects are important only for high-res runs -! Udir = 0, Udir < 0 are not -! future"revisions" shear effects for d mkz /dt = -kxw*dU/dz -! horizontal wavelength spectra mkz2 = l2 -kxw(n)*kxw(n) -! stochastic "tauogw'-setup+ sigma_tau ; -! 3D-wave effects 1+ (k/l)^2 and NS vs EW orowaves -! target is to get "multiple"-saturation levels for OGWs -!=============================================================================== - tauz(1:krefj) = tauogw ! constant flux for OGW-packet or single mode - ! sign of tauz > 0...and its attenuate with Z - k = krefj - uref = ui(k)*xn +vi(k)*yn - ch ! stationary waves - uf2 = uref*uref - c2f2 - if (uf2 > 0) then - mkz2 = bn2i(k)/uf2 -kx2 - if (mkz2.gt.0) then - mkzm = sqrt(mkz2) - else - return ! wave reflection mkz2 <=0. - endif - else - return ! wave absorption uf2 <= 0. - endif -! -! upward solver for single "mode" with tauz(levs+1) =0. at the top -! - kds = 0.1* kvg(krefj) ! eddy wave diffusion from the previous layer - kcrit = levs - do k= krefj+1, levs -! -! 2D-wave propagation along reference-wind direction -! udir = 0 critical wind for coro =0 -! cdop = -uref .... upwind waves travel against MF -! - udir = ui(k)*xn +vi(k)*yn - uf2 = udir*udir - c2f2 - - - if (uf2 < dw2min .or. udir <= 0.0) then - kcrit =K - tauz(kcrit:levs) = 0. - exit ! vert-level loop - endif -! -! wave-based solution -! - mkz2 = bn2i(k)/uf2 -kx2 - if (mkz2 > 0) then - mkzm = sqrt(mkz2) -! -! do dissipative flux vs saturation: kvg, ktg, krad, kion -! - kzw3 = mkzm*mkz2 -! - keff_m = kvg(k)*mkz2 + kion(k) -! keff_t = kturb(k)*iPr_turb + kmol(k)*iPr_mol - keff_t = ktg(k)*mkz2 + krad(k) -! -! - uf2p = uf2 + 2.0*c2f2 - betadis = uf2/uf2p - betaM = 1.0 / (1.0+betadis) ! if c2f2 = 0. betaM = betaT =0.5 ekw = epw - betaT = 1.0- BetaM - -! -!imaginary frequencies of momentum and heat with "kds at (k-1) level" -! - wfiM = kds*mkz2 + keff_m - wfiT = kds*mkz2 + keff_t -! - cdfm = sqrt(uf2)*kxs - cdft = abs(udir)*kxs - wfdM = wfiM/cdfm *BetaM - wfdT = wfiT/Cdft *BetaT - mkzi = 2.0*mkzm*(wfdM+wfdT) - - fdis = tauz(k-1)*exp(-mkzi*(zpi(k)-zpi(k-1)) ) - tauz(k) = fdis - hsat2 = fcrit_sm2 * uf2 *bn2i(k) - fsat = rhoi(k)* hsat2 * sqrt(uf2) * bvi(k) - if (fdis > fsat) then - tauz(k) = min(fsat, tauz(k-1)) -!================================================================= -! two definitions for eddy mixing of MF: -! a) wave damping-Lindzen : Ked ~ kx/(2H)*(u-c)^4/N^3 -! b) heat-based turbulence: 4/3 Richardson Ked ~eps^1/3 *Lt^4/3 -!================================================================= - kds = rhp2*kxs*uf2*uf2/bn2i(k)/bvi(k) - kdis(k) = kds - endif - else - tauz(k:levs) = 0. ! wave is reflected above - kds = 0. - endif - enddo - - do k=krefj+1, kcrit - drtau(k) = rgrav*(tauz(k+1)-tauz(k))/dp(k) - enddo -! -! - end subroutine ugwp_oro_lsatdis -! -! - subroutine ugwp_tofd(im, levs, con_cp, sigflt, elvmax, zpbl, u, v, zmid, & - utofd, vtofd, epstofd, krf_tofd) - use machine , only : kind_phys - use ugwp_oro_init_v1, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd -! - implicit none -! - integer :: im, levs - real(kind_phys) :: con_cp - real(kind_phys), dimension(im, levs) :: u, v, zmid - real(kind_phys), dimension(im) :: sigflt, elvmax, zpbl - real(kind_phys), dimension(im, levs) :: utofd, vtofd, epstofd, krf_tofd -! -! locals -! - integer :: i, k - real :: rcpd2 - real :: sgh = 30. - real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, zexp, krf -! - utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 - rcpd2 = 0.5/con_cp -! - - do i=1, im - - zdec = max(n_tofd*sigflt(i), zpbl(i)) - zdec = min(ze_tofd, zdec) - rzdec = 1.0/zdec - sgh2 = max(sigflt(i)*sigflt(i), sgh*sgh) - - do k=1, levs - zmet = zmid(i,k) - if (zmet > ztop_tofd) cycle - ekin = u(i,k)*u(i,k) + v(i,k)*v(i,k) - umag = sqrt(ekin) - zarg = zmet*rzdec - zexp = exp(-zarg*sqrt(zarg)) - krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *zexp - utofd(i,k) = -krf*u(i,k) - vtofd(i,k) = -krf*v(i,k) - epstofd(i,k)= rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" - ! to update momentum and temp-re - krf_tofd(i,k) = krf - enddo - enddo -! - end subroutine ugwp_tofd -! -! - subroutine ugwp_tofd1d(levs, con_cp, sigflt, elvmax, zsurf, zpbl, u, v, & - zmid, utofd, vtofd, epstofd, krf_tofd) - use machine , only : kind_phys - use ugwp_oro_init_v1, only : n_tofd, const_tofd, ze_tofd, a12_tofd, ztop_tofd -! - implicit none - integer :: levs - real(kind_phys) :: con_cp - real(kind_phys), dimension(levs) :: u, v, zmid - real(kind_phys) :: sigflt, elvmax, zpbl, zsurf - real(kind_phys), dimension(levs) :: utofd, vtofd, epstofd, krf_tofd -! -! locals -! - integer :: i, k - real :: rcpd2 - real :: sghmax = 5. - real :: sgh2, ekin, zdec, rzdec, umag, zmet, zarg, ztexp, krf -! - utofd =0.0 ; vtofd = 0.0 ; epstofd =0.0 ; krf_tofd =0.0 - rcpd2 = 0.5/con_cp -! - zdec = max(n_tofd*sigflt, zpbl) ! ntimes*sgh_turb or Zpbl - zdec = min(ze_tofd, zdec) ! cannot exceed 18 km - rzdec = 1.0/zdec - sgh2 = max(sigflt*sigflt, sghmax*sghmax) ! 25 meters dz-of the first layer - - do k=1, levs - zmet = zmid(k)-zsurf - if (zmet > ztop_tofd) cycle - ekin = u(k)*u(k) + v(k)*v(k) - umag = sqrt(ekin) - zarg = zmet*rzdec - ztexp = exp(-zarg*sqrt(zarg)) - krf = const_tofd* a12_tofd *sgh2* zmet ** (-1.2) *ztexp - - utofd(k) = -krf*u(k) - vtofd(k) = -krf*v(k) - epstofd(k) = rcpd2*krf*ekin ! more accurate heat/mom form using "implicit tend-solver" - ! to update momentum and temp-re; epstofd(k) can be skipped - krf_tofd(k) = krf - enddo -! - end subroutine ugwp_tofd1d - - -end module cires_vert_orodis_v1 diff --git a/physics/cires_vert_wmsdis.F90 b/physics/cires_vert_wmsdis.F90 deleted file mode 100644 index 9e0bbf37c..000000000 --- a/physics/cires_vert_wmsdis.F90 +++ /dev/null @@ -1,425 +0,0 @@ - subroutine ugwp_wmsdis_naz(levs, ksrc, nw, naz, kxw, taub_lat, ch, xaz, yaz, & - fcor, c2f2, dp, zmid, zint, pmid, pint, rho, ui, vi, ti, & - kvg, ktg, krad, kion, bn2i, bvi, rhoi, ax, ay, eps, ked, tau1) -! -! -! use para_taub, only : tau_ex - use ugwp_common, only : rcpd, grav, rgrav - implicit none -! - integer :: levs - integer :: nw, naz ! # - waves for each azimuth (naz) - integer :: ksrc ! source level - real :: kxw ! horizontal wn - real :: taub_lat ! lat-dep tau_bulk N/m2 -! - real, dimension(nw) :: ch, dch, taub_spect - real, dimension(naz) :: xaz, yaz - real, dimension(levs+1) :: ui, vi, ti, bn2i, bvi, rhoi, zint, pint - real, dimension(levs ) :: dp, rho, pmid, zmid - real :: fcor, c2f2 - real, dimension(levs+1) :: kvg, ktg, kion, krad, kmol - -! output/locals - real, dimension(levs ) :: ax, ay, eps - real, dimension(levs+1) :: ked , tau1 - real, dimension(levs+1 ) :: uaz - - real, dimension(levs, naz ) :: epsd - real, dimension(levs+1, naz ) :: atau, kedd - - real, dimension(levs+1 ) :: taux, tauy, bnrho - real, dimension(levs ) :: dzirho , dzpi - -! - integer :: iaz, k , inc - real, parameter :: gcstar=1.0 - integer , parameter :: nslope=1 - real :: spnorm ! source level normalization factor for the Broad Spectra - real :: bnrhos ! sum(taub_spect*dc) = spnorm taub_sect_norm = taub_spect/spnorm -! - atau=0.0 ; epsd=0.0 ; kedd=0.0 - bnrhos = bvi(ksrc)/rhoi(ksrc) - do k=1,levs - dzpi(k) = zint(k+1)-zint(k) - dzirho(k) = 1.0 / (rho(k)*dzpi(k)) ! grav/abs(dp(k)) still hydrostatic "ugwp" - bnrho(k) = (rhoi(k)/bvi(k)) !*bnrhos * gcstar ! gcstar=1.0 and bnrho(k=ksrc) =1. - enddo - k = levs+1 - bnrho(k) = (rhoi(k)/bvi(k))*bnrhos -! -! re-define ch, dch, taub_spect, this portion can be moved to "ugwp_init" -! -! -! - call FVS93_ugwps(nw, ch, dch, taub_spect, spnorm, nslope, bn2i(ksrc), bvi(ksrc), bnrho(ksrc)) - - -! print *, ' after FVS93_ugwp ', nw, maxval(ch), minval(ch) -! -! do normaalization for the spectral element of the saturated flux -! - bnrho = bnrho *spnorm - -! print * -! do inc=1, nw -! write(6,221) inc, ch(INC),taub_lat*taub_spect(inc), spnorm, dch(inc) -!221 FORMAT( i6, 2x, F8.2, 3(2x, E10.3)) -! enddo -! pause - - loop_iaz: do iaz =1, naz - - do k=1,levs+1 - uaz(k) =ui(k)*xaz(iaz) +vi(k)*yaz(iaz) - enddo -! -! -! multi-wave broad spectrum of FVS-93 with ~scheme of WMS-IFS 2010 -! -! print *, ' iaz before ugwp_wmsdis_az1 ', iaz -! - - call ugwp_wmsdis_az1(levs, ksrc, nw, kxw, ch, dch, taub_spect, taub_lat, & - spnorm, fcor, c2f2, zmid, zint, rho, uaz, ti, bn2i, bvi, rhoi, bnrho, dzirho, dzpi, & - kvg, ktg, krad, kion, kmol, epsd(:, iaz), kedd(:,iaz), atau(:, iaz) ) - -! print *, ' iaz after ugwp_wmsdis_az1 ', iaz - -! - enddo loop_iaz ! azimuth of gw propagation directions -! -! sum over azimuth and project atau(z, iza) =>(taux and tauy) -! for scalars for "wave-drag vector" -! - eps =0. ; ked =0. - do k=ksrc, levs - eps(k) = sum(epsd(k,:))*rcpd - enddo - - do k=ksrc, levs+1 - taux(k) = sum( atau(k,:)*xaz(:)) - tauy(k) = sum( atau(k,:)*yaz(:)) - ked(k) = sum( kedd(k,:)) - enddo -! - tau1(ksrc:levs) = taux(ksrc:levs) - tau1(1:ksrc-1) = tau1(ksrc) - -! end solver: gw_azimuth_solver_ls81 -! sign ax in rho*du/dt = -d(rho*tau)/dz -! [(k) - (k+1)] -! du/dt = ax = -1/rho*d( tau) /dz -! - ax =0. ; ay = 0. - - do k=ksrc, levs - ax(k) = dzirho(k)*(taux(k)-taux(k+1)) - ay(k) = dzirho(k)*(tauy(k)-tauy(k+1)) - enddo - call ugwp_limit_1d(ax, ay, eps, ked, levs) - - return - end subroutine ugwp_wmsdis_naz - - -! ======================================================================= - subroutine ugwp_wmsdis_az1(levs, ksrc, nw, kxw, ch, dch, taub_sp, tau_bulk, & - spnorm, fcor, c2f2, zm, zi, rho, um, tm, bn2, bn, rhoi, bnrho, & - dzirho, dzpi, kvg, ktg, krad, kion, kmol, eps, ked, tau ) -! -! use para_taub, only : tau_ex, xlatdeg !for exchange src-tau -! - use cires_ugwp_module, only : f_coriol, f_nonhyd, f_kds, linsat - use cires_ugwp_module, only : ipr_ktgw, ipr_spgw, ipr_turb, ipr_mol - use cires_ugwp_module, only : rhp4, rhp2, rhp1, khp, cd_ulim -! ======================================================================= - integer :: levs, ksrc, nw - real :: fcor, c2f2, kxw -! - real, dimension(nw) :: taub_sp, ch, dch - real :: tau_bulk, spnorm - real, dimension(levs) :: zm, rho, dzirho, dzpi - real, dimension(levs+1) :: zi, um, tm, bn2, bn, rhoi, bnrho - real, dimension(levs+1) :: kvg, ktg, krad, kion, kmol - real, dimension(levs+1) :: ked, tau - real, dimension(levs ) :: eps -! -!locals - integer :: k, inc - real, dimension(levs+1) :: umi - real :: zcin, zci_min, ztmp, zcinc - real :: zcimin=0.5 ! crit-level precision, 0.5 and start of Ch_MIN - real, parameter :: Keff = 0.2 - - real, dimension(nw) :: zflux ! - real, dimension(nw) :: wzact, zacc ! =1 ..crit level change it - - real, dimension(levs) :: zcrt ! - real, dimension(nw, levs) :: zflux_z, zact - - real :: zdelp, kxw2 - real :: vu_eff, vu_lin, v_kzw, v_cdp, v_wdp, v_kzi - real :: dfsat, fdis, fsat, fmode, expdis - real :: vc_zflx_mode, vm_zflx_mode - real :: tau_g5 -! ======================================================================= -!eps, ked, tau - - eps (:) =0; ked = 0.0 ; - kxw2 = kxw*kxw -! - zcrt(1:levs) = 0.0 - umi(1:levs+1) = um -! umi(1:levs+1) = um(1:levs+1) -um(ksrc) - - zci_min = zcimin - -! CALL slat_geos5(1, xlatdeg(1), tau_g5) -! tau_bulk = tau_g5 !tau_bulk*0.75 !3.75e-2 -! - zflux(:) = taub_sp(:)*tau_bulk ! includes tau_bulk(x,y) and spectral normalization - - zflux_z(1:nw,ksrc)=zflux(:) - - tau(1:levs+1) = tau_bulk ! constant flux for all layers k0.0 ) then -! ztmp = sum( ch(:)*zacc(:)*zflux(:)*dch(:) ) -! zcrt(k)=ztmp/tau(k) -! else -! zcrt( k )=zcrt(k-1) -! endif -! --------------------------------------------------------- -! do saturation (eq. (26) and (27) of scinocca 2003) -! + add molecular/eddy dissipation od gw-spectra vay-2015 -! for each mode & direction -! x by exp(-mi*zdelp) x introduce ....... mi(nw) -! -! mode-loop + add molecular/eddy dissipation od gw-spectra vay-2015 -! - do inc=1,nw - if (zact(inc,k) == 0.0) then - zflux(inc) = 0.0 - zflux_z(inc,k) = zflux(inc) - else - vu_eff = kvg(k) ! + ktg (k) !* ipr_ktgw - vu_lin = kion(k) ! + krad(k) !* ipr_ktgw - vu_eff = 2.e-5*exp(zi(k)/7000.)+.01 - zcin= ch(inc) - -!======================================================================= -! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat -! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) -! define kxw = -!======================================================================= - v_cdp = zcin-umi(k) - v_wdp = kxw*v_cdp - if (v_wdp.gt.0) then - v_kzw = bn(k)/v_cdp !can be non-hydrostatic - v_kzi = abs(( v_kzw*v_kzw*vu_eff + vu_lin) /v_wdp*v_kzw) - expdis = exp(-2.*v_kzi*dzpi(k) ) - else - v_kzi = 0. - expdis = 1.0 - endif - fmode = zflux(inc) - fdis = fmode*expdis ! only dissipation/crit_lev degrades it -!------------------------ -! includes rho/bn /(rhos/bns) *spnorm -!------------------------ - fsat = bnrho(k)* v_cdp*v_cdp /zcin ! expression for saturated flux - ! zfluxs=gcstar*zfct( k)*(zcin-zui( k ))**2/zcin -! flux_tot - sat.flux -! - dfsat= fdis-fsat - if( dfsat > 0.0 ) then -! put sat-n limit - zflux(inc) = fsat - else -! assign dis-ve flux - zflux(inc) =fdis - endif - zflux_z(inc,k)=zflux(inc) - - if (zflux_z(inc,k) > zflux_z(inc,k-1) ) zflux_z(inc,k) = zflux_z(inc,k-1) - - endif - - enddo -! -! integrate over spectral modes zpu(y, z, azimuth) zact( inc, )*zflux( inc, )*[d("zcinc")] -! - tau(k) = sum( zflux_z(:,k)*dch(:)) -!------------------------------------------------------------------------------ -! define expressions for eps-heat + Ked, needs more work for the broad spectra -! formulation especially for Ked -! after defining Ked .....GW-eddy cooling needs to be added -! for now "only" heating here -!============================================================================== - eps(k) =0. - do inc=1, nw - if (zact(inc,k) == 0.0) cycle ! dc-integration + dtau/dz - vc_zflx_mode = zflux(inc) - - zdelp= abs(ch(inc)-umi(k)) * dch(inc) /dzpi(k) - vm_zflx_mode=zflux_z(inc,k-1) - eps(k) =eps( k ) + (vm_zflx_mode-vc_zflx_mode)*zdelp ! heating >0 - - - enddo !inc=1, nw - ked(k) = Keff*eps(k)/bn2(k) -! -! -------------- -! - enddo ! end k do-loop vertical loop do k=ksrc+1, levs - -!top lid - k =levs+1 - ked(k) = ked(k-1) -! eps(k) = eps(k-1) - tau(k) =tau(k-1)*0.933 - -! from surface to ksrc-1 -! tau(1:ksrc) = tau(ksrc) - ked(1:ksrc) = 0. - eps( 1:ksrc) = 0. - -! -! output: eps, ked, tau for given azimuth -! - end subroutine ugwp_wmsdis_az1 -! -! - subroutine FVS93_ugwps(nw, ch, dch, taub_sp, spnorm, nslope, bn2, bn, bnrhos) - implicit none - integer :: nw, nslope - real :: bn2, bn, bnrhos -!! real :: taub_lat ! bulk - lat-dep momentum flux - real, dimension (nw) :: ch, dch, taub_sp -! locals - integer :: i, inc - real, parameter :: zcimin = 0.5, zcimax = 95.0, zgam =1./4. - real, parameter :: zms = 6.28e-3/2. ! mstar Lz ~ 2km - real :: zxran, zxmax, zxmin, zx1, zx2, zdx, ztx, rch - real :: bn3, bn4, zcin, tn4, tn3, tn2, cstar - real :: spnorm ! needs to be passed for saturation flux norm-n - real :: tau_bulk -!-------------------------------------------------------------------- -! -! transforms ch -uniform => 1/ch and back to non-uniform ch, dch -! -!------------------------------------------------------------------- -! note that this is expresed in terms of the intrinsic ch or vertical wn=N/cd -! at launch cd=ch-um(ksrc), the transformation is identical for all -! levels, azimuths and horizontal pixels -! see eq. 28-30 of scinocca 2003. x = 1/c stretching transform -! - zxmax=1.0 /zcimin - zxmin=1.0 /zcimax - zxran=zxmax-zxmin - zdx=zxran/float(nw-1) ! d_kz or d_mi -! -! - zx1=zxran/(exp(zxran/zgam)-1.0 ) !zgam =1./4. - zx2=zxmin-zx1 -! -! add idl computations for zci =1/zx -! x = 1/c stretching transform to look at final ch(i), dch(i) -! - - do i=1, nw - ztx=float(i-1)*zdx+zxmin - rch=zx1*exp((ztx-zxmin)/zgam)+zx2 !eq. 29 of scinocca 2003 - ch(i)=1.0 /rch !eq. 28 of scinocca 2003 - dch(i)=ch(i)*ch(i)*(zx1/zgam)*exp((ztx-zxmin)/zgam)*zdx !eq. 30 of scinocca 2003 - enddo -! -! nslope-dependent flux taub_spect(nw) momentum flux spectral density -! need to check math....expressions -! eq. (25) of scinocca 2003 with u-uo=0 it is identical to all azimuths -! -! - cstar=bn/zms - bn4=bn2*bn2 ! four times - bn3=bn2*bn - if(nslope==1) then -! s=1 case - do inc=1, nw - zcin=ch(inc) - tn4=(zms*zcin)**4 - taub_sp(inc) =bnrhos * zcin*bn4/(bn4+tn4) - enddo -! - elseif(nslope==2) then -! s=2 case - do inc=1, nw - zcin=ch(inc) - tn4=(zms*zcin)**4 - taub_sp(inc)= bnrhos*zcin*bn4/(bn4+tn4*zcin/cstar) - enddo -! - elseif(nslope==-1) then -! s=-1 case - do inc=1, nw - zcin=ch(inc) - tn2=(zms*zcin)**2 - taub_sp(inc)=bnrhos*zcin*bn2/(bn2+tn2) - enddo -! s=0 case - elseif(nslope==0) then - - do inc=1, nw - zcin=ch(inc) - tn3=(zms*zcin)**3 - taub_sp(inc)=bnrhos*zcin*bn3/(bn3+tn3) - enddo - endif ! for n-slopes -!============================================= -! normalize launch momentum flux -! ------------------------------------ -! (rho x f^h = rho_o x f_p^total) integrate (zflux x dx) - - tau_bulk= sum(taub_sp(:)*dch(:)) - spnorm= 1./tau_bulk - - do inc=1, nw - taub_sp(inc)=spnorm*taub_sp(inc) - enddo - - end subroutine FVS93_ugwps - diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index c47079992..abb78e7a6 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1,266 +1,3 @@ -! - module sso_coorde -! -! specific to COORDE-2019 project OGW switches/sensitivity -! to diagnose SSO effects pgwd=1 (OGW is on) =0 (off) -! pgd4=4 (4 timse taub, control pgwd=1) -! - use machine, only: kind_phys - real(kind=kind_phys),parameter :: pgwd = 1.0_kind_phys - real(kind=kind_phys),parameter :: pgwd4 = 1.0_kind_phys - logical, parameter :: debugprint = .false. - end module sso_coorde -! -! -! Routine cires_ugwp_driver_v0 is replaced with cires_ugwp.F90/cires_ugwp_run in CCPP -#if 0 - subroutine cires_ugwp_driver_v0(me, master, - & im, levs, nmtvr, dtp, kdt, imx, do_ugwp, do_tofd, - & cdmbgwd, xlat, xlatd, sinlat, coslat, spgrid, - & ugrs, vgrs, tgrs, qgrs, prsi, prsl, prslk, - & phii, phil, del, hprime, oc, oa4, clx, theta, - & gamm, sigma, elvmax, sgh30, kpbl, - & dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, - & tau_tofd, tau_mtb, tau_ogw, tau_ngw, - & zmtb, zlwb, zogw, du3dt_mtb,du3dt_ogw, du3dt_tms,rdxzb, - & rain, ntke, tke, lprnt, ipr) -!----------------------------------------------------------- -! Part 1 "old-revised" gfs-gwdps_v0 or "old" gwdps (if do_ugwp=.false.) -! Part 2 non-stationary multi-wave GWs FV3GFS-v0 -! Part 3 Dissipative version of UGWP-tendency application -! (similar to WAM-2017) -!----------------------------------------------------------- - use machine, only : kind_phys - use physcons, only : con_cp, con_g, con_rd, con_rv, & - con_omega - - use ugwp_wmsdis_init, only : tamp_mpa, ilaunch - use sso_coorde, only : pgwd, pgwd4, debugprint - implicit none -!input - - integer, parameter :: kp = kind_phys - - integer, intent(in) :: me, master - integer, intent(in) :: im, levs, kdt, imx, nmtvr, ntke, ipr - - real(kind=kind_phys), intent(in) :: dtp, cdmbgwd(4) - logical :: do_ugwp, do_tofd, lprnt - integer, intent(in) :: kpbl(im) - real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlatd - &, sgh30, sinlat, coslat, spgrid ! spgrid = tile-area - &, rain - - real(kind=kind_phys), intent(in), dimension(im,levs) :: - &, ugrs, vgrs, tgrs, qgrs, prsl, prslk, phil, del - real(kind=kind_phys), intent(in), dimension(im,levs+1) :: - & phii, prsi - -! real(kind=kind_phys), intent(in) :: oro_stat(im,nmtvr) - real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc - &, theta, gamm, sigma, elvmax - real(kind=kind_phys), intent(in), dimension(im,4) :: oa4, clx - real(kind=kind_phys), intent(in) :: tke(im,levs) -!out - real(kind=kind_phys), dimension(im,levs) :: gw_dudt, gw_dvdt - &, gw_dTdt, gw_kdis - -!-----locals + diagnostics output - - real(kind=kind_phys), dimension(im,levs) :: Pdvdt, Pdudt - &, Pdtdt, Pkdis, ed_dudt, ed_dvdt, ed_dTdt - - real(kind=kind_phys), dimension(im) :: dusfcg, dvsfcg - - real(kind=kind_phys), dimension(im) :: rdxzb, zmtb, - & zlwb, zogw, tau_mtb, tau_ogw, tau_tofd, tau_ngw, turb_fac - real(kind=kind_phys), dimension(im,levs) :: du3dt_mtb, du3dt_ogw - &, du3dt_tms - real(kind=kind_phys), dimension(im) :: tem - -! locals - real(kind=kind_phys) :: rfac, tx1 - integer :: i, j, k, ix -! -! define hprime, oc, oa4, clx, theta, sigma, gamm, elvmax -! -! real(kind=kind_phys), dimension(im) :: hprime, -! & oc, theta, sigma, gamm, elvmax -! real(kind=kind_phys), dimension(im, 4) :: clx, oa4 -! -! switches that activate impact of OGWs and NGWs along with eddy diffusion -! - real(kind=kind_phys), parameter :: pogw=1.0_kp, pngw=1.0_kp - &, pked=1.0_kp, zero=0.0_kp - &, ompked=1.0_kp-pked -! -! switches for GW-effects: pogw=1 (OGWs) pngw=1 (NGWs) pked=1 (eddy mixing) -! - if (me == master .and. kdt < 2 .and. debugprint) then - print * - write(6,*) 'FV3GFS execute ugwp_driver_v0 ' -! write(6,*) 'FV3GFS execute ugwp_driver_v0 nmtvr=', nmtvr - write(6,*) ' COORDE EXPER pogw = ' , pogw - write(6,*) ' COORDE EXPER pgwd = ' , pgwd - write(6,*) ' COORDE EXPER pgwd4 = ', pgwd4 - print * - endif - - do i=1,im - zlwb(i) = zero - enddo -! -! 1) ORO stationary GWs -! ------------------ - - if (do_ugwp .and. nmtvr == 14) then ! calling revised old GFS gravity wave drag - CALL GWDPS_V0(IM, levs, imx, do_tofd, - & Pdvdt, Pdudt, Pdtdt, Pkdis, - & ugrs , vgrs, tgrs, qgrs,KPBL, prsi,del,prsl, - & prslk, phii, phil, DTP,KDT, - & sgh30, HPRIME, OC, OA4, CLX, THETA, - & SIGMA, GAMM, ELVMAX, - & DUSFCg, DVSFCg, xlatd, sinlat, coslat, spgrid, - & cdmbgwd(1:2), me, master, rdxzb, - & con_g, con_omega, - & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, - & du3dt_mtb, du3dt_ogw, du3dt_tms) -! - if (me == master .and. kdt < 2 .and. debugprint) then - print * - write(6,*) 'FV3GFS finished gwdps_v0 in ugwp_driver_v0 ' - print * - endif - else ! calling old GFS gravity wave drag as is - do k=1,levs - do i=1,im - pdvdt(i,k) = zero - pdudt(i,k) = zero - pdtdt(i,k) = zero - pkdis(i,k) = zero - enddo - enddo - if (cdmbgwd(1) > zero.or. cdmbgwd(2) > zero) then - call gwdps(im, im, im, levs, Pdvdt, Pdudt, Pdtdt & - &, ugrs, vgrs, tgrs, qgrs & - &, kpbl, prsi, del, prsl, prslk, phii, phil, dtp, kdt& - &, hprime, oc, oa4, clx, theta, sigma, gamm & - &, elvmax, dusfcg, dvsfcg & - &, con_g, con_cp, con_rd, con_rv, imx & - &, nmtvr, cdmbgwd(1:2), me, lprnt, ipr, rdxzb) - endif - - tau_mtb = zero ; tau_ogw = zero ; tau_tofd = zero - du3dt_mtb = zero ; du3dt_ogw = zero ; du3dt_tms= zero - endif -! - if (cdmbgwd(3) > zero) then -! 2) non-stationary GWs with GEOS-5/MERRA GW-forcing -! ---------------------------------------------- -!-------- -! GMAO GEOS-5/MERRA GW-forcing lat-dep -!-------- - call slat_geos5_tamp(im, tamp_mpa, xlatd, tau_ngw) - -! call slat_geos5(im, xlatd, tau_ngw) -! - if (abs(1.0_kp-cdmbgwd(3)) > 1.0e-6_kp) then - if (cdmbgwd(4) > zero) then - do i=1,im - turb_fac(i) = zero - tem(i) = zero - enddo - if (ntke > 0) then - do k=1,(levs+levs)/3 - do i=1,im - turb_fac(i) = turb_fac(i) + del(i,k) * tke(i,k) - tem(i) = tem(i) + del(i,k) - enddo - enddo - do i=1,im - turb_fac(i) = turb_fac(i) / tem(i) - enddo - endif - rfac = 86400000 / dtp - do i=1,im - tx1 = cdmbgwd(4)*min(10.0, max(turb_fac(i),rain(i)*rfac)) - tau_ngw(i) = tau_ngw(i) * max(0.1_kp, min(5.0_kp, tx1)) - enddo - endif - do i=1,im - tau_ngw(i) = tau_ngw(i) * cdmbgwd(3) - enddo - endif -! - call fv3_ugwp_solv2_v0(im, levs, dtp, - & tgrs, ugrs, vgrs, qgrs, prsl, prsi, - & phil, xlatd, sinlat, coslat, - & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, - & tau_ngw, me, master, kdt) - - if (me == master .and. kdt < 2 .and. debugprint) then - print * - write(6,*)'FV3GFS finished fv3_ugwp_v0 in ugwp_driver_v0 ' - write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' - print * - endif - do k=1,levs - do i=1,im - gw_dtdt(i,k) = pngw*gw_dtdt(i,k) + pogw*Pdtdt(i,k) - gw_dudt(i,k) = pngw*gw_dudt(i,k) + pogw*Pdudt(i,k) - gw_dvdt(i,k) = pngw*gw_dvdt(i,k) + pogw*Pdvdt(i,k) - gw_kdis(i,k) = pngw*gw_kdis(i,k) + pogw*Pkdis(i,k) - enddo - enddo - else - do k=1,levs - do i=1,im - gw_dtdt(i,k) = Pdtdt(i,k) - gw_dudt(i,k) = Pdudt(i,k) - gw_dvdt(i,k) = Pdvdt(i,k) - gw_kdis(i,k) = Pkdis(i,k) - enddo - enddo - endif - - if (pogw == zero) then -! zmtb = 0.; zogw =0. - tau_mtb = zero ; tau_ogw = zero ; tau_tofd = zero - du3dt_mtb = zero ; du3dt_ogw = zero ; du3dt_tms= zero - endif - - return - -!============================================================================= -! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving -! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" -!============================================================================= -! -! 3) application of "eddy"-diffusion to "smooth" UGWP-related tendencies -!------------------------------------------------------------------------------ - do k=1,levs - do i=1,im - ed_dudt(i,k) = zero ; ed_dvdt(i,k) = zero ; ed_dtdt(i,k) = zero - enddo - enddo - - call edmix_ugwp_v0(im, levs, dtp, - & tgrs, ugrs, vgrs, qgrs, del, - & prsl, prsi, phil, prslk, - & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, - & ed_dudt, ed_dvdt, ed_dTdt, - & me, master, kdt ) - - do k=1,levs - do i=1,im - gw_dtdt(i,k) = gw_dtdt(i,k)*ompked + ed_dtdt(i,k)*pked - gw_dvdt(i,k) = gw_dvdt(i,k)*ompked + ed_dvdt(i,k)*pked - gw_dudt(i,k) = gw_dudt(i,k)*ompked + ed_dudt(i,k)*pked - enddo - enddo - - end subroutine cires_ugwp_driver_v0 -#endif ! !===================================================================== ! @@ -301,12 +38,12 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, !---------------------------------------- USE MACHINE , ONLY : kind_phys - use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 + use ugwp_common_v0,only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 &, pi, rad_to_deg, deg_to_rad, pi2 &, rdi, gor, grcp, gocp, fv, gr2 &, bnv2min, dw2min, velmin, arad - use ugwp_oro_init, only : rimin, ric, efmin, efmax + use ugwpv0_oro_init, only : rimin, ric, efmin, efmax &, hpmax, hpmin, sigfaci => sigfac &, dpmin, minwnd, hminmt, hncrit &, RLOLEV, GMAX, VELEPS, FACTOP @@ -315,11 +52,11 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, cdmb, cleff, fcrit_gfs, fcrit_mtb &, n_tofd, ze_tofd, ztop_tofd - use cires_ugwp_module, only : kxw, max_kdis, max_axyz - use sso_coorde, only : pgwd, pgwd4, debugprint + use cires_ugwpv0_module, only : kxw, max_kdis, max_axyz + !---------------------------------------- implicit none - integer, parameter :: kp = kind_phys + integer, parameter :: kp = kind_phys character(len=8) :: strsolver='PSS-1986' ! current operational solver or 'WAM-2017' integer, intent(in) :: im, km, imx, kdt integer, intent(in) :: me, master @@ -452,22 +189,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! sigmin = 2.*hpmin/dsmax !dxres ! Moorthi - this will not reproduce sigmin = 2.*hpmin/dxres !dxres -! if (kdt == 1) then -! print *, sgrmax, sgrmin , ' min-max sparea ' -! print *, 'sigmin-hpmin-dsmax', sigmin, hpmin, dsmax -! print *, 'dxres/dsmax ', dxres, dsmax -! print *, ' shilmin gammin ', shilmin, gammin -! endif - kxridge = float(IMX)/arad * cdmbgwd(2) - if (me == master .and. kdt == 1 .and. debugprint) then - print *, ' gwdps_v0 kxridge ', kxridge - print *, ' gwdps_v0 scale2 ', cdmbgwd(2) - print *, ' gwdps_v0 IMX ', imx - print *, ' gwdps_v0 GAM_MIN ', gammin - print *, ' gwdps_v0 SSO_MIN ', sso_min - endif + kxridge = float(IMX)/arad * cdmbgwd(2) do i=1,im idxzb(i) = 0 @@ -543,9 +267,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, endif enddo - IF (npt == 0 .and. debugprint) then -! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt -! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin + IF (npt == 0) then RETURN ! No gwd/mb calculation done endif @@ -918,16 +640,16 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, kxridge = 1.0 / sqrt(sparea(J)) XLINV(I) = XLINGFS !or max(kxridge, inv_b2eff) ! 6.28/Lx ..0.5*sigma(j)/heff = 1./Lridge taulin(i) = 0.5*ROLL(I)*XLINV(I)*BNV*ULOW(I)* - & heff*heff*pgwd4 + & heff*heff if ( FR > fcrit_gfs ) then TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) - & * ULOW(I) * GFOBNV * EFACT *pgwd4 ! nonlinear FLUX Tau0...XLINV(I) + & * ULOW(I) * GFOBNV * EFACT ! nonlinear FLUX Tau0...XLINV(I) ! else ! TAUB(I) = XLINV(I) * ROLL(I) * ULOW(I) * ULOW(I) - & * ULOW(I) * GFOBNV * EFACT *pgwd4 + & * ULOW(I) * GFOBNV * EFACT ! ! TAUB(I) = taulin(i) ! linear flux for FR <= fcrit_gfs ! @@ -1083,9 +805,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! --------------------------- IF( do_tofd ) then axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 - if ( kdt == 1 .and. me == 0 .and. debugprint) then - print *, 'VAY do_tofd from surface to ', ztop_tofd - endif + + DO I = 1,npt J = ipt(i) zpbl =rgrav*phil( j, kpbl(j) ) @@ -1099,8 +820,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, vp1(k) = v1(j,k) enddo - call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, - & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) + call ugwpv0_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, + & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) do k=1,km axtms(j,k) = utofd1(k) @@ -1151,8 +872,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! OGW-s above blocking height ! TAUD(I,K) = TAUD(I,K) * DTFAC(I) - DTAUX = TAUD(I,K) * XN(I) * pgwd - DTAUY = TAUD(I,K) * YN(I) * pgwd + DTAUX = TAUD(I,K) * XN(I) + DTAUY = TAUD(I,K) * YN(I) Pdvdt(j,k) = DTAUY +Pdvdt(j,k) Pdudt(j,k) = DTAUX +Pdudt(j,k) @@ -1185,97 +906,11 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, RETURN - -!============ debug ------------------------------------------------ - if (kdt <= 2 .and. me == 0 .and. debugprint) then - print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me -! - print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw_axoro' - print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw_ayoro' -! print *, maxval(kdis), minval(kdis), 'vgw_kdispro m2/sec' - print *, maxval(pdTdt)*86400., minval(pdTdt)*86400,'vgw_epsoro' - print *, maxval(zmtb), ' z_mtb ', maxval(tau_mtb), ' tau_mtb ' - print *, maxval(zogw), ' z_ogw ', maxval(tau_ogw), ' tau_ogw ' -! print *, maxval(tau_tofd), ' tau_tofd ' -! print *, maxval(axtms)*86400., minval(axtms)*86400, 'vgw_axtms' -! print *,maxval(dudt_mtb)*86400.,minval(dudt_mtb)*86400,'vgw_axmtb' - if (maxval(abs(pdudt))*86400. > 100.) then - - print *, maxval(u1), minval(u1), ' u1 gwdps-v0 ' - print *, maxval(v1), minval(v1), ' v1 gwdps-v0 ' - print *, maxval(t1), minval(t1), ' t1 gwdps-v0 ' - print *, maxval(q1), minval(q1), ' q1 gwdps-v0 ' - print *, maxval(del), minval(del), ' del gwdps-v0 ' - print *, maxval(phil)*rgrav,minval(phil)*rgrav, 'zmet' - print *, maxval(phii)*rgrav,minval(phii)*rgrav, 'zmeti' - print *, maxval(prsi), minval(prsi), ' prsi ' - print *, maxval(prsL), minval(prsL), ' prsL ' - print *, maxval(RO), minval(RO), ' RO-dens ' - print *, maxval(bnv2(1:npt,:)), minval(bnv2(1:npt,:)),' BNV2 ' - print *, maxval(kpbl), minval(kpbl), ' kpbl ' - print *, maxval(sgh30), maxval(hprime), maxval(elvmax),'oro-d' - print * - do i =1, npt - j= ipt(i) - print *,zogw(J)/hprime(j), zmtb(j)/hprime(j), - & phil(j,1)/9.81, nint(hprime(j)/sigma(j)) -! -!.................................................................... -! -! zogw/hp=5.9 zblk/hp=10.7 zm=11.1m ridge/2=2,489m/9,000m -! from 5 to 20 km , we need to count for "ridges" > dx/4 ~ 15 km -! we must exclude blocking by small ridges -! VAY-kref < iblk zogw-lev 15 block-level: 39 -! -! velmin => 1.0, 0.01, 0.1 etc.....unification of wind limiters -! MAX(SQRT(U1(J,K)*U1(J,K) + V1(J,K)*V1(J,K)), minwnd) -! MAX(DW2,DW2MIN) * RDZ * RDZ -! ULOW(I) = MAX(SQRT(UBAR(I)*UBAR(I) + VBAR(I)*VBAR(I)), 1.0) -! TEM = MAX(VELCO(I,K)*VELCO(I,K), 0.1) -! TEMV = 1.0 / max(VELCO(I,K), 0.01) -! & * max(VELCO(I,K),0.01) -!.................................................................... - enddo - print * - stop - endif - endif - -! - RETURN -!--------------------------------------------------------------- -! review of OLD-GFS code 2017/18 most substantial changes -! a) kref > idxzb if idxzb > KPBL "OK" clipped-hill for OGW -! b) tofd -sgh30 "OK" -! -! c) FR < Frc linear theory for taub-specification -! -! d) solver of Palmer et al. (1987) => Linsat of McFarlane -! -!--------------------------------------------------------------- end subroutine gwdps_v0 !=============================================================================== -! use fv3gfs-v0 -! first beta version of ugwp for fv3gfs-128 -! cires/swpc - jan 2018 -! non-tested wam ugwp-solvers in fv3gfs: "lsatdis", "dspdis", "ado99dis" -! they reqiure extra-work to put them in with intializtion and namelists -! next will be lsatdis for both fv3wam & fv3gfs-128l implementations -! with (a) stochastic-deterministic propagation solvers for wave packets/spectra -! (b) gw-sources: oro/convection/dyn-instability (fronts/jets/pv-anomalies) -! (c) guidance from high-res runs for GW sources and res-aware tune-ups -!23456 -! -! call gwdrag_wam(1, im, ix, km, ksrc, dtp, -! & xlat, gw_dudt, gw_dvdt, taux, tauy) -! call fv3_ugwp_wms17(kid1, im, ix, km, ksrc_ifs, dtp, -! & adt,adu,adv,prsl,prsi,phil,xlat, gw_dudt, gw_dvdt, gw_dtdt, gw_ked, -! & taux,tauy,grav, amol_i, me, lstep_first ) -! -! !23456============================================================================== !>\ingroup cires_ugwp_run @@ -1297,21 +932,19 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! use machine, only : kind_phys - use ugwp_common , only : rgrav, grav, cpd, rd, rv + use ugwp_common_v0 , only : rgrav, grav, cpd, rd, rv &, omega2, rcpd2, pi, pi2, fv &, rad_to_deg, deg_to_rad &, rdi, gor, grcp, gocp &, bnv2min, dw2min, velmin, gr2 ! - use ugwp_wmsdis_init, only : hpscale, rhp2, bv2min, gssec + use ugwpv0_wmsdis_init, only : hpscale, rhp2, bv2min, gssec &, v_kxw, v_kxw2, tamp_mpa, zfluxglob &, maxdudt, gw_eff, dked_min &, nslope, ilaunch, zmsi &, zci, zdci, zci4, zci3, zci2 &, zaz_fct, zcosang, zsinang - &, nwav, nazd, zcimin, zcimax - - use sso_coorde, only : debugprint + &, nwav, nazd, zcimin, zcimax ! implicit none !23456 @@ -1426,26 +1059,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, phil(j,k) = philg(j,k) * rgrav enddo enddo -!----------------------------------------------------------- -! also other options to alter tropical values -! tamp = 100.e-3*1.e3 = 100 mpa -! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 -!----------------------------------------------------------- -! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) - -! phil = philg*rgrav - -! rcpd = 1.0/(grav/cpd) ! 1/[g/cp] -! grav2cpd = grav*grav/cpd ! g*(g/cp)= g^2/cp - - if (kdt ==1 .and. mpi_id == master .and. debugprint) then - print *, maxval(tm1), minval(tm1), 'vgw: temp-res ' - print *, 'ugwp-v0: zcimin=' , zcimin - print *, 'ugwp-v0: zcimax=' , zcimax - print * - endif -! !================================================= do iazi=1, nazd do jk=1,klev @@ -1589,7 +1203,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo - endif ! for slopes + endif ! for slopes ! ! normalize momentum flux at the src-level ! ------------------------------ @@ -1866,257 +1480,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo ! !--------------------------------------------------------------------------- -! - if (kdt == 1 .and. mpi_id == master .and. debugprint) then - print *, 'vgw done ' -! - print *, maxval(pdudt)*86400, minval(pdudt)*86400, 'vgw ax' - print *, maxval(pdvdt)*86400, minval(pdvdt)*86400, 'vgw ay' - print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' - print *, maxval(pdtdt)*86400, minval(pdtdt)*86400,'vgw eps' -! -! print *, ' ugwp -heating rates ' - endif - return end subroutine fv3_ugwp_solv2_v0 -!------------------------------------------------------------------------------- -! -! Part-3 of UGWP-V01 Dissipative (eddy) effects of UGWP it will be activated -! after tests of OGW (new revision) and NGW with MERRA-2 forcing. -! -!------------------------------------------------------------------------------- - subroutine edmix_ugwp_v0(im, levs, dtp, - & t1, u1, v1, q1, del, - & prsl, prsi, phil, prslk, - & pdudt, pdvdt, pdTdt, pkdis, - & ed_dudt, ed_dvdt, ed_dTdt, - & me, master, kdt ) -! - use machine, only : kind_phys - use ugwp_common , only : rgrav, grav, cpd, rd, rdi, fv -! &, pi, rad_to_deg, deg_to_rad, pi2 - &, bnv2min, velmin, arad - - implicit none - - integer, intent(in) :: me, master, kdt - integer, intent(in) :: im, levs - real(kind=kind_phys), intent(in) :: dtp - real(kind=kind_phys), intent(in), dimension(im,levs) :: - & u1, v1, t1, q1, del, prsl, prslk, phil -! - real(kind=kind_phys), intent(in),dimension(im,levs+1):: prsi - real(kind=kind_phys),dimension(im,levs) :: pdudt, pdvdt, pdTdt - real(kind=kind_phys),dimension(im,levs) :: pkdis -! -! out -! - real(kind=kind_phys),dimension(im,levs) :: ed_dudt, ed_dvdt - real(kind=kind_phys),dimension(im,levs) :: ed_dTdt -! -! locals -! - integer :: i, j, k -!------------------------------------------------------------------------ -! solving 1D-vertical eddy diffusion to "smooth" -! GW-related tendencies: du/dt, dv/dt, d(PT)/dt -! we need to use sum of molecular + eddy terms including turb-part -! of PBL extended to the model top, because "phys-tend" dx/dt -! should be smoothed as "entire" fields therefore one should -! first estimate and collect "effective" diffusion and applied -! it to each part of tendency or "sum of tendencies + Xdyn" -! this "diffusive-way" is tested with UGWP-tendencies -! forced by various wave sources. X' =dx/dt *dt -! d(X + X')/dt = K*diff(X + X') => -! -! wave1 dX'/dt = Kw * diff(X')... eddy part "Kwave" on wave-part -! turb2 dX/dt = Kturb * diff(X) ... resolved scale mixing "Kturb" like PBL -! we may assume "zero-GW"-tendency at the top lid and "zero" flux -! or "vertical gradient" near the surface -! -! 1-st trial w/o PBL interactions: add dU, dV dT tendencies -! compute BV, SHR2, Ri => Kturb, Kturb + Kwave => Apply it to "X_Tend +X " -! ed_X = X_ed - X => final eddy tendencies -!--------------------------------------------------------------------------- -! rzs=30m dk = rzs*rzs*sqrt(shr2(i,k)) -! Ktemp = dk/(1+5.*ri)**2 Kmom = Pr*Ktemp -! - real(kind=kind_phys) :: Sw(levs), Sw1(levs), Fw(levs), Fw1(levs) - real(kind=kind_phys) :: Km(levs), Kpt(levs), Pt(levs), Ptmap(levs) - real(kind=kind_phys) :: rho(levs), rdp(levs), rdpm(levs-1) - real(kind=kind_phys),dimension(levs) :: ktur, vumol, up, vp, tp - real(kind=kind_phys),dimension(levs) :: bn2, shr2, ksum - real(kind=kind_phys) :: eps_shr, eps_bn2, eps_dis - real(kind=kind_phys) :: rdz , uz, vz, ptz -! ------------------------------------------------------------------------- -! Prw*Lsat2 =1, for GW-eddy diffusion Pr_wave = Kv/Kt -! Pr_wave ~1/Lsat2 = 1/Frcit2 = 2. => Lsat2 = 1./2 (Frc ~0.7) -! m*u'/N = u'/{c-U) = h'N/(c-U) = Lsat = Fcrit -! > PBL: 0.25 < prnum = 1.0 + 2.1*ri < 4 -! monin-edmf parameter(rlam=30.0,vk=0.4,vk2=vk*vk) rlamun=150.0 -! - real(kind=kind_phys), parameter :: iPr_pt = 0.5, dw2min = 1.e-4 - real(kind=kind_phys), parameter :: lturb = 30., sc2 = lturb*lturb - real(kind=kind_phys), parameter :: ulturb=150.,sc2u=ulturb* ulturb - real(kind=kind_phys), parameter :: ric =0.25 - real(kind=kind_phys), parameter :: rimin = -10., prmin = 0.25 - real(kind=kind_phys), parameter :: prmax = 4.0 - real(kind=kind_phys), parameter :: hps = 7000., h4 = 0.25/hps - real(kind=kind_phys), parameter :: kedmin = 0.01, kedmax = 250. - - - real(kind=kind_phys) :: rdtp, rineg, kamp, zmet, zgrow - real(kind=kind_phys) :: stab, stab_dt, dtstab, ritur - integer :: nstab - real(kind=kind_phys) :: w1, w2, w3 - rdtp = 1./dtp - nstab = 1 - stab_dt = 0.9999 - - do i =1, im - - rdp(1:levs) = grav/del(i, 1:levs) - - up(1:levs) = u1(i,1:levs) +pdudt(i,1:levs)*dtp - vp(1:levs) = v1(i,1:levs) +pdvdt(i,1:levs)*dtp - tp(1:levs) = t1(i,1:levs) +pdTdt(i,1:levs)*dtp - Ptmap(1:levs) = (1.+fv*q1(i,1:levs))/prslk(i,1:levs) - rho(1:levs) = rdi*prsl(i, 1:levs)/tp(1:levs) - Pt(1:levs) = tp(1:levs)*Ptmap(1:levs) - - do k=1, levs-1 - rdpm(k) = grav/(prsl(i,k)-prsl(i,k+1)) - rdz = .5*rdpm(k)*(rho(k)+rho(k+1)) - uz = up(k+1)-up(k) - vz = vp(k+1)-vp(k) - ptz =2.*(pt(k+1)-pt(k))/(pt(k+1)+pt(k)) - shr2(k) = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) - bn2(k) = grav*rdz*ptz - zmet = phil(j,k)*rgrav - zgrow = exp(zmet*h4) - if ( bn2(k) < 0. ) then -! -! adjust PT-profile to bn2(k) = bnv2min -- neutral atmosphere -! adapt "pdtdt = (Ptadj-Ptdyn)/Ptmap" -! -! print *,' UGWP-V0 unstab PT(z) via gwdTdt ', bn2(k), k - - rineg = bn2(k)/shr2(k) - bn2(k) = max(bn2(k), bnv2min) - kamp = sqrt(shr2(k))*sc2u *zgrow - ktur(k) =kamp* (1+8.*(-rineg)/(1+1.746*sqrt(-rineg))) - endif - ritur = max(bn2(k)/shr2(k), rimin) - if (ritur > 0. ) then - kamp = sqrt(shr2(k))*sc2 *zgrow - w1 = 1./(1. + 5*ritur) - ktur(k)= kamp * w1 * w1 - endif - vumol(k) = 2.e-5 *exp(zmet/hps) - ksum(k) =ktur(k)+Pkdis(i,k)+vumol(k) - ksum(k) = max(ksum(k), kedmin) - ksum(k) = min(ksum(k), kedmax) - stab = 2.*ksum(k)*rdz*rdz*dtp - if ( stab >= 1.0 ) then - stab_dt = max(stab_dt, stab) - endif - enddo - nstab = max(1, nint(stab_dt)+1) - dtstab = dtp / float(nstab) - ksum(levs) = ksum(levs-1) - Fw(1:levs) = pdudt(i, 1:levs) - Fw1(1:levs) = pdvdt(i, 1:levs) - Km(1:levs) = ksum(1:levs) * rho(1:levs)* rho(1:levs) - - do j=1, nstab - call diff_1d_wtend(levs, dtstab, Fw, Fw1, Km, - & rdp, rdpm, Sw, Sw1) - Fw = Sw - Fw1 = Sw1 - enddo - - ed_dudt(i,:) = Sw - ed_dvdt(i,:) = Sw1 - - Pt(1:levs) = t1(i,1:levs)*Ptmap(1:levs) - Kpt = Km*iPr_pt - Fw(1:levs) = pdTdt(i, 1:levs)*Ptmap(1:levs) - do j=1, nstab - call diff_1d_ptend(levs, dtstab, Fw, Kpt, rdp, rdpm, Sw) - Fw = Sw - enddo - ed_dtdt(i,1:levs) = Sw(1:levs)/Ptmap(1:levs) - - enddo - - end subroutine edmix_ugwp_v0 - subroutine diff_1d_wtend(levs, dt, F, F1, Km, rdp, rdpm, S, S1) - use machine, only: kind_phys - implicit none - integer :: levs - real(kind=kind_phys) :: dt - real(kind=kind_phys) :: S(levs), S1(levs), F(levs), F1(levs) - real(kind=kind_phys) :: Km(levs), rdp(levs), rdpm(levs-1) - integer :: i, k - real(kind=kind_phys) :: Kp1, ad, cd, bd -! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd -! S(:) = 0.0 ; S1(:) = 0.0 -! -! explicit diffusion solver -! - k = 1 -! km1 = 0. ; ad =0. - ad =0. - kp1 = .5*(Km(k)+Km(k+1)) - cd = rdp(1)*rdpm(1)*kp1*dt - bd = 1. - cd - ad -! S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) - S(K) = F(k) - S1(K) = F1(k) - do k=2, levs-1 - ad = cd - kp1 = .5*(Km(k)+Km(k+1)) - cd = rdp(k)*rdpm(k)*kp1*dt - bd = 1.-(ad +cd) - S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) - S1(k) = cd*F1(k+1) + ad *F1(k-1) + bd *F1(k) - enddo - k = levs - S(k) = F(k) - S1(k) = F1(k) - end subroutine diff_1d_wtend - - subroutine diff_1d_ptend(levs, dt, F, Km, rdp, rdpm, S) - use machine, only: kind_phys - implicit none - integer :: levs - real(kind=kind_phys) :: dt - real(kind=kind_phys) :: S(levs), S1(levs), F(levs), F1(levs) - real(kind=kind_phys) :: Km(levs), rdp(levs), rdpm(levs-1) - integer :: i, k - real(kind=kind_phys) :: Kp1, ad, cd, bd -! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd -! -! explicit "eddy" smoother for tendencies -! - - k = 1 -! km1 = 0. ; ad =0. - ad =0. - kp1 = .5*(Km(k)+Km(k+1)) - cd = rdp(1)*rdpm(1)*kp1*dt - bd = 1. -(cd +ad) -! S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) - S(K) = F(k) - do k=2, levs-1 - ad = cd - kp1 = .5*(Km(k)+Km(k+1)) - cd = rdp(k)*rdpm(k)*kp1*dt - bd = 1.-(ad +cd) - S(k) = cd*F(k+1) + ad *F(k-1) + bd *F(k) - enddo - k = levs - S(k) = F(k) - end subroutine diff_1d_ptend + diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 20ab38897..4439845ad 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -1,8 +1,9 @@ !> \file ugwpv1_gsldrag.F90 -!! This file combines three gravity wave drag schemes under one ("ugwpv1_gsldrag") suite: -!! 1) The "V0 CIRES UGWP" scheme (cires_ugwp.F90) as implemented in the FV3GFSv16 atmosphere model, which includes: -!! a) the "traditional" EMC orograhic gravity wave drag and flow blocking scheme of gwdps.f -!! b) the v0 cires ugwp non-stationary GWD scheme +!! This introduces two gravity wave drag schemes ugwpv1/CIRES and GSL/drag_suite.F90 under "ugwpv1_gsldrag" suite: +!! 1) The "V1 CIRES UGWP" scheme as tested in the FV3GFSv16-127L atmosphere model and workflow, which includes: +!! a) the orograhic gravity wave drag, flow blocking scheme and TOFD (Beljaars et al, 2004). +!! b) the v1 CIRE ugwp non-stationary GW scheme, new revision that generate realistic climate of FV3GFS-127L +!! in the strato-mesosphere in the multi-year simulations (Annual cycles, SAO and QBO in th tropical dynamics). !! 2) The GSL orographic drag suite (drag_suite.F90), as implmeneted in the RAP/HRRR, which includes: !! a) large-scale gravity wave drag and low-level flow blocking -- active at horizontal scales !! down to ~5km (Kim and Arakawa, 1995 \cite kim_and_arakawa_1995; Kim and Doyle, 2005 \cite kim_and_doyle_2005) @@ -10,8 +11,7 @@ !! (Steeneveld et al, 2008 \cite steeneveld_et_al_2008; Tsiringakis et al, 2017 \cite tsiringakis_et_al_2017) !! c) turbulent orographic form drag -- active at horizontal grid ersolutions down to ~1km !! (Beljaars et al, 2004 \cite beljaars_et_al_2004) -!! 3) The "V1 CIRES UGWP" scheme developed by Valery Yudin (University of Colorado, CIRES) -!! See Valery Yudin's presentation at 2017 NGGPS PI meeting: +!! See Valery Yudin's presentation at 2020 UFS User's meeting (Jul 2020): !! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers !! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics !! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. @@ -172,7 +172,7 @@ subroutine ugwpv1_gsldrag_init ( & print *, ' do_ugwp_v1_orog_only ', do_ugwp_v1_orog_only print *, ' do_gsl_drag_ls_bl ',do_gsl_drag_ls_bl write(errmsg,'(*(a))') " the CIRES CCPP-suite intend to & - support but has Logic error" + support with but has Logic error" errflg = 1 return endif @@ -341,9 +341,9 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! Preference use (im,levs) rather than (:,:) to avoid memory-leaks ! that found in Nov-Dec 2020 ! order array-description control-logical -! other in-variables -! out-variables -! local-variables +! other in-variables +! out-variables +! local-variables ! ! unified GSL and CIRES diagnostics inside CCPP and GFS_typedefs.F90/GFS_diagnostics.F90 ! @@ -453,7 +453,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! from ugwp_driver_v0.f -> cires_ugwp_initialize.F90 -> module ugwp_wmsdis_init ! now in the namelist of cires_ugwp "knob_ugwp_tauamp" controls tamp_mpa ! -! tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 +! tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 !------------ ! real(kind=kind_phys), parameter :: tamp_mpa_v0=30.e-3 ! large flux to help "GFS-ensembles" in July 2019 @@ -532,8 +532,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! Run the appropriate large-scale (large-scale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd - if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd & - .or. do_ugwp_v1_w_gsldrag) then + if ( do_gsl_drag_ls_bl.or.do_gsl_drag_ss.or.do_gsl_drag_tofd) then ! ! to do: the zero diag and tendency values assigned inside "drag_suite_run" can be skipped : ! @@ -581,7 +580,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd else ! -! not gsldrag scheme for example "do_ugwp_v1_orog_only" +! not gsldrag oro-scheme for example "do_ugwp_v1_orog_only" ! if ( do_ugwp_v1_orog_only ) then @@ -634,9 +633,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd enddo enddo endif - ENDIF ! + ENDIF ! - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Begin non-stationary GW schemes ! ugwp_v1 diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 8f8538077..b6bd83d2c 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -1,5 +1,5 @@ !> \file unified_ugwp.F90 -!! This file combines three gravity wave drag schemes under one ("unified_ugwp") suite: +!! This file combines three two orographic GW-schemes cires_ugwp.F90 and drag_suite.F90 under "unified_ugwp" suite: !! 1) The "V0 CIRES UGWP" scheme (cires_ugwp.F90) as implemented in the FV3GFSv16 atmosphere model, which includes: !! a) the "traditional" EMC orograhic gravity wave drag and flow blocking scheme of gwdps.f !! b) the v0 cires ugwp non-stationary GWD scheme @@ -10,8 +10,6 @@ !! (Steeneveld et al, 2008 \cite steeneveld_et_al_2008; Tsiringakis et al, 2017 \cite tsiringakis_et_al_2017) !! c) turbulent orographic form drag -- active at horizontal grid ersolutions down to ~1km !! (Beljaars et al, 2004 \cite beljaars_et_al_2004) -!! 3) The "V1 CIRES UGWP" scheme developed by Valery Yudin (University of Colorado, CIRES) -!! See Valery Yudin's presentation at 2017 NGGPS PI meeting: !! Gravity waves (GWs): Mesoscale GWs transport momentum, energy (heat) , and create eddy mixing in the whole atmosphere domain; Breaking and dissipating GWs deposit: (a) momentum; (b) heat (energy); and create (c) turbulent mixing of momentum, heat, and tracers !! To properly incorporate GW effects (a-c) unresolved by DYCOREs we need GW physics !! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. @@ -29,8 +27,6 @@ !! do_gsl_drag_ls_bl -- activates RAP/HRRR (GSL) large-scale GWD and blocking !! do_gsl_drag_ss -- activates RAP/HRRR (GSL) small-scale GWD !! do_gsl_drag_tofd -- activates RAP/HRRR (GSL) turbulent orographic drag -!! do_ugwp_v1 -- activates V1 CIRES UGWP scheme - both orographic and non-stationary GWD -!! do_ugwp_v1_orog_only -- activates V1 CIRES UGWP scheme - orographic GWD only !! Note that only one "large-scale" scheme can be activated at a time. !! @@ -38,22 +34,12 @@ module unified_ugwp use machine, only: kind_phys - use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize - - use cires_ugwp_module_v1, only: cires_ugwp_init_v1, cires_ugwp_finalize, calendar_ugwp - +! use cires_ugwp_module, only: knob_ugwp_version, cires_ugwp_mod_init, cires_ugwp_mod_finalize + use cires_ugwpv0_module, only: knob_ugwp_version, cires_ugwpv0_mod_init, cires_ugwpv0_mod_finalize use gwdps, only: gwdps_run use drag_suite, only: drag_suite_run - use cires_ugwp_orolm97_v1, only: gwdps_oro_v1 - - use cires_ugwp_triggers_v1, only: slat_geos5_tamp_v1 - - ! use cires_ugwp_ngw_utils, only: tau_limb_advance - - use cires_ugwp_solv2_v1_mod, only: cires_ugwp_solv2_v1 - implicit none private @@ -78,7 +64,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, & do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & - do_ugwp_v1, do_ugwp_v1_orog_only, errmsg, errflg) + errmsg, errflg) !---- initialization of unified_ugwp implicit none @@ -101,8 +87,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, & - do_gsl_drag_tofd, do_ugwp_v1, & - do_ugwp_v1_orog_only + do_gsl_drag_tofd character(len=*), intent (in) :: fn_nml2 !character(len=*), parameter :: fn_nml='input.nml' @@ -122,29 +107,12 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & ! Test to make sure that at most only one large-scale/blocking ! orographic drag scheme is chosen - if ( (do_ugwp_v0.and.(do_ugwp_v0_orog_only.or.do_gsl_drag_ls_bl.or. & - do_ugwp_v1.or.do_ugwp_v1_orog_only)) .or. & - (do_ugwp_v0_orog_only.and.(do_gsl_drag_ls_bl.or.do_ugwp_v1.or. & - do_ugwp_v1_orog_only)) .or. & - (do_gsl_drag_ls_bl.and.(do_ugwp_v1.or.do_ugwp_v1_orog_only)) .or. & - (do_ugwp_v1.and.do_ugwp_v1_orog_only) ) then + if ( (do_ugwp_v0.and.(do_ugwp_v0_orog_only.or.do_gsl_drag_ls_bl)) .or. & + (do_ugwp_v0_orog_only.and.do_gsl_drag_ls_bl) ) then write(errmsg,'(*(a))') "Logic error: Only one large-scale& &/blocking scheme (do_ugwp_v0,do_ugwp_v0_orog_only,& - &do_gsl_drag_ls_bl,do_ugwp_v1 or & - &do_ugwp_v1_orog_only) can be chosen" - errflg = 1 - return - - end if - - ! Test to make sure that if ugwp_v0 non-stationary-only is selected that - ! ugwp_v1 is not also selected - if ( do_ugwp_v0_nst_only .and. (do_ugwp_v1.or.do_ugwp_v1_orog_only) ) then - - write(errmsg,'(*(a))') "Logic error: do_ugwp_v0_nst_only can only be & - &selected if both do_ugwp_v1 and do_ugwp_v1_orog_only are not & - &selected" + &do_gsl_drag_ls_bl can be chosen" errflg = 1 return @@ -157,7 +125,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) then ! if (do_ugwp .or. cdmbgwd(3) > 0.0) then (deactivate effect of do_ugwp) if (cdmbgwd(3) > 0.0) then - call cires_ugwp_mod_init (me, master, nlunit, input_nml_file, logunit, & + call cires_ugwpv0_mod_init(me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, con_p0, dtp, & cdmbgwd(1:2), cgwf, pa_rf_in, tau_rf_in) else @@ -169,13 +137,6 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & end if - if ( do_ugwp_v1 ) then - call cires_ugwp_init_v1 (me, master, nlunit, logunit, jdat, con_pi, & - con_rerth, fn_nml2, lonr, latr, levs, ak, bk, & - con_p0, dtp, cdmbgwd(1:2), cgwf, pa_rf_in, & - tau_rf_in, errmsg, errflg) - end if - is_initialized = .true. end subroutine unified_ugwp_init @@ -192,12 +153,11 @@ end subroutine unified_ugwp_init !! subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v0_nst_only, & - do_ugwp_v1,errmsg, errflg) + errmsg, errflg) implicit none ! - logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_nst_only, & - do_ugwp_v1 + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_nst_only character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -207,9 +167,7 @@ subroutine unified_ugwp_finalize(do_ugwp_v0,do_ugwp_v0_nst_only, & if (.not.is_initialized) return - if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) call cires_ugwp_mod_finalize() - - if ( do_ugwp_v1 ) call cires_ugwp_finalize() + if ( do_ugwp_v0 .or. do_ugwp_v0_nst_only ) call cires_ugwpv0_mod_finalize() is_initialized = .false. @@ -251,7 +209,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & ldiag3d, lssav, flag_for_gwd_generic_tend, do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & - do_ugwp_v1, do_ugwp_v1_orog_only, gwd_opt, errmsg, errflg) + gwd_opt, errmsg, errflg) implicit none @@ -266,7 +224,9 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), intent(in), dimension(im,4) :: oa4ss,ol4ss logical, intent(in) :: flag_for_gwd_generic_tend - ! elvmax is intent(in) for CIRES UGWP, but intent(inout) for GFS GWDPS + + ! elvmax is intent(in) for CIRES UGWPv1, but intent(inout) for GFS GWDPS + real(kind=kind_phys), intent(inout), dimension(im) :: elvmax real(kind=kind_phys), intent(in), dimension(im, 4) :: clx, oa4 real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlat_d, sinlat, coslat, area @@ -324,8 +284,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & do_ugwp_v0_nst_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, & - do_gsl_drag_tofd, do_ugwp_v1, & - do_ugwp_v1_orog_only + do_gsl_drag_tofd character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -337,8 +296,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), dimension(im, levs) :: Pdtdt, Pkdis real(kind=kind_phys), parameter :: tamp_mpa=30.e-3 - ! switches that activate impact of OGWs and NGWs (WL* how to deal with them? *WL) - real(kind=kind_phys), parameter :: pogw=1., pngw=1., pked=1. integer :: nmtvr_temp @@ -357,8 +314,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ! 1) ORO stationary GWs ! ------------------ - zlwb(:) = 0. - ! Run the appropriate large-scale (large-scale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd @@ -377,37 +332,12 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & errmsg,errflg) - - end if - - if ( do_ugwp_v1.or.do_ugwp_v1_orog_only ) then - - ! Valery's TOFD - ! topo paras - ! w/ orographic effects - if(nmtvr == 14)then - ! calculate sgh30 for TOFD - sgh30 = abs(oro - oro_uf) - ! w/o orographic effects - else - sgh30 = varss - endif - - inv_g = 1./con_g - zmeti = phii*inv_g - zmet = phil*inv_g - - call gwdps_oro_v1 (im, levs, lonr, do_tofd, & - Pdvdt, Pdudt, Pdtdt, Pkdis, & - ugrs , vgrs, tgrs, q1, KPBL, prsi,del,prsl, & - prslk, zmeti, zmet, dtp, kdt, hprime, oc, oa4, & - clx, theta, sigma, gamma, elvmax, & - con_g, con_omega, con_rd, con_cp, con_rv,con_pi, & - con_rerth, con_fvirt, sgh30, DUSFCg, DVSFCg, & - xlat_d, sinlat, coslat, area,cdmbgwd(1:2), me, & - master, rdxzb, zmtb, zogw, tau_mtb, tau_ogw, & - tau_tofd, du3dt_mtb, du3dt_ogw, du3dt_tms) - +! +! put zeros due to xy GSL-drag style: dtauy2d_ls,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls +! + tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0. + dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. + end if if ( do_ugwp_v0.or.do_ugwp_v0_orog_only.or.do_ugwp_v0_nst_only ) then @@ -445,7 +375,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if (errflg/=0) return endif - tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 if (ldiag_ugwp) then du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 end if @@ -477,7 +407,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if (cdmbgwd(3) > 0.0) then ! 2) non-stationary GW-scheme with GMAO/MERRA GW-forcing - call slat_geos5_tamp(im, tamp_mpa, xlat_d, tau_ngw) + call slat_geos5_tamp_v0(im, tamp_mpa, xlat_d, tau_ngw) if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then if (cdmbgwd(4) > 0.0) then @@ -520,10 +450,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, do k=1,levs do i=1,im - gw_dtdt(i,k) = pngw*gw_dtdt(i,k)+ pogw*Pdtdt(i,k) - gw_dudt(i,k) = pngw*gw_dudt(i,k)+ pogw*Pdudt(i,k) - gw_dvdt(i,k) = pngw*gw_dvdt(i,k)+ pogw*Pdvdt(i,k) - gw_kdis(i,k) = pngw*gw_kdis(i,k)+ pogw*Pkdis(i,k) + gw_dtdt(i,k) = gw_dtdt(i,k)+ Pdtdt(i,k) + gw_dudt(i,k) = gw_dudt(i,k)+ Pdudt(i,k) + gw_dvdt(i,k) = gw_dvdt(i,k)+ Pdvdt(i,k) + gw_kdis(i,k) = gw_kdis(i,k)+ Pkdis(i,k) ! accumulation of tendencies for CCPP to replicate EMC-physics updates (!! removed in latest code commit to VLAB) !dudt(i,k) = dudt(i,k) +gw_dudt(i,k) !dvdt(i,k) = dvdt(i,k) +gw_dvdt(i,k) @@ -543,13 +473,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, enddo endif ! cdmbgwd(3) > 0.0 - - if (pogw == 0.0) then - tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0. - dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. - endif - - + if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then do k=1,levs do i=1,im diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index f60bdc038..181ffad92 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -1,13 +1,10 @@ [ccpp-table-properties] name = unified_ugwp type = scheme - dependencies = machine.F,cires_ugwp_module.F90,ugwp_driver_v0.F,cires_ugwp_triggers.F90 - dependencies = cires_ugwp_initialize.F90,cires_ugwp_solvers.F90,cires_ugwp_utils.F90 - dependencies = cires_orowam2017.f,cires_vert_lsatdis.F90,cires_vert_orodis.F90 - dependencies = cires_vert_wmsdis.F90,cires_ugwp_module_v1.F90,cires_ugwp_triggers_v1.F90 - dependencies = cires_ugwp_initialize_v1.F90,cires_ugwp_solv2_v1_mod.F90 - dependencies = cires_ugwp_orolm97_v1.F90,cires_orowam2017.F90,cires_vert_orodis_v1.F90 - dependencies = gwdps.f,drag_suite.F90 + + dependencies=cires_ugwp_triggers.F90,cires_ugwp_initialize.F90 + dependencies=cires_orowam2017.f, cires_ugwp_module.F90,gwdps.f,machine.F,ugwp_driver_v0.F + dependencies=drag_suite.F90 ######################################################################## [ccpp-arg-table] @@ -239,22 +236,6 @@ type = logical intent = in optional = F -[do_ugwp_v1] - standard_name = do_ugwp_v1 - long_name = flag to activate ver 1 CIRES UGWP - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_ugwp_v1_orog_only] - standard_name = do_ugwp_v1_orog_only - long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only - units = flag - dimensions = () - type = logical - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -293,14 +274,6 @@ type = logical intent = in optional = F -[do_ugwp_v1] - standard_name = do_ugwp_v1 - long_name = flag to activate ver 1 CIRES UGWP - units = flag - dimensions = () - type = logical - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -1341,22 +1314,6 @@ type = logical intent = in optional = F -[do_ugwp_v1] - standard_name = do_ugwp_v1 - long_name = flag to activate ver 1 CIRES UGWP - units = flag - dimensions = () - type = logical - intent = in - optional = F -[do_ugwp_v1_orog_only] - standard_name = do_ugwp_v1_orog_only - long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only - units = flag - dimensions = () - type = logical - intent = in - optional = F [gwd_opt] standard_name = gwd_opt long_name = flag to choose gwd scheme From a0efcb4e6124c5a2525b7158a144e13b24aed1b3 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 1 Feb 2021 11:31:43 -0700 Subject: [PATCH 187/274] Update GFS_debug.F90 with new variables --- physics/GFS_debug.F90 | 86 ++++++++++++++++++++++++++++++++-------- physics/unified_ugwp.F90 | 4 +- 2 files changed, 72 insertions(+), 18 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 2db523355..19bb2903c 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -824,8 +824,12 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_h', Grid%jindx1_h) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_h', Grid%jindx2_h) endif - ! Model/Control - ! not yet + if (Model%do_ugwp_v1) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_j1tau ', Grid%ddy_j1tau ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_j2tau ', Grid%ddy_j2tau ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_tau', Grid%jindx1_tau ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_tau', Grid%jindx2_tau ) + endif end if #ifdef OPENMP !$OMP BARRIER @@ -1229,21 +1233,71 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_land ', Interstitial%zorl_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_ocean ', Interstitial%zorl_ocean ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zt1d ', Interstitial%zt1d ) + if (Model%do_ugwp_v1) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_gw ', Interstitial%dudt_gw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_gw ', Interstitial%dvdt_gw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdt_gw ', Interstitial%dtdt_gw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kdis_gw ', Interstitial%kdis_gw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ngw ', Interstitial%dudt_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ngw ', Interstitial%dvdt_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdt_ngw ', Interstitial%dtdt_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kdis_ngw ', Interstitial%kdis_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ogw ', Interstitial%dvdt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_obl ', Interstitial%dudt_obl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_obl ', Interstitial%dvdt_obl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_oss ', Interstitial%dudt_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_oss ', Interstitial%dvdt_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ofd ', Interstitial%dudt_ofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ofd ', Interstitial%dvdt_ofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_oss ', Interstitial%tau_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ogwcol ', Interstitial%du_ogwcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ogwcol ', Interstitial%dv_ogwcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_oblcol ', Interstitial%du_oblcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_oblcol ', Interstitial%dv_oblcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_osscol ', Interstitial%du_osscol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_osscol ', Interstitial%dv_osscol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ofdcol ', Interstitial%du_ofdcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ofdcol ', Interstitial%dv_ofdcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zobl ', Interstitial%zobl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zngw ', Interstitial%zngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dudt ', Interstitial%gw_dudt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dvdt ', Interstitial%gw_dvdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dtdt ', Interstitial%gw_dtdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_kdis ', Interstitial%gw_kdis ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) + end if ! CIRES UGWP v0 - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dudt ', Interstitial%gw_dudt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dvdt ', Interstitial%gw_dvdt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dtdt ', Interstitial%gw_dtdt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_kdis ', Interstitial%gw_kdis ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) + if (Model%do_ugwp_v0 .or. Model%do_gsl_drag_ls_bl .or. Model%do_gsl_drag_ss .or. Model%do_gsl_drag_tofd) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dudt ', Interstitial%gw_dudt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dvdt ', Interstitial%gw_dvdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dtdt ', Interstitial%gw_dtdt ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_kdis ', Interstitial%gw_kdis ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) + end if !-- GSD drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%varss ', Interstitial%varss ) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index b6bd83d2c..0454ed376 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -334,7 +334,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, errmsg,errflg) ! ! put zeros due to xy GSL-drag style: dtauy2d_ls,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls -! +! tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0. dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. @@ -375,7 +375,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, if (errflg/=0) return endif - tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 + tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 if (ldiag_ugwp) then du3dt_mtb = 0.0 ; du3dt_ogw = 0.0 ; du3dt_tms= 0.0 end if From f4c0b0bad8607ff4d9d5106bcad46253caf5944b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 1 Feb 2021 11:32:15 -0700 Subject: [PATCH 188/274] Replace tabs with whitespaces in physics/cires_ugwpv1_solv2.F90, trim trailing whitespaces --- physics/cires_ugwpv1_solv2.F90 | 1138 ++++++++++++++++---------------- 1 file changed, 569 insertions(+), 569 deletions(-) diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/cires_ugwpv1_solv2.F90 index 07330cf8b..f282635e6 100644 --- a/physics/cires_ugwpv1_solv2.F90 +++ b/physics/cires_ugwpv1_solv2.F90 @@ -5,7 +5,7 @@ module cires_ugwpv1_solv2 !--------------------------------------------------- -! Broad spectrum FVS-1993, mkz^nSlope with nSlope = 0, 1,2 +! Broad spectrum FVS-1993, mkz^nSlope with nSlope = 0, 1,2 ! dissipative solver with NonHyd/ROT-effects ! reflected GWs treated as waves with "negligible" flux, ! they are out of given column @@ -14,7 +14,7 @@ module cires_ugwpv1_solv2 subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & tau_ngw, tm , um, vm, qm, prsl, prsi, zmet, zmeti, prslk, & xlatd, sinlat, coslat, & - pdudt, pdvdt, pdtdt, dked, zngw) + pdudt, pdvdt, pdtdt, dked, zngw) ! !-------------------------------------------------------------------------------- ! nov 2015 alternative gw-solver for nggps-wam @@ -23,17 +23,17 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! source function and *F90 CIRES-style of the code ! oct 2020 Diagnostics of "tauabs, wrms, trms" is taken out ! -------------------------------------------------------------------------------- -! - use machine, only : kind_phys +! + use machine, only : kind_phys use cires_ugwpv1_module,only : krad, kvg, kion, ktg, iPr_ktgw, Pr_kdis, Pr_kvkt - + use cires_ugwpv1_module,only : knob_ugwp_doheat, knob_ugwp_dokdis, idebug_gwrms - + use cires_ugwpv1_module,only : psrc => knob_ugwp_palaunch - + use cires_ugwpv1_module,only : maxdudt, maxdtdt, max_eps, dked_min, dked_max - + use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpdl, grav2cpd, & omega2, rcpd, rcpd2, pi, pi2, fv, & rad_to_deg, deg_to_rad, & @@ -41,39 +41,39 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & bnv2min, bnv2max, dw2min, velmin, gr2, & hpscale, rhp, rh4, grav2, rgrav2, mkzmin, mkz2min ! - use ugwp_wmsdis_init, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & + use ugwp_wmsdis_init, only : v_kxw, rv_kxw, v_kxw2, tamp_mpa, tau_min, ucrit, & gw_eff, & nslope, ilaunch, zms, & zci, zdci, zci4, zci3, zci2, & zaz_fct, zcosang, zsinang, nwav, nazd, & zcimin, zcimax, rimin, sc2, sc2u, ric -! +! implicit none ! real(kind=kind_phys), parameter :: zsp_gw = 106.5e3 ! sponge for GWs above the model top - real(kind=kind_phys), parameter :: linsat2 = 1.0, dturb_max = 100.0 + real(kind=kind_phys), parameter :: linsat2 = 1.0, dturb_max = 100.0 integer, parameter :: ener_norm =0 - integer, parameter :: ener_lsat=0 - integer, parameter :: nstdif = 1 - integer, parameter :: wave_sponge = 1 - + integer, parameter :: ener_lsat=0 + integer, parameter :: nstdif = 1 + integer, parameter :: wave_sponge = 1 + integer, intent(in) :: levs ! vertical level integer, intent(in) :: im ! horiz tiles integer, intent(in) :: mpi_id, master, kdt - - real(kind=kind_phys) ,intent(in) :: dtp ! model time step - real(kind=kind_phys) ,intent(in) :: tau_ngw(im) - - real(kind=kind_phys) ,intent(in) :: vm(im,levs) ! meridional wind + + real(kind=kind_phys) ,intent(in) :: dtp ! model time step + real(kind=kind_phys) ,intent(in) :: tau_ngw(im) + + real(kind=kind_phys) ,intent(in) :: vm(im,levs) ! meridional wind real(kind=kind_phys) ,intent(in) :: um(im,levs) ! zonal wind real(kind=kind_phys) ,intent(in) :: qm(im,levs) ! spec. humidity - real(kind=kind_phys) ,intent(in) :: tm(im,levs) ! kinetic temperature + real(kind=kind_phys) ,intent(in) :: tm(im,levs) ! kinetic temperature real(kind=kind_phys) ,intent(in) :: prsl(im,levs) ! mid-layer pressure - real(kind=kind_phys) ,intent(in) :: prslk(im,levs) ! mid-layer exner function + real(kind=kind_phys) ,intent(in) :: prslk(im,levs) ! mid-layer exner function real(kind=kind_phys) ,intent(in) :: zmet(im,levs) ! meters now !!!!! phil =philg/grav real(kind=kind_phys) ,intent(in) :: prsi(im,levs+1) ! interface pressure - real(kind=kind_phys) ,intent(in) :: zmeti(im,levs+1) ! interface geopi/meters + real(kind=kind_phys) ,intent(in) :: zmeti(im,levs+1) ! interface geopi/meters real(kind=kind_phys) ,intent(in) :: xlatd(im) ! xlat_d in degrees real(kind=kind_phys) ,intent(in) :: sinlat(im) real(kind=kind_phys) ,intent(in) :: coslat(im) @@ -84,70 +84,70 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & real(kind=kind_phys) ,intent(out) :: pdvdt(im,levs) ! meridional momentum tendency real(kind=kind_phys) ,intent(out) :: pdtdt(im,levs) ! gw-heating (u*ax+v*ay)/cp and cooling real(kind=kind_phys) ,intent(out) :: dked(im,levs) ! gw-eddy diffusion - real(kind=kind_phys) ,intent(out) :: zngw(im) ! launch height + real(kind=kind_phys) ,intent(out) :: zngw(im) ! launch height ! -! -! -! local =========================================================================================== - +! +! +! local =========================================================================================== + real(kind=kind_phys) :: tauabs(im,levs) ! - real(kind=kind_phys) :: wrms(im,levs) ! - real(kind=kind_phys) :: trms(im,levs) ! - + real(kind=kind_phys) :: wrms(im,levs) ! + real(kind=kind_phys) :: trms(im,levs) ! + real(kind=kind_phys) :: zwrms(nwav,nazd), wrk1(levs), wrk2(levs) - real(kind=kind_phys) :: atrms(nazd, levs),awrms(nazd, levs), akzw(nwav,nazd, levs+1) + real(kind=kind_phys) :: atrms(nazd, levs),awrms(nazd, levs), akzw(nwav,nazd, levs+1) ! -! local =========================================================================================== +! local =========================================================================================== real(kind=kind_phys) :: taux(levs+1) ! EW component of vertical momentum flux (pa) real(kind=kind_phys) :: tauy(levs+1) ! NS component of vertical momentum flux (pa) real(kind=kind_phys) :: fpu(nazd, levs+1) ! az-momentum flux real(kind=kind_phys) :: ui(nazd, levs+1) ! azimuthal wind - - real(kind=kind_phys) :: fden_bn(levs+1) ! density/brent - real(kind=kind_phys) :: flux (nwav, nazd) , flux_m (nwav, nazd) -! - real(kind=kind_phys) :: bn(levs+1) ! interface BV-frequency - real(kind=kind_phys) :: bn2(levs+1) ! interface BV*BV-frequency - real(kind=kind_phys) :: rhoint(levs+1) ! interface density + + real(kind=kind_phys) :: fden_bn(levs+1) ! density/brent + real(kind=kind_phys) :: flux (nwav, nazd) , flux_m (nwav, nazd) +! + real(kind=kind_phys) :: bn(levs+1) ! interface BV-frequency + real(kind=kind_phys) :: bn2(levs+1) ! interface BV*BV-frequency + real(kind=kind_phys) :: rhoint(levs+1) ! interface density real(kind=kind_phys) :: uint(levs+1) ! interface zonal wind real(kind=kind_phys) :: vint(levs+1) ! meridional wind real(kind=kind_phys) :: tint(levs+1) ! temp-re - - real(kind=kind_phys) :: irhodz_mid(levs) - real(kind=kind_phys) :: suprf(levs+1) ! RF-super linear dissipation - real(kind=kind_phys) :: cstar(levs+1) ,cstar2(levs+1) + + real(kind=kind_phys) :: irhodz_mid(levs) + real(kind=kind_phys) :: suprf(levs+1) ! RF-super linear dissipation + real(kind=kind_phys) :: cstar(levs+1) ,cstar2(levs+1) real(kind=kind_phys) :: v_zmet(levs+1) - real(kind=kind_phys) :: vueff(levs+1) + real(kind=kind_phys) :: vueff(levs+1) real(kind=kind_phys) :: dfdz_v(nazd, levs), dfdz_heat(nazd, levs) ! axj = -df*rho/dz directional Ax - + real(kind=kind_phys), dimension(levs) :: atm , aum, avm, aqm, aprsl, azmet, dz_met real(kind=kind_phys), dimension(levs+1) :: aprsi, azmeti, dz_meti - real(kind=kind_phys), dimension(levs) :: wrk3 + real(kind=kind_phys), dimension(levs) :: wrk3 real(kind=kind_phys), dimension(levs) :: uold, vold, told, unew, vnew, tnew - real(kind=kind_phys), dimension(levs) :: rho, rhomid, adif, cdif, acdif + real(kind=kind_phys), dimension(levs) :: rho, rhomid, adif, cdif, acdif real(kind=kind_phys), dimension(levs) :: Qmid, AKT - real(kind=kind_phys), dimension(levs+1) :: dktur, Ktint, Kvint - real(kind=kind_phys), dimension(levs+1) :: fden_lsat, fden_bnen - + real(kind=kind_phys), dimension(levs+1) :: dktur, Ktint, Kvint + real(kind=kind_phys), dimension(levs+1) :: fden_lsat, fden_bnen + integer, dimension(levs) :: Anstab - - real(kind=kind_phys) :: sig_u2az(nazd), sig_u2az_m(nazd) - real(kind=kind_phys) :: wave_dis(nwav, nazd), wave_disaz(nazd) + + real(kind=kind_phys) :: sig_u2az(nazd), sig_u2az_m(nazd) + real(kind=kind_phys) :: wave_dis(nwav, nazd), wave_disaz(nazd) real(kind=kind_phys) :: rdci(nwav), rci(nwav) real(kind=kind_phys) :: wave_act(nwav, nazd) ! active waves at given vert-level real(kind=kind_phys) :: ul(nazd) ! velocity in azimuthal direction at launch level ! ! scalars -! - real(kind=kind_phys) :: bvi, bvi2, bvi3, bvi4, rcms ! BV at launch level - real(kind=kind_phys) :: c2f2, cf1, wave_distot - +! + real(kind=kind_phys) :: bvi, bvi2, bvi3, bvi4, rcms ! BV at launch level + real(kind=kind_phys) :: c2f2, cf1, wave_distot + real(kind=kind_phys) :: flux_norm ! norm-factor real(kind=kind_phys) :: taub_src, rho_src, zcool, vmdiff ! - real(kind=kind_phys) :: zthm, dtau, cgz, ucrit_maxdc + real(kind=kind_phys) :: zthm, dtau, cgz, ucrit_maxdc real(kind=kind_phys) :: vm_zflx_mode, vc_zflx_mode real(kind=kind_phys) :: kzw2, kzw3, kdsat, cdf2, cdf1, wdop2,v_cdp2 real(kind=kind_phys) :: ucrit_max @@ -155,318 +155,318 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & real(kind=kind_phys) :: zu, zcin, zcin2, zcin3, zcin4, zcinc real(kind=kind_phys) :: zatmp, fluxs, zdep, ze1, ze2 -! +! real(kind=kind_phys) :: zdelp, zdelm, taud_min real(kind=kind_phys) :: tvc, tvm, ptc, ptm - real(kind=kind_phys) :: umfp, umfm, umfc, ucrit3 + real(kind=kind_phys) :: umfp, umfm, umfc, ucrit3 real(kind=kind_phys) :: fmode, expdis, fdis real(kind=kind_phys) :: v_kzi, v_kzw, v_cdp, v_wdp, tx1, fcorsat, dzcrit real(kind=kind_phys) :: v_wdi, v_wdpc - real(kind=kind_phys) :: ugw, vgw, ek1, ek2, rdtp, rdtp2, rhp_wam - + real(kind=kind_phys) :: ugw, vgw, ek1, ek2, rdtp, rdtp2, rhp_wam + integer :: j, jj, k, kk, inc, jk, jkp, jl, iaz - integer :: ksrc, km2, km1, kp1, ktop + integer :: ksrc, km2, km1, kp1, ktop ! ! Kturb-part -! - real(kind=kind_phys) :: uz, vz, shr2 , ritur, ktur - +! + real(kind=kind_phys) :: uz, vz, shr2 , ritur, ktur + real(kind=kind_phys) :: kamp, zmetk, zgrow real(kind=kind_phys) :: stab, stab_dt, dtstab - real(kind=kind_phys) :: nslope3 -! - integer :: nstab, ist + real(kind=kind_phys) :: nslope3 +! + integer :: nstab, ist real(kind=kind_phys) :: w1, w2, w3, dtdif - - real(kind=kind_phys) :: dzmetm, dzmetp, dzmetf, bdif, bt_dif, apc, kturp + + real(kind=kind_phys) :: dzmetm, dzmetp, dzmetf, bdif, bt_dif, apc, kturp real(kind=kind_phys) :: rstar, rstar2 real(kind=kind_phys) :: snorm_ener, sigu2, flux_2_sig, ekin_norm - real(kind=kind_phys) :: taub_ch, sigu2_ch + real(kind=kind_phys) :: taub_ch, sigu2_ch real(kind=kind_phys) :: Pr_kdis_eff, mf_diss_heat, iPr_max - real(kind=kind_phys) :: exp_sponge, mi_sponge, gipr - + real(kind=kind_phys) :: exp_sponge, mi_sponge, gipr + !-------------------------------------------------------------------------- -! +! nslope3 = nslope + 3.0 - Pr_kdis_eff = gw_eff*pr_kdis - iPr_max = max(1.0, iPr_ktgw) - gipr = grav* Ipr_ktgw + Pr_kdis_eff = gw_eff*pr_kdis + iPr_max = max(1.0, iPr_ktgw) + gipr = grav* Ipr_ktgw ! -! test for input fields +! test for input fields ! if (mpi_id == master .and. kdt < -2) then ! print *, im, levs, dtp, kdt, ' vay-solv2-v1' ! print *, minval(tm), maxval(tm), ' min-max-tm ' -! print *, minval(vm), maxval(vm), ' min-max-vm ' -! print *, minval(um), maxval(um), ' min-max-um ' -! print *, minval(qm), maxval(qm), ' min-max-qm ' -! print *, minval(prsl), maxval(prsl), ' min-max-Pmid ' -! print *, minval(prsi), maxval(prsi), ' min-max-Pint ' -! print *, minval(zmet), maxval(zmet), ' min-max-Zmid ' -! print *, minval(zmeti), maxval(zmeti), ' min-max-Zint ' -! print *, minval(prslk), maxval(prslk), ' min-max-Exner ' -! print *, minval(tau_ngw), maxval(tau_ngw), ' min-max-taungw ' -! print *, tau_min, ' tau_min ', tamp_mpa, ' tamp_mpa ' -! -! endif - +! print *, minval(vm), maxval(vm), ' min-max-vm ' +! print *, minval(um), maxval(um), ' min-max-um ' +! print *, minval(qm), maxval(qm), ' min-max-qm ' +! print *, minval(prsl), maxval(prsl), ' min-max-Pmid ' +! print *, minval(prsi), maxval(prsi), ' min-max-Pint ' +! print *, minval(zmet), maxval(zmet), ' min-max-Zmid ' +! print *, minval(zmeti), maxval(zmeti), ' min-max-Zint ' +! print *, minval(prslk), maxval(prslk), ' min-max-Exner ' +! print *, minval(tau_ngw), maxval(tau_ngw), ' min-max-taungw ' +! print *, tau_min, ' tau_min ', tamp_mpa, ' tamp_mpa ' +! +! endif + if (idebug_gwrms == 1) then - tauabs=0.0; wrms =0.0 ; trms =0.0 - endif - + tauabs=0.0; wrms =0.0 ; trms =0.0 + endif + rci(:) = 1./zci(:) rdci(:) = 1./zdci(:) - + rdtp = 1./dtp - rdtp2 = 0.5*rdtp - + rdtp2 = 0.5*rdtp + ksrc= max(ilaunch, 3) - km2 = ksrc - 2 + km2 = ksrc - 2 km1 = ksrc - 1 kp1 = ksrc + 1 ktop= levs+1 - + suprf(ktop) = kion(levs) - + do k=1,levs - suprf(k) = kion(k) ! approximate 1-st order damping with Fast super-RF of FV3 + suprf(k) = kion(k) ! approximate 1-st order damping with Fast super-RF of FV3 pdvdt(:,k) = 0.0 pdudt(:,k) = 0.0 pdtdt(:,k) = 0.0 dked(: ,k) = 0.0 enddo - -!----------------------------------------------------------- + +!----------------------------------------------------------- ! column-based j=1,im pjysics with 1D-arrays !----------------------------------------------------------- - DO j=1, im + DO j=1, im jl =j - tx1 = omega2 * sinlat(j) *rv_kxw - cf1 = abs(tx1) + tx1 = omega2 * sinlat(j) *rv_kxw + cf1 = abs(tx1) c2f2 = tx1 * tx1 - ucrit_max = max(ucrit, cf1) - ucrit3 = ucrit_max*ucrit_max*ucrit_max + ucrit_max = max(ucrit, cf1) + ucrit3 = ucrit_max*ucrit_max*ucrit_max ! ! ngw-fluxes at all gridpoints (with tau_min at least) -! - aprsl(1:levs) = prsl(jl,1:levs) +! + aprsl(1:levs) = prsl(jl,1:levs) ! ! ksrc-define "aprsi(1:levs+1) redefine "ilaunch" ! - do k=1, levs + do k=1, levs if (aprsl(k) .lt. psrc ) exit enddo - ilaunch = max(k-1, 3) + ilaunch = max(k-1, 3) ksrc= max(ilaunch, 3) - - zngw(j) = zmet(j, ksrc) - - km2 = ksrc - 2 + + zngw(j) = zmet(j, ksrc) + + km2 = ksrc - 2 km1 = ksrc - 1 kp1 = ksrc + 1 -!=====ksrc +!=====ksrc - aum(km2:levs) = um(jl,km2:levs) - avm(km2:levs) = vm(jl,km2:levs) - atm(km2:levs) = tm(jl,km2:levs) - aqm(km2:levs) = qm(jl,km2:levs) - azmet(km2:levs) = zmet(jl,km2:levs) - aprsi(km2:levs+1) = prsi(jl,km2:levs+1) - azmeti(km2:levs+1) = zmeti(jl,km2:levs+1) + aum(km2:levs) = um(jl,km2:levs) + avm(km2:levs) = vm(jl,km2:levs) + atm(km2:levs) = tm(jl,km2:levs) + aqm(km2:levs) = qm(jl,km2:levs) + azmet(km2:levs) = zmet(jl,km2:levs) + aprsi(km2:levs+1) = prsi(jl,km2:levs+1) + azmeti(km2:levs+1) = zmeti(jl,km2:levs+1) - - rho_src = aprsl(ksrc)*rdi/atm(ksrc) + + rho_src = aprsl(ksrc)*rdi/atm(ksrc) taub_ch = max(tau_ngw(jl), tau_min) - taub_src = taub_ch + taub_src = taub_ch + - - sigu2 = taub_src/rho_src/v_kxw * zms - sig_u2az(1:nazd) = sigu2 + sigu2 = taub_src/rho_src/v_kxw * zms + sig_u2az(1:nazd) = sigu2 ! ! compute diffusion-based arrays km2:levs -! +! do jk = km2, levs dz_meti(jk) = azmeti(jk+1)-azmeti(jk) - dz_met(jk) = azmet(jk)-azmeti(jk-1) - enddo -! --------------------------------------------- + dz_met(jk) = azmet(jk)-azmeti(jk-1) + enddo +! --------------------------------------------- ! interface mean flow parameters launch -> levs+1 ! --------------------------------------------- do jk= km1,levs tvc = atm(jk)*(1. +fv*aqm(jk)) tvm = atm(jk-1)*(1. +fv*aqm(jk-1)) - ptc = tvc/ prslk(jl, jk) - ptm = tvm/prslk(jl,jk-1) + ptc = tvc/ prslk(jl, jk) + ptm = tvm/prslk(jl,jk-1) ! zthm = 2.0/(tvc+tvm) - rhp_wam = zthm*gor -!interface + rhp_wam = zthm*gor +!interface uint(jk) = 0.5*(aum(jk-1)+aum(jk)) vint(jk) = 0.5*(avm(jk-1)+avm(jk)) - tint(jk) = 0.5*(tvc+tvm) + tint(jk) = 0.5*(tvc+tvm) rhomid(jk) = aprsl(jk)*rdi/atm(jk) - rhoint(jk) = aprsi(jk)*rdi*zthm ! rho = p/(RTv) + rhoint(jk) = aprsi(jk)*rdi*zthm ! rho = p/(RTv) zdelp = dz_meti(jk) ! >0 ...... dz-meters - v_zmet(jk) = 2.*zdelp ! 2*kzi*[Z_int(k+1)-Z_int(k)] + v_zmet(jk) = 2.*zdelp ! 2*kzi*[Z_int(k+1)-Z_int(k)] zdelm = 1./dz_met(jk) ! 1/dz ...... 1/meters -! +! ! bvf2 = grav2*zdelm*(ptc-ptm)/(ptc + ptm) ! N2=[g/PT]*(dPT/dz) -! +! bn2(jk) = grav2cpd*zthm*(1.0+rcpdl*(tvc-tvm)*zdelm) bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) - bn(jk) = sqrt(bn2(jk)) - - - wrk3(jk)= 1./zdelp/rhomid(jk) ! 1/rho_mid(k)/[Z_int(k+1)-Z_int(k)] - irhodz_mid(jk) = rdtp*zdelp*rhomid(jk)/rho_src -! + bn(jk) = sqrt(bn2(jk)) + + + wrk3(jk)= 1./zdelp/rhomid(jk) ! 1/rho_mid(k)/[Z_int(k+1)-Z_int(k)] + irhodz_mid(jk) = rdtp*zdelp*rhomid(jk)/rho_src +! ! ! diagnostics -Kzz above PBL ! uz = aum(jk) - aum(jk-1) vz = avm(jk) - avm(jk-1) - shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm - + shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm + zmetk = azmet(jk)* rh4 ! mid-layer height k_int => k_int+1 zgrow = exp(zmetk) - ritur = bn2(jk)/shr2 + ritur = bn2(jk)/shr2 kamp = sqrt(shr2)*sc2 *zgrow w1 = 1./(1. + 5*ritur) - ktur= min(max(kamp * w1 * w1, dked_min), dked_max) - zmetk = azmet(jk)* rhp + ktur= min(max(kamp * w1 * w1, dked_min), dked_max) + zmetk = azmet(jk)* rhp vueff(jk) = ktur + kvg(jk) - - akt(jk) = gipr/tvc + + akt(jk) = gipr/tvc enddo - if (idebug_gwrms == 1) then + if (idebug_gwrms == 1) then do jk= km1,levs - wrk1(jk) = rv_kxw/rhoint(jk) - wrk2(jk)= rgrav2*zthm*zthm*bn2(jk) ! dimension [K*K]*(c2/m2) + wrk1(jk) = rv_kxw/rhoint(jk) + wrk2(jk)= rgrav2*zthm*zthm*bn2(jk) ! dimension [K*K]*(c2/m2) enddo - endif + endif ! ! extrapolating values for ktop = levs+1 (lev-interface for prsi(levs+1) =/= 0) -! +! jk = levs - + rhoint(ktop) = 0.5*aprsi(levs)*rdi/atm(jk) - tint(ktop) = atm(jk)*(1. +fv*aqm(jk)) + tint(ktop) = atm(jk)*(1. +fv*aqm(jk)) uint(ktop) = aum(jk) vint(ktop) = avm(jk) - + v_zmet(ktop) = v_zmet(jk) vueff(ktop) = vueff(jk) - bn2(ktop) = bn2(jk) - bn(ktop) = bn(jk) -! -! akt_mid *KT = -g*(1/H + 1/T*dT/dz)*KT ... grav/tvc for eddy heat conductivity -! + bn2(ktop) = bn2(jk) + bn(ktop) = bn(jk) +! +! akt_mid *KT = -g*(1/H + 1/T*dT/dz)*KT ... grav/tvc for eddy heat conductivity +! do jk=km1, levs - akt(jk) = -akt(jk)*(gor + (tint(jk+1)-tint(jk))/dz_meti(jk) ) - enddo - - - bvi = bn(ksrc); bvi2 = bvi * bvi; - bvi3 = bvi2*bvi; bvi4 = bvi2 * bvi2; rcms = zms/bvi + akt(jk) = -akt(jk)*(gor + (tint(jk+1)-tint(jk))/dz_meti(jk) ) + enddo + + + bvi = bn(ksrc); bvi2 = bvi * bvi; + bvi3 = bvi2*bvi; bvi4 = bvi2 * bvi2; rcms = zms/bvi ! ! project winds at ksrc -! +! do iaz=1, nazd ul(iaz) = zcosang(iaz) *uint(ksrc) + zsinang(iaz) *vint(ksrc) enddo ! - do jk=ksrc, ktop - cstar(jk) = bn(jk)/zms - cstar2(jk) = cstar(jk)*cstar(jk) - - fden_lsat(jk) = rhoint(jk)/bn(jk)*v_kxw*Linsat2 - + do jk=ksrc, ktop + cstar(jk) = bn(jk)/zms + cstar2(jk) = cstar(jk)*cstar(jk) + + fden_lsat(jk) = rhoint(jk)/bn(jk)*v_kxw*Linsat2 + do iaz=1, nazd zu = zcosang(iaz)*uint(jk) + zsinang(iaz)*vint(jk) ui(iaz, jk) = zu !- ul(iaz)*0. enddo enddo - - rstar = 1./cstar(ksrc) - rstar2 = rstar*rstar -! ----------------------------------------- + + rstar = 1./cstar(ksrc) + rstar2 = rstar*rstar +! ----------------------------------------- ! set launch momentum flux spectral density -! ----------------------------------------- +! ----------------------------------------- fpu(1:nazd, km2:ktop) =0. - + do inc=1,nwav - + zcin = zci(inc)*rstar - -! + +! ! integrate (flux(cin) x dcin ) old tau-flux and normalization ! flux(inc,1) = rstar*(zcin*zcin)/(1.+ zcin**nslope3) -! +! ! fsat = rstar*(zcin*zcin) * taub_src / SN * [rho/rho_src *N_src/N] -! - fpu(1,ksrc) = fpu(1,ksrc) + flux(inc,1)*zdci(inc) ! dc/cstar = dim-less - - do iaz=1,nazd +! + fpu(1,ksrc) = fpu(1,ksrc) + flux(inc,1)*zdci(inc) ! dc/cstar = dim-less + + do iaz=1,nazd akzw(inc, iaz, ksrc) = bvi*rci(inc) - enddo - + enddo + enddo -! +! ! adjust rho/bn vertical factors for saturated fluxes (E(m) ~m^-3) flux_norm = taub_src / fpu(1, ksrc) ! [Pa * dc/cstar *dim_less] ze1 = flux_norm * bvi/rhoint(ksrc) *rstar *rstar2 do jk=ksrc, ktop - fden_bn(jk) = ze1* rhoint(jk) / bn(jk) ! [Pa]/[m/s] * rstar2 - enddo -! + fden_bn(jk) = ze1* rhoint(jk) / bn(jk) ! [Pa]/[m/s] * rstar2 + enddo +! do inc=1, nwav flux(inc,1) = flux_norm*flux(inc,1) - enddo - - + enddo + + if (ener_norm == 1) then - snorm_ener = 0. + snorm_ener = 0. do inc=1,nwav - zcin = zci(inc)*rstar - - ze2 = zcin /(1.+ zcin**nslope3) - - snorm_ener = snorm_ener + ze2*zdci(inc)*rstar !dim-less - flux(inc,1) = ze2 * zcin + zcin = zci(inc)*rstar + + ze2 = zcin /(1.+ zcin**nslope3) + + snorm_ener = snorm_ener + ze2*zdci(inc)*rstar !dim-less + flux(inc,1) = ze2 * zcin enddo - - ekin_norm = 1./snorm_ener - + + ekin_norm = 1./snorm_ener + ! taub_src = sigu2 * rho_src * [v_kxw / zms ] -! sigu2 = taub_src*zms/(rho_src/v_kxw) -! ze1 = sigu2*ks*dens/Ns = taub*zms/Ns - - ze1 = taub_src*zms/bvi * ekin_norm - taub_src = 0. - +! sigu2 = taub_src*zms/(rho_src/v_kxw) +! ze1 = sigu2*ks*dens/Ns = taub*zms/Ns + + ze1 = taub_src*zms/bvi * ekin_norm + taub_src = 0. + do inc=1,nwav - flux(inc,1) = ze1* flux(inc,1) - taub_src = taub_src + flux(inc,1)*zdci(inc) - enddo - ze1 = ekin_norm * v_kxw * rstar2 + flux(inc,1) = ze1* flux(inc,1) + taub_src = taub_src + flux(inc,1)*zdci(inc) + enddo + ze1 = ekin_norm * v_kxw * rstar2 do jk=ksrc, ktop fden_bnen(jk) = rhoint(jk) / bn(jk) *ze1 ! mult on => sigu2(z)*cdf2 => flux_sat enddo - - endif + + endif ! - do iaz=1,nazd + do iaz=1,nazd fpu(iaz, ksrc) = taub_src fpu(iaz, km1) = taub_src enddo - + ! copy flux-1 into other azimuths ! -------------------------------- @@ -476,146 +476,146 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & flux(inc,iaz) = flux(inc,1) enddo enddo - + ! if (mpi_id == master .and. ener_norm == 1) then ! print * -! print *, 'vay_norm: ', taub_src, taub_ch, sigu2, flux_norm, ekin_norm -! print * +! print *, 'vay_norm: ', taub_src, taub_ch, sigu2, flux_norm, ekin_norm +! print * ! endif - if (idebug_gwrms == 1) then - pwrms =0. - ptrms =0. - tx1 = real(nazd)/rhoint(ksrc)*rv_kxw - ze2 = wrk2(ksrc) ! (bvi*atm(ksrc)*rgrav)**2 - do inc=1, nwav - v_kzw = bvi*rci(inc) - ze1 = flux(inc,1)*zdci(inc)*tx1*v_kzw - pwrms = pwrms + ze1 - ptrms = ptrms + ze1 * ze2 - enddo - wrms(jl, ksrc) = pwrms - trms(jl, ksrc) = ptrms + if (idebug_gwrms == 1) then + pwrms =0. + ptrms =0. + tx1 = real(nazd)/rhoint(ksrc)*rv_kxw + ze2 = wrk2(ksrc) ! (bvi*atm(ksrc)*rgrav)**2 + do inc=1, nwav + v_kzw = bvi*rci(inc) + ze1 = flux(inc,1)*zdci(inc)*tx1*v_kzw + pwrms = pwrms + ze1 + ptrms = ptrms + ze1 * ze2 + enddo + wrms(jl, ksrc) = pwrms + trms(jl, ksrc) = ptrms endif - + ! -------------------------------- - wave_act(:,:) = 1.0 + wave_act(:,:) = 1.0 ! vertical do-loop do jk=ksrc, levs - jkp = jk+1 + jkp = jk+1 ! azimuth do-loop - do iaz=1, nazd - - sig_u2az_m(iaz) = sig_u2az(iaz) - - umfp = ui(iaz, jkp) + do iaz=1, nazd + + sig_u2az_m(iaz) = sig_u2az(iaz) + + umfp = ui(iaz, jkp) umfm = ui(iaz, jk) umfc = .5*(umfm + umfp) ! wave-cin loop dfdz_v(iaz, jk) = 0.0 - dfdz_heat(iaz, jk) = 0.0 + dfdz_heat(iaz, jk) = 0.0 fpu(iaz, jkp) = 0.0 - sig_u2az(iaz) =0.0 + sig_u2az(iaz) =0.0 ! -! wave_dis(iaz, :) = vueff(jk) +! wave_dis(iaz, :) = vueff(jk) do inc=1, nwav - flux_m(inc, iaz) = flux(inc, iaz) + flux_m(inc, iaz) = flux(inc, iaz) zcin = zci(inc) ! zcin =/0 by definition - zcinc = rci(inc) - - if(wave_act(inc,iaz) == 1.0) then + zcinc = rci(inc) + + if(wave_act(inc,iaz) == 1.0) then !======================================================================= ! discrete mode ! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat -! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) -!======================================================================= - +! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) +!======================================================================= + v_cdp = zcin - umfp - v_cdp2=v_cdp*v_cdp - cdf2 = v_cdp2 - c2f2 - if (v_cdp .le. ucrit_max .or. cdf2 .le. 0.0) then + v_cdp2=v_cdp*v_cdp + cdf2 = v_cdp2 - c2f2 + if (v_cdp .le. ucrit_max .or. cdf2 .le. 0.0) then ! ! between layer [k-1,k or jk-jkp] (Chi - Uk) -> ucrit_max, wave's absorption ! - wave_act(inc,iaz) =0. + wave_act(inc,iaz) =0. akzw(inc, iaz, jkp) = pi/dz_meti(jk) ! pi2/dzmet - fluxs = 0.0 !max(0., rhobnk(jkp)*ucrit3)*rdci(inc) - flux(inc,iaz) = fluxs - - else - + fluxs = 0.0 !max(0., rhobnk(jkp)*ucrit3)*rdci(inc) + flux(inc,iaz) = fluxs + + else + v_wdp = v_kxw*v_cdp wdop2 = v_wdp* v_wdp - -! + +! ! rotational cut-off -! +! kzw2 = (bn2(jkp)-wdop2)/Cdf2 ! -!cires_ugwp_initialize.F90: real, parameter :: mkzmin = pi2/80.0e3 -! +!cires_ugwp_initialize.F90: real, parameter :: mkzmin = pi2/80.0e3 +! if ( kzw2 > mkz2min ) then v_kzw = sqrt(kzw2) akzw(inc, iaz, jkp) = v_kzw -! +! !linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 -! -!kzw2 = (bn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) +! +!kzw2 = (bn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) ! Kds_sat = kxw*Cdf1*rhp2/kzw3 !krad, kvg, kion, ktg v_cdp = sqrt( cdf2 ) v_wdp = v_kxw * v_cdp - v_wdi = kzw2*vueff(jk) + kion(jk) ! supRF-diss due for "all" vars - v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) - v_kzi = v_kzw*v_wdi/v_wdpc - -! - ze1 = v_kzi*v_zmet(jk) - - if (ze1 .ge. 1.e-2) then - expdis = max(exp(-ze1), 0.01) - else - expdis = 1./(1.+ ze1) - endif - -! - wave_act(inc,iaz) = 1.0 + v_wdi = kzw2*vueff(jk) + kion(jk) ! supRF-diss due for "all" vars + v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) + v_kzi = v_kzw*v_wdi/v_wdpc + +! + ze1 = v_kzi*v_zmet(jk) + + if (ze1 .ge. 1.e-2) then + expdis = max(exp(-ze1), 0.01) + else + expdis = 1./(1.+ ze1) + endif + +! + wave_act(inc,iaz) = 1.0 fmode = flux(inc,iaz) - - flux_2_sig = v_kzw/v_kxw/rhoint(jkp) - w1 = v_wdpc/kzw2/v_kzw/v_zmet(jk) + + flux_2_sig = v_kzw/v_kxw/rhoint(jkp) + w1 = v_wdpc/kzw2/v_kzw/v_zmet(jk) else ! kzw2 <= mkz2min large "Lz"-reflection - + expdis = 1.0 v_kzw = mkzmin - + v_cdp = 0. ! no effects of reflected waves wave_act(inc,iaz) = 0.0 akzw(inc, iaz, jkp) = v_kzw - fmode = 0. - w1 =0. + fmode = 0. + w1 =0. endif ! expdis =1.0 - + fdis = fmode*expdis*wave_act(inc,iaz) !============================================================================== ! ! Saturated Fluxes and Energy: Spectral and Dicrete Modes -! +! ! S2003 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz))**2/zcin ! WM2001 fluxs= fden_bn(jk)*(zcin-ui(jk,iaz)) ! saturated flux + wave dissipation - Keddy_gwsat in UGWP-V1 ! linsatdis = 1.0 , here: u'^2 ~ linsatdis* [v_cdp*v_cdp] ! ! old-sat fluxs= fden_bn(jkp)*cdf2*zcinc*wave_act(inc,iaz) -! fluxs= fden_bn(jkp)*cdf2*zcinc*wave_act(inc,iaz) +! fluxs= fden_bn(jkp)*cdf2*zcinc*wave_act(inc,iaz) ! new sat fluxs= fden_bn(jkp)*sqrt(cdf2)*wave_act(inc,iaz) -! +! ! fluxs= fden_bn(jkp)*sqrt(cdf2)*wave_act(inc,iaz) -! +! ! ! old spectral sat-limit with "mapping to source-level" sp_tau(cd) = fden_bn(jkp)*sqrt(cdf2) ! new spectral sat-limit with "mapping to source-level" sp_tau(cd) = fden_bn(jkp)*cdf2*rstar2 @@ -623,402 +623,402 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! fsat = rstar*(zcin*zcin) * [taub_src / SN * [ rstar3*rho/rho_src *N_src/N] = fden_bn ] if (ener_norm == 0) fluxs= fden_bn(jkp)*cdf2*wave_act(inc,iaz) ! dim-n: Pa/[m/s] -! +! ! single mode saturation limit: [rho(z)/bn(z)*kx *linsat2* cd^3] /dc -! - if (ener_lsat == 1) fluxs= fden_Lsat(jkp)*cdf2*sqrt(cdf2)*rdci(inc)*wave_act(inc,iaz) - - if (ener_norm == 1) then - -! spectral saturation limit - - if (ener_lsat == 0) fluxs= fden_bnen(jk)*cdf2*wave_act(inc,iaz)*sig_u2az_m(iaz) - -! single mode saturation limit: [rho(z)/bn(z)*kx *linsat2* cd^3] /dc - - if (ener_lsat == 1) fluxs= fden_Lsat(jkp)*cdf2*sqrt(cdf2)*rdci(inc)*wave_act(inc,iaz) -! - endif +! + if (ener_lsat == 1) fluxs= fden_Lsat(jkp)*cdf2*sqrt(cdf2)*rdci(inc)*wave_act(inc,iaz) + + if (ener_norm == 1) then + +! spectral saturation limit + + if (ener_lsat == 0) fluxs= fden_bnen(jk)*cdf2*wave_act(inc,iaz)*sig_u2az_m(iaz) + +! single mode saturation limit: [rho(z)/bn(z)*kx *linsat2* cd^3] /dc + + if (ener_lsat == 1) fluxs= fden_Lsat(jkp)*cdf2*sqrt(cdf2)*rdci(inc)*wave_act(inc,iaz) +! + endif !---------------------------------------------------------------------------- -! dicrete mode saturation fden_sat(jkp) = rhoint(jkp)/bn(jkp)*v_kxw +! dicrete mode saturation fden_sat(jkp) = rhoint(jkp)/bn(jkp)*v_kxw ! fluxs = fden_sat(jkp)*cdf2*sqrt(cdf2)/zdci(inc)*L2sat ! fluxs_src = fden_sat(ksrc)*cdf2*sqrt(cdf2)/zdci(inc)*L2sat !---------------------------------------------------------------------------- zdep = fdis-fluxs ! dimension [Pa/dc] *dc = Pa if(zdep > 0.0 ) then ! subs on sat-limit - ze1 = flux(inc,iaz) + ze1 = flux(inc,iaz) flux(inc,iaz) = fluxs - ze2 = log(ze1/fluxs)*w1 ! Kdsat-compute damping of mode =>df = f-fluxs - ! here we can add extra-dissip for the next layer + ze2 = log(ze1/fluxs)*w1 ! Kdsat-compute damping of mode =>df = f-fluxs + ! here we can add extra-dissip for the next layer else ! assign dis-ve flux flux(inc,iaz) = fdis endif - - dtau = flux_m(inc,iaz)-flux(inc,iaz) - if (dtau .lt. 0) then - flux(inc,iaz) = flux_m(inc,iaz) - endif + + dtau = flux_m(inc,iaz)-flux(inc,iaz) + if (dtau .lt. 0) then + flux(inc,iaz) = flux_m(inc,iaz) + endif ! ! GW-sponge domain: saturate all "GW"-modes above "zsp_gw" ! if ( azmeti(jkp) .ge. zsp_gw) then - mi_sponge = .5/dz_meti(jk) - ze2 = v_wdp /v_kzw * mi_sponge ! Ksat*v_kzw2 = [mi_sat*wdp/kzw] - v_wdi = ze2 + v_wdi*0.25 ! diss-sat GW-sponge - v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) - v_kzi = v_kzw*v_wdi/v_wdpc -! - ze1 = v_kzi*v_zmet(jk) - exp_sponge = exp(-ze1) -! + mi_sponge = .5/dz_meti(jk) + ze2 = v_wdp /v_kzw * mi_sponge ! Ksat*v_kzw2 = [mi_sat*wdp/kzw] + v_wdi = ze2 + v_wdi*0.25 ! diss-sat GW-sponge + v_wdpc = sqrt(v_wdp*v_wdp +v_wdi*v_wdi) + v_kzi = v_kzw*v_wdi/v_wdpc +! + ze1 = v_kzi*v_zmet(jk) + exp_sponge = exp(-ze1) +! ! additional sponge -! - flux(inc,iaz) = flux(inc,iaz) *exp_sponge - endif - - endif ! coriolis or CL condition-checkif => (v_cdp .le. ucrit_max) then +! + flux(inc,iaz) = flux(inc,iaz) *exp_sponge + endif + + endif ! coriolis or CL condition-checkif => (v_cdp .le. ucrit_max) then endif ! only for waves w/o CL-absorption wave_act=1 ! ! sum for given (jk, iaz) all active "wave" contributions -! - if (wave_act(inc,iaz) == 1) then - - zcinc =zdci(inc) +! + if (wave_act(inc,iaz) == 1) then + + zcinc =zdci(inc) vc_zflx_mode = flux(inc,iaz) vmdiff = max(0., flux_m(inc,iaz)-vc_zflx_mode) if (vmdiff <= 0. ) vc_zflx_mode = flux_m(inc,iaz) - ze1 = vc_zflx_mode*zcinc - fpu(iaz, jkp) = fpu(iaz,jkp) + ze1 ! flux (pa) at - sig_u2az(iaz) = sig_u2az(iaz) + ze1*flux_2_sig ! ekin(m2/s2) at z+dz - + ze1 = vc_zflx_mode*zcinc + fpu(iaz, jkp) = fpu(iaz,jkp) + ze1 ! flux (pa) at + sig_u2az(iaz) = sig_u2az(iaz) + ze1*flux_2_sig ! ekin(m2/s2) at z+dz + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! (heat deposition integration over spectral mode for each azimuth ! later sum over selected azimuths as "non-negative" scalars) ! cdf1 = sqrt( (zci(inc)-umfc)**2-c2f2) !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -! zdelp = wrk3(jk)*cdf1 *zcinc - +! zdelp = wrk3(jk)*cdf1 *zcinc + zdelp = wrk3(jk)* v_cdp *zcinc * vmdiff - -! zcool = 1. ! COOL=(-3.5 + Pr)/Pr -! zcool = [Kv/Pr]*N2*(Pr-Cp/R)/cp -! edis = (c-u)*ax/cp = Kv_dis*N2/cp + +! zcool = 1. ! COOL=(-3.5 + Pr)/Pr +! zcool = [Kv/Pr]*N2*(Pr-Cp/R)/cp +! edis = (c-u)*ax/cp = Kv_dis*N2/cp ! cool = -Kt*N2/R -! add heat-conduction "bulk" impact: 1/Pr*(g*g*rho)* d [rho*Kv(dT/dp- R/Cp *T/p)] -! +! add heat-conduction "bulk" impact: 1/Pr*(g*g*rho)* d [rho*Kv(dT/dp- R/Cp *T/p)] +! dfdz_v(iaz, jk) = dfdz_v(iaz,jk) + zdelp ! +cool !heating & simple cooling < 0 - dfdz_heat(iaz, jk) = dfdz_heat(iaz,jk) + zdelp ! heating -only > 0 - endif !wave_act(inc,iaz) == 1) -! - enddo ! wave-inc-loop - + dfdz_heat(iaz, jk) = dfdz_heat(iaz,jk) + zdelp ! heating -only > 0 + endif !wave_act(inc,iaz) == 1) +! + enddo ! wave-inc-loop + ze1 =fpu(iaz, jk) if (fpu(iaz, jkp) > ze1 ) fpu(iaz, jkp) = ze1 ! ! compute wind and temp-re rms ! - if (idebug_gwrms == 1) then - pwrms =0. - ptrms =0. - do inc=1, nwav - if (wave_act(inc,iaz) > 0.) then - v_kzw =akzw(inc, iaz, jk) + if (idebug_gwrms == 1) then + pwrms =0. + ptrms =0. + do inc=1, nwav + if (wave_act(inc,iaz) > 0.) then + v_kzw =akzw(inc, iaz, jk) ze1 = flux(inc,iaz)*v_kzw*zdci(inc)*wrk1(jk) - pwrms = pwrms + ze1 - ptrms = ptrms + ze1*wrk2(jk) - endif - enddo - Awrms(iaz, jk) = pwrms - Atrms(iaz, jk) = ptrms - endif + pwrms = pwrms + ze1 + ptrms = ptrms + ze1*wrk2(jk) + endif + enddo + Awrms(iaz, jk) = pwrms + Atrms(iaz, jk) = ptrms + endif ! -------------- enddo ! end Azimuth do-loop - -! -! eddy wave dissipation to limit GW-rms -! - tx1 = sum(abs(dfdz_heat(1:nazd, jk)))/bn2(jk) - ze1=max(dked_min, tx1) - ze2=min(dked_max, ze1) - vueff(jkp) = ze2 + vueff(jkp) -! + +! +! eddy wave dissipation to limit GW-rms +! + tx1 = sum(abs(dfdz_heat(1:nazd, jk)))/bn2(jk) + ze1=max(dked_min, tx1) + ze2=min(dked_max, ze1) + vueff(jkp) = ze2 + vueff(jkp) +! enddo ! end Vertical do-loop ! ! top-layers constant interface-fluxes and zero-heat -! we allow non-zero momentum fluxes and thermal effects -! fpu(1:nazd,levs+1) = fpu(1:nazd, levs) +! we allow non-zero momentum fluxes and thermal effects +! fpu(1:nazd,levs+1) = fpu(1:nazd, levs) ! dfdz_v(1:nazd, levs) = 0.0 - -! --------------------------------------------------------------------- + +! --------------------------------------------------------------------- ! sum contribution for total zonal and meridional fluxes + ! energy dissipation ! --------------------------------------------------- -! +! !======================================================================== ! at the source level and below taux = 0 (taux_E=-taux_W by assumption) !======================================================================== - + do jk=ksrc, levs - taux(jk) = 0.0 - tauy(jk) = 0.0 + taux(jk) = 0.0 + tauy(jk) = 0.0 do iaz=1,nazd - taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) - tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) + taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) + tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) pdtdt(jl,jk) = pdtdt(jl,jk) + dfdz_v(iaz,jk) - dked(jl,jk) = dked(jl,jk) + dfdz_heat(iaz,jk) - enddo + dked(jl,jk) = dked(jl,jk) + dfdz_heat(iaz,jk) + enddo enddo jk = ktop; taux(jk)=0.; tauy(jk)=0. - do iaz=1,nazd - taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) - tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) + do iaz=1,nazd + taux(jk) = taux(jk) + fpu(iaz,jk)*zcosang(iaz) + tauy(jk) = tauy(jk) + fpu(iaz,jk)*zsinang(iaz) enddo - - if (idebug_gwrms == 1) then - do jk=kp1, levs - do iaz=1,nazd + + if (idebug_gwrms == 1) then + do jk=kp1, levs + do iaz=1,nazd wrms(jl,jk) =wrms(jl,jk) + Awrms(iaz,jk) - trms(jl,jk) =trms(jl,jk) + Atrms(iaz,jk) - tauabs(jl,jk)=tauabs(jl,jk) + fpu(iaz,jk) + trms(jl,jk) =trms(jl,jk) + Atrms(iaz,jk) + tauabs(jl,jk)=tauabs(jl,jk) + fpu(iaz,jk) enddo - enddo - endif + enddo + endif ! do jk=ksrc+1,levs jkp = jk + 1 - zdelp = wrk3(jk)*gw_eff - ze1 = (taux(jkp)-taux(jk))* zdelp + zdelp = wrk3(jk)*gw_eff + ze1 = (taux(jkp)-taux(jk))* zdelp ze2 = (tauy(jkp)-tauy(jk))* zdelp - + if (abs(ze1) >= maxdudt ) then ze1 = sign(maxdudt, ze1) - endif + endif if (abs(ze2) >= maxdudt ) then ze2 = sign(maxdudt, ze2) endif - + pdudt(jl,jk) = -ze1 pdvdt(jl,jk) = -ze2 ! ! Cx =0 based Cx=/= 0. above ! -! +! if (knob_ugwp_doheat == 1) then -! +! !maxdtdt= dked_max * bnfix2 -! +! pdtdt(jl,jk) = pdtdt(jl,jk)*gw_eff - ze2 = pdtdt(jl,jk) - if (abs(ze2) >= max_eps ) pdtdt(jl,jk) = sign(max_eps, ze2) - - dked(jl,jk) = dked(jl,jk)/bn2(jk) - ze1 = max(dked_min, dked(jl,jk)) - dked(jl,jk) = min(dked_max, ze1) - qmid(jk) = pdtdt(j,jk) - endif + ze2 = pdtdt(jl,jk) + if (abs(ze2) >= max_eps ) pdtdt(jl,jk) = sign(max_eps, ze2) + + dked(jl,jk) = dked(jl,jk)/bn2(jk) + ze1 = max(dked_min, dked(jl,jk)) + dked(jl,jk) = min(dked_max, ze1) + qmid(jk) = pdtdt(j,jk) + endif enddo -!---------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------- ! Update heat = ek_diss/cp and aply 1-2-1 smoother for "dked" => dktur ! here with "u_new = u +dtp*dudt ; vnew = v + v +dtp*dvdt ! can check "stability" in the column and "add" ktur-estimation ! to suppress instability as needed so dked = dked_gw + ktur_ric -!---------------------------------------------------------------------------------- - - dktur(1:levs) = dked(jl,1:levs) +!---------------------------------------------------------------------------------- + + dktur(1:levs) = dked(jl,1:levs) ! - do ist= 1, nstdif + do ist= 1, nstdif do jk=ksrc,levs-1 - adif(jk) =.25*(dktur(jk-1)+ dktur(jk+1)) + .5*dktur(jk) + adif(jk) =.25*(dktur(jk-1)+ dktur(jk+1)) + .5*dktur(jk) enddo dktur(ksrc:levs-1) = adif(ksrc:levs-1) enddo dktur(levs) = .5*( dked(jl,levs)+ dked(jl,levs-1)) dktur(levs+1) = dktur(levs) - + do jk=ksrc,levs - ze1 = .5*( dktur(jk) +dktur(jk-1) ) - kvint(jk) = ze1 - ktint(jk) = ze1*iPr_ktgw - enddo - + ze1 = .5*( dktur(jk) +dktur(jk-1) ) + kvint(jk) = ze1 + ktint(jk) = ze1*iPr_ktgw + enddo + ! ! Thermal budget qmid = qheat + qcool -! - do jk=ksrc+1,levs +! + do jk=ksrc+1,levs ze2 = qmid(jk) + dktur(jk)*Akt(jk) + grav*(ktint(jk+1)-ktint(jk))/dz_meti(jk) - qmid(jk) = ze2 - if (abs(ze2) >= max_eps ) qmid(jk) = sign(max_eps, ze2) + qmid(jk) = ze2 + if (abs(ze2) >= max_eps ) qmid(jk) = sign(max_eps, ze2) pdtdt(jl,jk) = qmid(jk)*rcpd - dked(jl, jk) = dktur(jk) - enddo + dked(jl, jk) = dktur(jk) + enddo ! ! perform explicit eddy "diffusive" 3-point smoothing of "u-v-t" ! from the surface/launch-gw to the "top" -! +! ! ! update by source function X(t+dt) = X(t) + dtp * dXdt -! - uold(km2:levs) = aum(km2:levs)+pdudt(jl,km2:levs)*dtp - vold(km2:levs) = avm(km2:levs)+pdvdt(jl,km2:levs)*dtp - told(km2:levs) = atm(km2:levs)+pdtdt(jl,km2:levs)*dtp +! + uold(km2:levs) = aum(km2:levs)+pdudt(jl,km2:levs)*dtp + vold(km2:levs) = avm(km2:levs)+pdvdt(jl,km2:levs)*dtp + told(km2:levs) = atm(km2:levs)+pdtdt(jl,km2:levs)*dtp ! ! diagnose turb-profile using "stability-check" relying on the free-atm diffusion ! sc2 = 30m x 30m -! - dktur(km2:levs) = dked_min - - do jk=km1,levs - uz = uold(jk) - uold(jk-1) +! + dktur(km2:levs) = dked_min + + do jk=km1,levs + uz = uold(jk) - uold(jk-1) vz = vold(jk) - vold(jk-1) - ze1 = dz_met(jk) - zdelm = 1./ze1 - + ze1 = dz_met(jk) + zdelm = 1./ze1 + tvc = told(jk) * (1. +fv*aqm(jk)) tvm = told(jk-1) * (1. +fv*aqm(jk-1)) - zthm = 2.0 / (tvc+tvm) - shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm - + zthm = 2.0 / (tvc+tvm) + shr2 = (max(uz*uz+vz*vz, dw2min)) * zdelm *zdelm + bn2(jk) = grav2cpd*zthm * (1.0+rcpdl*(tvc-tvm)*zdelm) - - bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) + + bn2(jk) = max(min(bn2(jk), bnv2max), bnv2min) zmetk = azmet(jk)* rh4 ! mid-layer height k_int => k_int+1 zgrow = exp(zmetk) - ritur = bn2(jk)/shr2 - w1 = 1./(1. + 5*ritur) - ze2 = min( sc2 *zgrow, 4.*ze1*ze1) + ritur = bn2(jk)/shr2 + w1 = 1./(1. + 5*ritur) + ze2 = min( sc2 *zgrow, 4.*ze1*ze1) ! ! Smag-type of eddy diffusion K_smag = Sqrt(Deformation - N2/Pr)* L2 *const -! - kamp = sqrt(shr2)* ze2 * w1 * w1 - ktur= min(max(kamp, dked_min), dked_max) - dktur(jk) = ktur +! + kamp = sqrt(shr2)* ze2 * w1 * w1 + ktur= min(max(kamp, dked_min), dked_max) + dktur(jk) = ktur ! ! update of dked = dked_gw + k_turb_mf -! - dked(jl, jk) = dked(jl, jk) +ktur - - enddo - +! + dked(jl, jk) = dked(jl, jk) +ktur + + enddo + ! ! apply eddy effects due to GWs: explicit scheme Kzz*dt/dz2 < 0.5 stability -! - if (knob_ugwp_dokdis == 2) then - +! + if (knob_ugwp_dokdis == 2) then + do jk=km1,levs - ze1 = min(.5*(dktur(jk) +dktur(jk-1)), dturb_max) - kvint(jk) = kvint(jk) + ze1 -! ktint(jk) = ktint(jk) + ze1*iPr_ktgw - enddo - - kvint(ktop) = kvint(levs) - - dzmetm = 1./dz_met(km1) - Adif(km1:levs) = 0. - Cdif(km1:levs) = 0. - do jk=km1,levs-1 - - dzmetp = 1./dz_met(jk+1) - dzmetf = 1./(dz_meti(jk)*rhomid(jk)) - - - ktur = kvint(jk) *rhoint(jk) * dzmetf - kturp =Kvint(jk+1)*rhoint(jk+1) * dzmetf - - Adif(jk) = ktur * dzmetm - Cdif(jk) = kturp * dzmetp - ApC = adif(jk)+cdif(jk) - ACdif(jk) = ApC - - w1 = ApC*iPr_max - if (rdtp < w1 ) then - Anstab(jk) = floor(w1*dtp) + 1 - else - Anstab(jk) = 1 - endif - dzmetm = dzmetp - enddo - - nstab = maxval( Anstab(ksrc:levs-1)) - -! if (nstab .ge. 3) print *, 'nstab ', nstab -! + ze1 = min(.5*(dktur(jk) +dktur(jk-1)), dturb_max) + kvint(jk) = kvint(jk) + ze1 +! ktint(jk) = ktint(jk) + ze1*iPr_ktgw + enddo + + kvint(ktop) = kvint(levs) + + dzmetm = 1./dz_met(km1) + Adif(km1:levs) = 0. + Cdif(km1:levs) = 0. + do jk=km1,levs-1 + + dzmetp = 1./dz_met(jk+1) + dzmetf = 1./(dz_meti(jk)*rhomid(jk)) + + + ktur = kvint(jk) *rhoint(jk) * dzmetf + kturp =Kvint(jk+1)*rhoint(jk+1) * dzmetf + + Adif(jk) = ktur * dzmetm + Cdif(jk) = kturp * dzmetp + ApC = adif(jk)+cdif(jk) + ACdif(jk) = ApC + + w1 = ApC*iPr_max + if (rdtp < w1 ) then + Anstab(jk) = floor(w1*dtp) + 1 + else + Anstab(jk) = 1 + endif + dzmetm = dzmetp + enddo + + nstab = maxval( Anstab(ksrc:levs-1)) + +! if (nstab .ge. 3) print *, 'nstab ', nstab +! ! k instead Jk -! - dtdif = dtp/real(nstab) - ze1 = 1./dtdif - - do ist= 1, nstab - do k=ksrc,levs-1 - Bdif = ze1 - ACdif(k) - Bt_dif = ze1 - ACdif(k)* iPr_ktgw ! ipr_Ktgw = 1./Pr <1 - unew(k) = uold(k)*Bdif + uold(k-1)*Adif(k) + uold(k+1)*Cdif(k) - vnew(k) = vold(k)*Bdif + vold(k-1)*Adif(k) + vold(k+1)*Cdif(k) - tnew(k) = told(k)*Bt_dif+(told(k-1)*Adif(k) + told(k+1)*Cdif(k))*iPr_ktgw - enddo - - uold(ksrc:levs-1) = unew(ksrc:levs-1)*dtdif ! value du/dtp *dtp = du - vold(ksrc:levs-1) = vnew(ksrc:levs-1)*dtdif - told(ksrc:levs-1) = tnew(ksrc:levs-1)*dtdif +! + dtdif = dtp/real(nstab) + ze1 = 1./dtdif + + do ist= 1, nstab + do k=ksrc,levs-1 + Bdif = ze1 - ACdif(k) + Bt_dif = ze1 - ACdif(k)* iPr_ktgw ! ipr_Ktgw = 1./Pr <1 + unew(k) = uold(k)*Bdif + uold(k-1)*Adif(k) + uold(k+1)*Cdif(k) + vnew(k) = vold(k)*Bdif + vold(k-1)*Adif(k) + vold(k+1)*Cdif(k) + tnew(k) = told(k)*Bt_dif+(told(k-1)*Adif(k) + told(k+1)*Cdif(k))*iPr_ktgw + enddo + + uold(ksrc:levs-1) = unew(ksrc:levs-1)*dtdif ! value du/dtp *dtp = du + vold(ksrc:levs-1) = vnew(ksrc:levs-1)*dtdif + told(ksrc:levs-1) = tnew(ksrc:levs-1)*dtdif ! ! smoothing the boundary points: "k-1" = ksrc-1 and "k+1" = levs ! - uold(levs) = uold(levs-1) - vold(levs) = vold(levs-1) - told(levs) = told(levs-1) + uold(levs) = uold(levs-1) + vold(levs) = vold(levs-1) + told(levs) = told(levs-1) enddo ! ! compute "smoothed" tendencies by molecular + GW-eddy diffusions -! - do k=ksrc,levs-1 -! +! + do k=ksrc,levs-1 +! ! final updates of tendencies and diffusion -! - ze2 = rdtp*(uold(k) - aum(k)) - ze1 = rdtp*(vold(k) - avm(k)) - pdtdt(jl,k)= rdtp*( told(k) - atm(k) ) - - if (abs(pdtdt(jl,k)) >= maxdtdt ) pdtdt(jl,k) = sign(maxdtdt,pdtdt(jl,k) ) +! + ze2 = rdtp*(uold(k) - aum(k)) + ze1 = rdtp*(vold(k) - avm(k)) + pdtdt(jl,k)= rdtp*( told(k) - atm(k) ) + + if (abs(pdtdt(jl,k)) >= maxdtdt ) pdtdt(jl,k) = sign(maxdtdt,pdtdt(jl,k) ) if (abs(ze1) >= maxdudt ) then ze1 = sign(maxdudt, ze1) - endif + endif if (abs(ze2) >= maxdudt ) then ze2 = sign(maxdudt, ze2) endif - - pdudt(jl, k) = ze2 - pdvdt(jl, k) = ze1 - uz = uold(k+1) - uold(k-1) + + pdudt(jl, k) = ze2 + pdvdt(jl, k) = ze1 + uz = uold(k+1) - uold(k-1) vz = vold(k+1) - vold(k-1) - ze2 = 1./(dz_met(k+1)+dz_met(k) ) - mf_diss_heat = rcpd*kvint(k)*(uz*uz +vz*vz)*ze2*ze2 ! vert grad heat - pdtdt(jl,k)= pdtdt(jl,k) + mf_diss_heat ! extra heat due to eddy viscosity - - enddo - - - ENDIF ! dissipative IF-loop for vertical eddy difusion u-v-t - + ze2 = 1./(dz_met(k+1)+dz_met(k) ) + mf_diss_heat = rcpd*kvint(k)*(uz*uz +vz*vz)*ze2*ze2 ! vert grad heat + pdtdt(jl,k)= pdtdt(jl,k) + mf_diss_heat ! extra heat due to eddy viscosity + + enddo + + + ENDIF ! dissipative IF-loop for vertical eddy difusion u-v-t + enddo ! J-loop -! - RETURN - -!================================= diag print after "return" ====================== +! + RETURN + +!================================= diag print after "return" ====================== if (kdt ==1 .and. mpi_id == master) then -! +! print *, ' ugwpv1: nazd-nw-ilaunch=', nazd, nwav,ilaunch, maxval(kvg), ' kvg ' print *, 'ugwpv1: zdci(inc)=' , maxval(zdci), minval(zdci) - print *, 'ugwpv1: zcimax=' , maxval(zci) ,' zcimin=' , minval(zci) + print *, 'ugwpv1: zcimax=' , maxval(zci) ,' zcimin=' , minval(zci) ! print *, 'ugwpv1: tau_ngw=' , maxval(taub_src)*1.e3, minval(taub_src)*1.e3, tau_min print * - + endif - + if (kdt == 1 .and. mpi_id == master) then print *, 'vgw done nstab ', nstab ! @@ -1029,8 +1029,8 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! ! print *, ' ugwp -heating rates ' endif -!================================= - return +!================================= + return end subroutine cires_ugwpv1_ngw_solv2 From 79ae254afab6f9d1dd22004fed1f6123480ebfff Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 2 Feb 2021 13:52:19 -0600 Subject: [PATCH 189/274] update merra2 before a new pull request --- physics/GFS_phys_time_vary.fv3.F90 | 23 +++-- physics/aerclm_def.F | 4 +- physics/aerinterp.F90 | 100 ++++++++++----------- physics/radiation_aerosols.f | 2 +- physics/samfdeepcnv.f | 138 ++++++++++++++--------------- 5 files changed, 138 insertions(+), 129 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 3c894b777..9354603cf 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -18,7 +18,7 @@ module GFS_phys_time_vary use h2ointerp, only : read_h2odata, setindxh2o, h2ointerpol use aerclm_def, only : aerin, aer_pres, ntrcaer, ntrcaerm - use aerinterp, only : read_aerdata, setindxaer, aerinterpol + use aerinterp, only : read_aerdata, setindxaer, aerinterpol, read_aerdataf use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol @@ -59,14 +59,17 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! Local variables integer :: nb, nblks, nt - integer :: i, j, ix + integer :: i, j, ix, iamin, iamax, jamin, jamax logical :: non_uniform_blocks ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (is_initialized) return - + iamin=999 + iamax=-999 + jamin=999 + jamax=-999 nblks = size(Model%blksz) ! Non-uniform blocks require special handling: instead @@ -100,6 +103,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP shared (Model,Data,Interstitial,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres) & !$OMP shared (levh2o,h2o_coeff,h2o_pres) & +!$OMP shared (iamin, iamax, jamin, jamax) & !$OMP shared (ntrcaer,nblks,nthrds,non_uniform_blocks) #ifdef OPENMP @@ -230,14 +234,22 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !> - Call setindxaer() to initialize aerosols data if (Model%iaerclm) then -!$OMP do schedule (dynamic,1) +!$OMP single +!!!!$OMP do schedule (dynamic,1) do nb = 1, nblks call setindxaer (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_aer, & Data(nb)%Grid%jindx2_aer, Data(nb)%Grid%ddy_aer, Data(nb)%Grid%xlon_d, & Data(nb)%Grid%iindx1_aer, Data(nb)%Grid%iindx2_aer, Data(nb)%Grid%ddx_aer, & Model%me, Model%master) + iamin=min(minval(Data(nb)%Grid%iindx1_aer), iamin) + iamax=max(maxval(Data(nb)%Grid%iindx2_aer), iamax) + jamin=min(minval(Data(nb)%Grid%jindx1_aer), jamin) + jamax=max(maxval(Data(nb)%Grid%jindx2_aer), jamax) enddo -!$OMP end do +!!!!$OMP end do + call read_aerdataf (iamin, iamax, jamin, jamax, Model%me,Model%master,Model%iflip, & + Model%idate,errmsg,errflg) +!$OMP end single endif !> - Call setindxci() to initialize IN and CCN data @@ -497,7 +509,6 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, enddo endif endif - #if 0 !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) if (first_time_step) then diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F index 84852a1de..426881fe4 100644 --- a/physics/aerclm_def.F +++ b/physics/aerclm_def.F @@ -2,8 +2,8 @@ module aerclm_def use machine , only : kind_phys implicit none - integer, parameter :: levsaer=50, ntrcaerm=15, timeaer=12 - integer :: latsaer, lonsaer, ntrcaer + integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=12 + integer :: latsaer, lonsaer, ntrcaer, levsw character*10 :: specname(ntrcaerm) real (kind=kind_phys):: aer_time(13) diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index e7cd6ca20..8686bfa78 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -11,7 +11,7 @@ module aerinterp private - public :: read_aerdata, setindxaer, aerinterpol + public :: read_aerdata, setindxaer, aerinterpol, read_aerdataf contains @@ -32,11 +32,6 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) logical :: file_exist integer, allocatable :: invardims(:) - real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff - real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx - real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp - real(kind=kind_io8),allocatable,dimension(:) :: aer_lati - real(kind=kind_io8),allocatable,dimension(:) :: aer_loni ! !! =================================================================== if (me == master) then @@ -72,50 +67,62 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) ! specify latsaer, lonsaer, hmx lonsaer = dim1 latsaer = dim2 - hmx = int(dim1/2) ! to swap long from W-E to E-W + levsw = dim3 if(me==master) then print *, 'MERRA2 dim: ',dim1, dim2, dim3 endif ! allocate arrays - if (.not. allocated(aer_loni)) then - allocate (aer_loni(lonsaer)) - allocate (aer_lati(latsaer)) - endif if (.not. allocated(aer_lat)) then allocate(aer_lat(latsaer)) allocate(aer_lon(lonsaer)) - allocate(aerin(lonsaer,latsaer,levsaer,ntrcaerm,timeaer)) - allocate(aer_pres(lonsaer,latsaer,levsaer,timeaer)) endif ! construct lat/lon array call nf_inq_varid(ncid, 'lat', varid) - call nf_get_var(ncid, varid, aer_lati) + call nf_get_var(ncid, varid, aer_lat) call nf_inq_varid(ncid, 'lon', varid) - call nf_get_var(ncid, varid, aer_loni) - - do i = 1, hmx ! flip from (-180,180) to (0,360) - if(aer_loni(i)<0.) aer_loni(i)=aer_loni(i)+360. - aer_lon(i+hmx) = aer_loni(i) - aer_lon(i) = aer_loni(i+hmx) - enddo + call nf_get_var(ncid, varid, aer_lon) + call nf_close(ncid) + END SUBROUTINE read_aerdata +! +!********************************************************************** + SUBROUTINE read_aerdataf (iamin, iamax, jamin, jamax, & + me, master, iflip, idate, errmsg, errflg) + use machine, only: kind_phys, kind_io4, kind_io8 + use aerclm_def + use netcdf - do i = 1, latsaer - aer_lat(i) = aer_lati(i) - enddo +!--- in/out + integer, intent(in) :: me, master, iflip, idate(4) + integer, intent(in) :: iamin, iamax, jamin, jamax + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg - call nf_close(ncid) +!--- locals + integer :: ncid, varid + integer :: i, j, k, n, ii, imon, klev + character :: fname*50, mn*2, vname*10 + logical :: file_exist + integer, allocatable :: invardims(:) + real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff + real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx + real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp +! + if (.not. allocated(aerin)) then + allocate(aerin(iamin:iamax,jamin:jamax,levsaer,ntrcaerm,timeaer)) + allocate(aer_pres(iamin:iamax,jamin:jamax,levsaer,timeaer)) + endif ! allocate local working arrays if (.not. allocated(buff)) then - allocate (buff(lonsaer, latsaer, dim3)) - allocate (pres_tmp(lonsaer,dim3)) + allocate (buff(lonsaer, latsaer, levsw)) + allocate (pres_tmp(lonsaer,levsw)) endif if (.not. allocated(buffx)) then - allocate (buffx(lonsaer, latsaer, dim3,1)) + allocate (buffx(lonsaer, latsaer, levsw,1)) endif !! =================================================================== @@ -137,11 +144,11 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) call nf_inq_varid(ncid, "DELP", varid) call nf_get_var(ncid, varid, buff) - do j = 1, latsaer - do i = 1, lonsaer + do j = jamin, jamax + do i = iamin, iamax ! constract pres_tmp (top-down), note input is top-down pres_tmp(i,1) = 0. - do k=2, dim3 + do k=2, levsw pres_tmp(i,k) = pres_tmp(i,k-1)+buff(i,j,k) enddo !k-loop enddo !i-loop (lon) @@ -151,11 +158,10 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) if ( iflip == 0 ) then ! data from toa to sfc klev = k else ! data from sfc to top - klev = ( dim3 - k ) + 1 + klev = ( levsw - k ) + 1 endif - do i = 1, hmx - aer_pres(i+hmx,j,k,imon)= 1.d0*pres_tmp(i,klev) - aer_pres(i,j,k,imon) = 1.d0*pres_tmp(i+hmx,klev) + do i = iamin, iamax + aer_pres(i,j,k,imon) = 1.d0*pres_tmp(i,klev) enddo !i-loop (lon) enddo !k-loop (lev) enddo !j-loop (lat) @@ -168,22 +174,18 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) call nf_inq_varid(ncid, vname, varid) call nf_get_var(ncid, varid, buffx) - do j = 1, latsaer + do j = jamin, jamax do k = 1, levsaer ! input is from toa to sfc if ( iflip == 0 ) then ! data from toa to sfc klev = k else ! data from sfc to top - klev = ( dim3 - k ) + 1 + klev = ( levsw - k ) + 1 endif - do i = 1, hmx - aerin(i+hmx,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) - if(aerin(i+hmx,j,k,ii,imon)<0.or.aerin(i+hmx,j,k,ii,imon)>1.) then - aerin(i+hmx,j,k,ii,imon) = 0. - end if - aerin(i,j,k,ii,imon) = 1.d0*buffx(i+hmx,j,klev,1) + do i = iamin, iamax + aerin(i,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) if(aerin(i,j,k,ii,imon)<0.or.aerin(i,j,k,ii,imon)>1.) then - aerin(i,j,k,ii,imon) = 0. + aerin(i,j,k,ii,imon) = 1.e-15 end if enddo !i-loop (lon) enddo !k-loop (lev) @@ -195,13 +197,9 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) call nf_close(ncid) enddo !imon-loop !--- - deallocate (aer_loni, aer_lati) deallocate (buff, pres_tmp) deallocate (buffx) - - END SUBROUTINE read_aerdata -! -!********************************************************************** + END SUBROUTINE read_aerdataf ! SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & iindx1,iindx2,ddx,me,master) @@ -341,7 +339,7 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& +tx2*(TEMI*TEMJ*aer_pres(I1,J1,L,n2)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n2) & +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) - + ENDDO ENDDO @@ -369,7 +367,7 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & tx1 = temi/(aerpres(j,i1) - aerpres(j,i2)) tx2 = temj/(aerpres(j,i1) - aerpres(j,i2)) DO ii = 1, ntrcaer - aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 + aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 ENDDO endif ENDDO !L-loop diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 130c6471f..e1e66b0d9 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -561,7 +561,7 @@ subroutine aer_init & laswflg= (mod(iaerflg,10) > 0) ! control flag for sw tropospheric aerosol lalwflg= (mod(iaerflg/10,10) > 0) ! control flag for lw tropospheric aerosol - lavoflg= (iaerflg >= 100) ! control flag for stratospheric volcanic aeros + lavoflg= (mod(iaerflg/100,10) >0) ! control flag for stratospheric volcanic aeros !> -# Call wrt_aerlog() to write aerosol parameter configuration to output logs. diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index f2a21c683..1b71e011e 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -161,7 +161,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & jmin(im), lmin(im), kbmax(im), & kbm(im), kmax(im) ! - real(kind=kind_phys) acrt(im), acrtfct(im) +! real(kind=kind_phys) aa1(im), acrt(im), acrtfct(im), real(kind=kind_phys) aa1(im), tkemean(im),clamt(im), & ps(im), del(im,km), prsl(im,km), & umean(im), tauadv(im), gdx(im), @@ -247,18 +247,18 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & & qrcko(im,km), qrcdo(im,km), & pwo(im,km), pwdo(im,km), c0t(im,km), & tx1(im), sumx(im), cnvwt(im,km) - &, rhbar(im) +! &, rhbar(im) ! logical do_aerosols, totflg, cnvflg(im), asqecflg(im), flg(im) ! ! asqecflg: flag for the quasi-equilibrium assumption of Arakawa-Schubert ! - real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) - save pcrit, acritt - data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., - & 350.,300.,250.,200.,150./ - data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, - & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ +! real(kind=kind_phys) pcrit(15), acritt(15), acrit(15) +!! save pcrit, acritt +! data pcrit/850.,800.,750.,700.,650.,600.,550.,500.,450.,400., +! & 350.,300.,250.,200.,150./ +! data acritt/.0633,.0445,.0553,.0664,.075,.1082,.1521,.2216, +! & .3151,.3677,.41,.5255,.7663,1.1686,1.6851/ c gdas derived acrit c data acritt/.203,.515,.521,.566,.625,.665,.659,.688, c & .743,.813,.886,.947,1.138,1.377,1.896/ @@ -318,8 +318,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & edt(i) = 0. edto(i) = 0. edtx(i) = 0. - acrt(i) = 0. - acrtfct(i) = 1. +! acrt(i) = 0. +! acrtfct(i) = 1. aa1(i) = 0. aa2(i) = 0. xaa0(i) = 0. @@ -395,9 +395,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo endif c - do k = 1, 15 - acrit(k) = acritt(k) * (975. - pcrit(k)) - enddo +! do k = 1, 15 +! acrit(k) = acritt(k) * (975. - pcrit(k)) +! enddo ! dt2 = delt ! val = 1200. @@ -1246,7 +1246,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! aa1(i) = 0. qcko(i,kb(i)) = qo(i,kb(i)) qrcko(i,kb(i)) = qo(i,kb(i)) - rhbar(i) = 0. +! rhbar(i) = 0. endif enddo !> - Calculate the moisture content of the entraining/detraining parcel (qcko) and the value it would have if just saturated (qrch), according to equation A.14 in Grell (1993) \cite grell_1993 . Their difference is the amount of convective cloud water (qlk = rain + condensate). Determine the portion of convective cloud water that remains suspended and the portion that is converted into convective precipitation (pwo). Calculate and save the negative cloud work function (aa1) due to water loading. The liquid water in the updraft layer is assumed to be detrained from the layers above the level of the minimum moist static energy into the grid-scale cloud water (dellal). @@ -1268,7 +1268,7 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & cj dq = eta(i,k) * (qcko(i,k) - qrch) c - rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) +! rhbar(i) = rhbar(i) + qo(i,k) / qeso(i,k) c c check if there is excess moisture to release latent heat c @@ -1311,12 +1311,12 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & enddo enddo c - do i = 1, im - if(cnvflg(i)) then - indx = ktcon(i) - kb(i) - 1 - rhbar(i) = rhbar(i) / float(indx) - endif - enddo +! do i = 1, im +! if(cnvflg(i)) then +! indx = ktcon(i) - kb(i) - 1 +! rhbar(i) = rhbar(i) / float(indx) +! endif +! enddo c c calculate cloud work function c @@ -2319,56 +2319,56 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & c c calculate critical cloud work function c - do i = 1, im - if(cnvflg(i)) then - if(pfld(i,ktcon(i)) < pcrit(15))then - acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) - & /(975.-pcrit(15)) - else if(pfld(i,ktcon(i)) > pcrit(1))then - acrt(i)=acrit(1) - else - k = int((850. - pfld(i,ktcon(i)))/50.) + 2 - k = min(k,15) - k = max(k,2) - acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* - & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) - endif - endif - enddo - do i = 1, im - if(cnvflg(i)) then - if(islimsk(i) == 1) then - w1 = w1l - w2 = w2l - w3 = w3l - w4 = w4l - else - w1 = w1s - w2 = w2s - w3 = w3s - w4 = w4s - endif +! do i = 1, im +! if(cnvflg(i)) then +! if(pfld(i,ktcon(i)) < pcrit(15))then +! acrt(i)=acrit(15)*(975.-pfld(i,ktcon(i))) +! & /(975.-pcrit(15)) +! else if(pfld(i,ktcon(i)) > pcrit(1))then +! acrt(i)=acrit(1) +! else +! k = int((850. - pfld(i,ktcon(i)))/50.) + 2 +! k = min(k,15) +! k = max(k,2) +! acrt(i)=acrit(k)+(acrit(k-1)-acrit(k))* +! & (pfld(i,ktcon(i))-pcrit(k))/(pcrit(k-1)-pcrit(k)) +! endif +! endif +! enddo +! do i = 1, im +! if(cnvflg(i)) then +! if(islimsk(i) == 1) then +! w1 = w1l +! w2 = w2l +! w3 = w3l +! w4 = w4l +! else +! w1 = w1s +! w2 = w2s +! w3 = w3s +! w4 = w4s +! endif c c modify critical cloud workfunction by cloud base vertical velocity c - if(pdot(i) <= w4) then - acrtfct(i) = (pdot(i) - w4) / (w3 - w4) - elseif(pdot(i) >= -w4) then - acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) - else - acrtfct(i) = 0. - endif - val1 = -1. - acrtfct(i) = max(acrtfct(i),val1) - val2 = 1. - acrtfct(i) = min(acrtfct(i),val2) - acrtfct(i) = 1. - acrtfct(i) +! if(pdot(i) <= w4) then +! acrtfct(i) = (pdot(i) - w4) / (w3 - w4) +! elseif(pdot(i) >= -w4) then +! acrtfct(i) = - (pdot(i) + w4) / (w4 - w3) +! else +! acrtfct(i) = 0. +! endif +! val1 = -1. +! acrtfct(i) = max(acrtfct(i),val1) +! val2 = 1. +! acrtfct(i) = min(acrtfct(i),val2) +! acrtfct(i) = 1. - acrtfct(i) c -c modify acrtfct(i) by colume mean rh if nhbar(i) is greater than 80 percent - - if(rhbar(i) >= .8) then - acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. - endif +c modify acrtfct(i) by colume mean rh if rhbar(i) is greater than 80 percent +c +c if(rhbar(i) >= .8) then +c acrtfct(i) = acrtfct(i) * (.9 - min(rhbar(i),.9)) * 10. +c endif c c modify adjustment time scale by cloud base vertical velocity c @@ -2380,8 +2380,8 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & ! dtconv(i) = max(dtconv(i),dtmin) ! dtconv(i) = min(dtconv(i),dtmax) c - endif - enddo +! endif +! enddo ! ! compute convective turn-over time ! From c148234daf6814c824da55f61e13bb6f64f7241d Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 2 Feb 2021 20:03:29 +0000 Subject: [PATCH 190/274] add ca_global to radiation tendency logic --- physics/GFS_stochastics.F90 | 4 +++- physics/dcyc2.f | 7 ++++--- physics/dcyc2.meta | 8 ++++++++ 3 files changed, 15 insertions(+), 4 deletions(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index a3b4f30cf..759bb20fe 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -219,7 +219,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:) snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:) endif -!zero out radiative heating tendency for next physics step + !zero out radiative heating tendency for next physics step dtdtnp(:,:)=0.0 endif @@ -290,6 +290,8 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc rain_cpl(:) = rain_cpl(:) + (ca(:,15) - 1.0)*drain_cpl(:) snow_cpl(:) = snow_cpl(:) + (ca(:,15) - 1.0)*dsnow_cpl(:) endif + !zero out radiative heating tendency for next physics step + dtdtnp(:,:)=0.0 endif diff --git a/physics/dcyc2.f b/physics/dcyc2.f index c8ef077f8..c00234ca2 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -180,7 +180,7 @@ subroutine dcyc2t3_run & & im, levs, deltim, fhswr, & & dry, icy, wet, & & use_LW_jacobian, sfculw, sfculw_jac, & - & pert_radtend, do_sppt, & + & pert_radtend, do_sppt,ca_global, & ! & dry, icy, wet, lprnt, ipr, & ! --- input/output: & dtdt,dtdtnp, & @@ -212,7 +212,8 @@ subroutine dcyc2t3_run & ! integer, intent(in) :: ipr ! logical lprnt logical, dimension(im), intent(in) :: dry, icy, wet - logical, intent(in) :: use_LW_jacobian, pert_radtend,do_sppt + logical, intent(in) :: use_LW_jacobian, pert_radtend + logical, intent(in) :: do_sppt,ca_global real(kind=kind_phys), intent(in) :: solhr, slag, cdec, sdec, & & deltim, fhswr @@ -360,7 +361,7 @@ subroutine dcyc2t3_run & dtdt(i,k) = dtdt(i,k) + swh(i,k)*xmu(i) + hlw(i,k) enddo enddo - if (do_sppt) then + if (do_sppt .or. ca_global) then if (pert_radtend) then ! clear sky do k = 1, levs diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index aa6d2c35a..e4a22477d 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -378,6 +378,14 @@ type = logical intent = in optional = F +[ca_global] + standard_name = flag_for_global_cellular_automata + long_name = switch for global ca + units = flag + dimensions = () + type = logical + intent = in + optional = F [dtdtnp] standard_name = tendency_of_air_temperature_to_withold_from_sppt long_name = temp. change from physics that should not be perturbed by sppt From f304650eb492c18ad8879476ec42a685b66b429d Mon Sep 17 00:00:00 2001 From: pjpegion Date: Tue, 2 Feb 2021 20:07:21 +0000 Subject: [PATCH 191/274] add MP perturbations to ca_global section --- physics/GFS_stochastics.F90 | 46 +++++++++++++++++++++++++++++++++++-- 1 file changed, 44 insertions(+), 2 deletions(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 759bb20fe..ab05afe5f 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -215,10 +215,10 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc totprcpb(:) = totprcpb(:) + (sppt_wts(:,15) - 1 )*rain(:) cnvprcpb(:) = cnvprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:) - if (cplflx) then + if (cplflx) then rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:) snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:) - endif + endif !zero out radiative heating tendency for next physics step dtdtnp(:,:)=0.0 @@ -274,6 +274,48 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc gq0_wv(i,k) = qnew gt0(i,k) = tgrs(i,k) + tpert + (delt*dtdtnp(i,k)) endif + if (pert_mp) then + if (ntcw>0) then + qpert = (gq0_cw(i,k) - qgrs_cw(i,k)) * ca(i,k) + qnew = qgrs_cw(i,k)+qpert + gq0_cw(i,k) = qnew + if (qnew < 0.0) then + gq0_cw(i,k) = 0.0 + endif + endif + if (ntrw>0) then + qpert = (gq0_rw(i,k) - qgrs_rw(i,k)) * ca(i,k) + qnew = qgrs_rw(i,k)+qpert + gq0_rw(i,k) = qnew + if (qnew < 0.0) then + gq0_rw(i,k) = 0.0 + endif + endif + if (ntsw>0) then + qpert = (gq0_sw(i,k) - qgrs_sw(i,k)) * ca(i,k) + qnew = qgrs_sw(i,k)+qpert + gq0_sw(i,k) = qnew + if (qnew < 0.0) then + gq0_sw(i,k) = 0.0 + endif + endif + if (ntiw>0) then + qpert = (gq0_iw(i,k) - qgrs_iw(i,k)) * ca(i,k) + qnew = qgrs_iw(i,k)+qpert + gq0_iw(i,k) = qnew + if (qnew < 0.0) then + gq0_iw(i,k) = 0.0 + endif + endif + if (ntgl>0) then + qpert = (gq0_gl(i,k) - qgrs_gl(i,k)) * ca(i,k) + qnew = qgrs_gl(i,k)+qpert + gq0_gl(i,k) = qnew + if (qnew < 0.0) then + gq0_gl(i,k) = 0.0 + endif + endif + endif enddo enddo From 28a7793c5408bf2a8797f5809f2d34606207d035 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 3 Feb 2021 08:51:39 -0700 Subject: [PATCH 192/274] Fix uninitialized variables in physics/cires_ugwpv1_solv2.F90 --- physics/cires_ugwpv1_solv2.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/cires_ugwpv1_solv2.F90 index f282635e6..ee8f7bc83 100644 --- a/physics/cires_ugwpv1_solv2.F90 +++ b/physics/cires_ugwpv1_solv2.F90 @@ -840,7 +840,7 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & dktur(levs) = .5*( dked(jl,levs)+ dked(jl,levs-1)) dktur(levs+1) = dktur(levs) - do jk=ksrc,levs + do jk=ksrc,levs+1 ze1 = .5*( dktur(jk) +dktur(jk-1) ) kvint(jk) = ze1 ktint(jk) = ze1*iPr_ktgw @@ -909,14 +909,14 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! if (knob_ugwp_dokdis == 2) then - do jk=km1,levs - ze1 = min(.5*(dktur(jk) +dktur(jk-1)), dturb_max) - kvint(jk) = kvint(jk) + ze1 -! ktint(jk) = ktint(jk) + ze1*iPr_ktgw - enddo + do jk=ksrc,levs + ze1 = min(.5*(dktur(jk) +dktur(jk-1)), dturb_max) + kvint(jk) = kvint(jk) + ze1 +! ktint(jk) = ktint(jk) + ze1*iPr_ktgw + enddo + kvint(km1) = kvint(ksrc) + kvint(ktop) = kvint(levs) - kvint(ktop) = kvint(levs) - dzmetm = 1./dz_met(km1) Adif(km1:levs) = 0. Cdif(km1:levs) = 0. From df8a9230c6fda0d898b9af9497f0782a958f31af Mon Sep 17 00:00:00 2001 From: "Shan.Sun" Date: Thu, 4 Feb 2021 04:28:14 +0000 Subject: [PATCH 193/274] A bug fix. "flag_cice" used to be a proxy for "not 1st time step cold start" in NEMS, but is no longer the case in CMEPS. It is now replaced by "kdt>1". This will change results in all coupled models. Co-authored-by: ben.green@noaa.gov --- physics/GFS_PBL_generic.F90 | 6 +++--- physics/GFS_PBL_generic.meta | 12 ++++++------ 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 357309b2a..026e91416 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -316,7 +316,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & - dq3dt_ozone, rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, flag_cice, dusfc_cice, dvsfc_cice, & + dq3dt_ozone, rd, cp, fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, kdt, dusfc_cice, dvsfc_cice, & dtsfc_cice, dqsfc_cice, wet, dry, icy, wind, stress_wat, hflx_wat, evap_wat, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, & ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg) @@ -333,7 +333,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, integer, intent(in) :: imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires logical, intent(in) :: ltaerosol, cplflx, cplchm, lssav, ldiag3d, qdiag3d, lsidea logical, intent(in) :: hybedmf, do_shoc, satmedmf, shinhong, do_ysu - logical, dimension(:), intent(in) :: flag_cice + integer, intent(in) :: kdt logical, intent(in) :: flag_for_pbl_generic_tend real(kind=kind_phys), dimension(im, levs), intent(in) :: save_u, save_v, save_t @@ -549,7 +549,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, do i=1,im if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES if ( .not. wet(i)) then ! no open water - if (flag_cice(i)) then !use results from CICE + if ( kdt > 1 ) then !use results from CICE dusfci_cpl(i) = dusfc_cice(i) dvsfci_cpl(i) = dvsfc_cice(i) dtsfci_cpl(i) = dtsfc_cice(i) diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 5e83b8ad4..87b3f33b8 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -1194,12 +1194,12 @@ kind = kind_phys intent = in optional = F -[flag_cice] - standard_name = flag_for_cice - long_name = flag for cice - units = flag - dimensions = (horizontal_loop_extent) - type = logical +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer intent = in optional = F [dusfc_cice] From 7cf1a0aa9d980316964eab2ea57f5887f7a09446 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 4 Feb 2021 10:37:34 -0700 Subject: [PATCH 194/274] Add calls to initialize LSM lookup tables to GFS_phys_time_vary.fv3.{F90,meta} --- physics/GFS_phys_time_vary.fv3.F90 | 86 ++++++++++++++--------- physics/GFS_phys_time_vary.fv3.meta | 105 +++++++++++++++++++++++++++- 2 files changed, 157 insertions(+), 34 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 8f0bc50d9..84c284540 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -29,10 +29,9 @@ module GFS_phys_time_vary use gcycle_mod, only : gcycle -#if 0 !--- variables needed for calculating 'sncovr' use namelist_soilveg, only: salp_data, snupx -#endif + use set_soilveg_mod, only: set_soilveg implicit none @@ -42,9 +41,12 @@ module GFS_phys_time_vary logical :: is_initialized = .false. - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + real(kind=kind_phys), parameter :: drythresh = 1.e-4_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys contains @@ -58,7 +60,8 @@ subroutine GFS_phys_time_vary_init ( jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & - nthrds, errmsg, errflg) + isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_ruc, min_seaice, fice, landfrac, & + vtype, weasd, nthrds, errmsg, errflg) implicit none @@ -78,12 +81,19 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) + integer, intent(in) :: isot, ivegsrc, nlunit + real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) + integer, intent(in) :: lsm, lsm_ruc + real(kind_phys), intent(in) :: min_seaice, fice(:) + real(kind_phys), intent(in) :: landfrac(:), vtype(:), weasd(:) + integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i, j, ix + integer :: i, j, ix, vegtyp + real(kind_phys) :: rsnow ! Initialize CCPP error handling variables errmsg = '' @@ -100,7 +110,9 @@ subroutine GFS_phys_time_vary_init ( !$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & !$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & !$OMP shared (jindx1_ci,jindx2_ci,ddy_ci,iindx1_ci,iindx2_ci,ddx_ci) & -!$OMP private (ix,i,j) +!$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) & +!$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) & +!$OMP private (ix,i,j,rsnow,vegtyp) !$OMP sections @@ -177,6 +189,10 @@ subroutine GFS_phys_time_vary_init ( ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif +!$OMP section +!> - Initialize soil vegetation (needed for sncovr calculation further down) + call set_soilveg(me, isot, ivegsrc, nlunit) + !$OMP end sections ! Need an OpenMP barrier here (implicit in "end sections") @@ -223,35 +239,39 @@ subroutine GFS_phys_time_vary_init ( enddo enddo +!$OMP section + !--- if sncovr does not exist in the restart, need to create it + if (all(sncovr < zero)) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' + !--- compute sncovr from existing variables + !--- code taken directly from read_fix.f + sncovr(:) = zero + do ix=1,im + if (landfrac(ix) >= drythresh .or. fice(ix) >= min_seaice) then + vegtyp = vtype(ix) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001_kind_phys*weasd(ix)/snupx(vegtyp) + if (0.001_kind_phys*weasd(ix) < snupx(vegtyp)) then + sncovr(ix) = one - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + sncovr(ix) = one + endif + endif + enddo + endif + + !--- For RUC LSM: create sncovr_ice from sncovr + if (lsm == lsm_ruc) then + if (all(sncovr_ice < zero)) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: fill sncovr_ice with sncovr for RUC LSM' + sncovr_ice(:) = sncovr(:) + endif + endif + !$OMP end sections !$OMP end parallel -#if 0 - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - if (first_time_step) then - if (nint(Data(1)%Sfcprop%sncovr(1)) == -9999) then - !--- compute sncovr from existing variables - !--- code taken directly from read_fix.f - do nb = 1, nblks - do ix = 1, Model%blksz(nb) - Data(nb)%Sfcprop%sncovr(ix) = 0.0 - if (Data(nb)%Sfcprop%slmsk(ix) > 0.001) then - vegtyp = Data(nb)%Sfcprop%vtype(ix) - if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Data(nb)%Sfcprop%weasd(ix)/snupx(vegtyp) - if (0.001*Data(nb)%Sfcprop%weasd(ix) < snupx(vegtyp)) then - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - else - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - endif - endif - enddo - enddo - endif - endif -#endif - is_initialized = .true. end subroutine GFS_phys_time_vary_init diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 7ae6b4948..4a625f6c0 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F + dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F ######################################################################## [ccpp-arg-table] @@ -307,6 +307,64 @@ type = integer intent = inout optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [nthrds] standard_name = omp_threads long_name = number of OpenMP threads available for physics schemes @@ -315,6 +373,51 @@ type = integer intent = in optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 7d45f106c3caf2898d8f37cd462aabe95dbf435b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 9 Feb 2021 14:09:42 -0700 Subject: [PATCH 195/274] Update and cleanup of UGWPv0, UGWpv1 and drag suite standard names --- physics/GFS_debug.F90 | 38 +++++++---- physics/GFS_phys_time_vary.fv3.meta | 60 ++++++++--------- physics/cires_ugwp.meta | 12 ++-- physics/cires_ugwp_post.meta | 10 +-- physics/drag_suite.meta | 54 ++++++++-------- physics/ugwpv1_gsldrag.F90 | 8 +-- physics/ugwpv1_gsldrag.meta | 93 ++++++++++++--------------- physics/ugwpv1_gsldrag_post.meta | 18 +++--- physics/unified_ugwp.F90 | 20 +++--- physics/unified_ugwp.meta | 99 +++++++++++++---------------- physics/unified_ugwp_post.meta | 10 +-- 11 files changed, 208 insertions(+), 214 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 19bb2903c..8f072cae6 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -1262,31 +1262,24 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_osscol ', Interstitial%dv_osscol ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ofdcol ', Interstitial%du_ofdcol ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ofdcol ', Interstitial%dv_ofdcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zobl ', Interstitial%zobl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zngw ', Interstitial%zngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dudt ', Interstitial%gw_dudt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dvdt ', Interstitial%gw_dvdt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dtdt ', Interstitial%gw_dtdt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_kdis ', Interstitial%gw_kdis ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) end if ! CIRES UGWP v0 if (Model%do_ugwp_v0 .or. Model%do_gsl_drag_ls_bl .or. Model%do_gsl_drag_ss .or. Model%do_gsl_drag_tofd) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dudt ', Interstitial%gw_dudt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dvdt ', Interstitial%gw_dvdt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_dtdt ', Interstitial%gw_dtdt ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%gw_kdis ', Interstitial%gw_kdis ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_gw ', Interstitial%dudt_gw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_gw ', Interstitial%dvdt_gw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdt_gw ', Interstitial%dtdt_gw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kdis_gw ', Interstitial%kdis_gw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) @@ -1299,12 +1292,31 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) end if !-- GSD drag suite - if (Model%gwd_opt==3 .or. Model%gwd_opt==33) then + if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & + Model%gwd_opt==2 .or. Model%gwd_opt==22) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%varss ', Interstitial%varss ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ocss ', Interstitial%ocss ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%oa4ss ', Interstitial%oa4ss ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%clxss ', Interstitial%clxss ) end if + if (Model%gwd_opt==33 .or. Model%gwd_opt==22) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ogw ', Interstitial%dvdt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ogwcol ', Interstitial%du_ogwcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ogwcol ', Interstitial%dv_ogwcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_obl ', Interstitial%dudt_obl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_obl ', Interstitial%dvdt_obl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_oblcol ', Interstitial%du_oblcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_oblcol ', Interstitial%dv_oblcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_oss ', Interstitial%dudt_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_oss ', Interstitial%dvdt_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_osscol ', Interstitial%du_osscol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_osscol ', Interstitial%dv_osscol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ofd ', Interstitial%dudt_ofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ogw ', Interstitial%dvdt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ofdcol ', Interstitial%du_ofdcol ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ofdcol ', Interstitial%dv_ofdcol ) + end if ! GFDL and Thompson MP if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%graupelmp ', Interstitial%graupelmp ) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index e20920686..887037924 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -316,7 +316,7 @@ intent = in optional = F [do_ugwp_v1] - standard_name = do_ugwp_v1 + standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP units = flag dimensions = () @@ -324,39 +324,39 @@ intent = in optional = F [jindx1_tau] - standard_name = index_interp_weight1_taungw - long_name = index1 for weight1 for tau NGWs + standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index1 for weight1 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = integer intent = inout - optional = F + optional = F [jindx2_tau] - standard_name = index_interp_weight2_taungw - long_name = index2 for weight2 for tau NGWs + standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index2 for weight2 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = integer intent = inout - optional = F + optional = F [ddy_j1tau] - standard_name = interp_weight1_taungw - long_name = interpolation weight1 for tau NGWs + standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight1 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = real - intent = inout + intent = inout kind = kind_phys - optional = F + optional = F [ddy_j2tau] - standard_name = interp_weight2_taungw - long_name = interpolation weight2 for tau NGWs + standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight2 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = real intent = inout kind = kind_phys - optional = F + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -492,7 +492,7 @@ [nsswr] standard_name = number_of_timesteps_between_shortwave_radiation_calls long_name = number of timesteps between shortwave radiation calls - units = + units = dimensions = () type = integer intent = in @@ -1378,7 +1378,7 @@ intent = inout optional = F [do_ugwp_v1] - standard_name = do_ugwp_v1 + standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP units = flag dimensions = () @@ -1386,33 +1386,33 @@ intent = in optional = F [jindx1_tau] - standard_name = index_interp_weight1_taungw - long_name = index1 for weight1 for tau NGWs + standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index1 for weight1 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = integer intent = in - optional = F + optional = F [jindx2_tau] - standard_name = index_interp_weight2_taungw - long_name = index2 for weight2 for tau NGWs + standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index2 for weight2 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = integer intent = in - optional = F + optional = F [ddy_j1tau] - standard_name = interp_weight1_taungw - long_name = interpolation weight1 for tau NGWs + standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight1 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = real - intent = in + intent = in kind = kind_phys - optional = F + optional = F [ddy_j2tau] - standard_name = interp_weight2_taungw - long_name = interpolation weight2 for tau NGWs + standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight2 for tau NGWs units = none dimensions = (horizontal_loop_extent) type = real @@ -1420,14 +1420,14 @@ kind = kind_phys optional = F [tau_amf] - standard_name = ngw_abs_momentum_flux + standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux units = various dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout - optional = F + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 887280612..e2afbf70f 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -565,7 +565,7 @@ intent = out optional = F [gw_dudt] - standard_name = tendency_of_x_wind_due_to_ugwp + standard_name = tendency_of_x_wind_due_to_gravity_wave_drag long_name = zonal wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -574,7 +574,7 @@ intent = out optional = F [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_ugwp + standard_name = tendency_of_y_wind_due_to_gravity_wave_drag long_name = meridional wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -583,7 +583,7 @@ intent = out optional = F [gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_ugwp + standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag long_name = air temperature tendency due to UGWP units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -592,7 +592,7 @@ intent = out optional = F [gw_kdis] - standard_name = eddy_mixing_due_to_ugwp + standard_name = atmosphere_momentum_diffusivity_due_to_gravity_wave_drag long_name = eddy mixing due to UGWP units = m2 s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -673,7 +673,7 @@ intent = out optional = F [dudt_ogw] - standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -682,7 +682,7 @@ intent = out optional = F [dudt_tms] - standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) diff --git a/physics/cires_ugwp_post.meta b/physics/cires_ugwp_post.meta index 80b8ce1ca..c8618e1c8 100644 --- a/physics/cires_ugwp_post.meta +++ b/physics/cires_ugwp_post.meta @@ -41,7 +41,7 @@ intent = in optional = F [gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_ugwp + standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag long_name = air temperature tendency due to UGWP units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -50,7 +50,7 @@ intent = in optional = F [gw_dudt] - standard_name = tendency_of_x_wind_due_to_ugwp + standard_name = tendency_of_x_wind_due_to_gravity_wave_drag long_name = zonal wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -59,7 +59,7 @@ intent = in optional = F [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_ugwp + standard_name = tendency_of_y_wind_due_to_gravity_wave_drag long_name = meridional wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -140,7 +140,7 @@ intent = in optional = F [dudt_ogw] - standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -149,7 +149,7 @@ intent = in optional = F [dudt_tms] - standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index fa5b317fc..3035a2c95 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -274,7 +274,7 @@ intent = inout optional = F [dtaux2d_ls] - standard_name = x_momentum_tendency_from_large_scale_gwd + standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = x momentum tendency from large scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -283,7 +283,7 @@ intent = out optional = F [dtauy2d_ls] - standard_name = y_momentum_tendency_from_large_scale_gwd + standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y momentum tendency from large scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -292,7 +292,7 @@ intent = out optional = F [dtaux2d_bl] - standard_name = x_momentum_tendency_from_blocking_drag + standard_name = tendency_of_x_momentum_due_to_blocking_drag long_name = x momentum tendency from blocking drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -301,7 +301,7 @@ intent = out optional = F [dtauy2d_bl] - standard_name = y_momentum_tendency_from_blocking_drag + standard_name = tendency_of_y_momentum_due_to_blocking_drag long_name = y momentum tendency from blocking drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -310,7 +310,7 @@ intent = out optional = F [dtaux2d_ss] - standard_name = x_momentum_tendency_from_small_scale_gwd + standard_name = tendency_of_x_momentum_due_to_small_scale_gravity_wave_drag long_name = x momentum tendency from small scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -319,7 +319,7 @@ intent = out optional = F [dtauy2d_ss] - standard_name = y_momentum_tendency_from_small_scale_gwd + standard_name = tendency_of_y_momentum_due_to_small_scale_gravity_wave_drag long_name = y momentum tendency from small scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -328,7 +328,7 @@ intent = out optional = F [dtaux2d_fd] - standard_name = x_momentum_tendency_from_form_drag + standard_name = tendency_of_x_momentum_due_to_form_drag long_name = x momentum tendency from form drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -337,7 +337,7 @@ intent = out optional = F [dtauy2d_fd] - standard_name = y_momentum_tendency_from_form_drag + standard_name = tendency_of_y_momentum_due_to_form_drag long_name = y momentum tendency from form drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -364,72 +364,72 @@ intent = out optional = F [dusfc_ls] - standard_name = integrated_x_momentum_flux_from_large_scale_gwd + standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from large scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_ls] - standard_name = integrated_y_momentum_flux_from_large_scale_gwd + standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from large scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dusfc_bl] - standard_name = integrated_x_momentum_flux_from_blocking_drag + standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_bl] - standard_name = integrated_y_momentum_flux_from_blocking_drag + standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dusfc_ss] - standard_name = integrated_x_momentum_flux_from_small_scale_gwd + standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_ss] - standard_name = integrated_y_momentum_flux_from_small_scale_gwd + standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dusfc_fd] - standard_name = integrated_x_momentum_flux_from_form_drag + standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_fd] - standard_name = integrated_y_momentum_flux_from_form_drag + standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -592,7 +592,7 @@ intent = in optional = F [do_gsl_drag_ls_bl] - standard_name = do_gsl_drag_ls_bl + standard_name = flag_for_gsl_drag_suite_large_scale_orographic_and_blocking_drag long_name = flag to activate GSL drag suite - large-scale GWD and blocking units = flag dimensions = () @@ -600,7 +600,7 @@ intent = in optional = F [do_gsl_drag_ss] - standard_name = do_gsl_drag_ss + standard_name = flag_for_gsl_drag_suite_small_scale_orographic_drag long_name = flag to activate GSL drag suite - small-scale GWD units = flag dimensions = () @@ -608,7 +608,7 @@ intent = in optional = F [do_gsl_drag_tofd] - standard_name = do_gsl_drag_tofd + standard_name = flag_for_gsl_drag_suite_turbulent_orographic_form_drag long_name = flag to activate GSL drag suite - turb orog form drag units = flag dimensions = () diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 4439845ad..28a4110fc 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -312,7 +312,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd varss,oc1ss,oa4ss,ol4ss, dx, xlat, xlat_d, sinlat, coslat, area, & rain, br1, hpbl, kpbl, slmsk, & ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, del, tau_amf, & - dudt_ogw, dvdt_ogw, dtdt_sso, du_ogwcol, dv_ogwcol, & + dudt_ogw, dvdt_ogw, du_ogwcol, dv_ogwcol, & dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, & dudt_oss, dvdt_oss, du_osscol, dv_osscol, & dudt_ofd, dvdt_ofd, du_ofdcol, dv_ofdcol, & @@ -408,7 +408,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_osscol, dv_osscol, du_ofdcol, dv_ofdcol ! -! we may add later but due to launch in the upper layes ~ mPa comparing to ORO Pa*(0.1) +! we may add later but due to launch in the upper layes ~ mPa comparing to ORO Pa*(0.1) ! du_ngwcol, dv_ngwcol real(kind=kind_phys), intent(out), dimension(im) :: dusfcg, dvsfcg @@ -419,9 +419,9 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd real(kind=kind_phys), intent(out) , dimension(im, levs) :: dudt_ngw, dvdt_ngw, kdis_ngw - real(kind=kind_phys), intent(out) , dimension(im, levs) :: dudt_gw, dvdt_gw, kdis_gw + real(kind=kind_phys), intent(out) , dimension(im, levs) :: dudt_gw, dvdt_gw, kdis_gw - real(kind=kind_phys), intent(out) , dimension(im, levs) :: dtdt_sso, dtdt_ngw, dtdt_gw + real(kind=kind_phys), intent(out) , dimension(im, levs) :: dtdt_ngw, dtdt_gw real(kind=kind_phys), intent(out) , dimension(im) :: zogw, zlwb, zobl, zngw ! diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta index 1cfec2104..2eac9a321 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -207,7 +207,7 @@ intent = in optional = F [do_ugwp_v0] - standard_name = do_ugwp_v0 + standard_name = flag_for_ugwp_version_0 long_name = flag to activate ver 0 CIRES UGWP units = flag dimensions = () @@ -215,7 +215,7 @@ intent = in optional = F [do_ugwp_v0_orog_only] - standard_name = do_ugwp_v0_orog_only + standard_name = flag_for_ugwp_version_0_orographic_gwd long_name = flag to activate ver 0 CIRES UGWP - orographic GWD only units = flag dimensions = () @@ -223,7 +223,7 @@ intent = in optional = F [do_gsl_drag_ls_bl] - standard_name = do_gsl_drag_ls_bl + standard_name = flag_for_gsl_drag_suite_large_scale_orographic_and_blocking_drag long_name = flag to activate GSL drag suite - large-scale GWD and blocking units = flag dimensions = () @@ -231,7 +231,7 @@ intent = in optional = F [do_gsl_drag_ss] - standard_name = do_gsl_drag_ss + standard_name = flag_for_gsl_drag_suite_small_scale_orographic_drag long_name = flag to activate GSL drag suite - small-scale GWD units = flag dimensions = () @@ -239,7 +239,7 @@ intent = in optional = F [do_gsl_drag_tofd] - standard_name = do_gsl_drag_tofd + standard_name = flag_for_gsl_drag_suite_turbulent_orographic_form_drag long_name = flag to activate GSL drag suite - turb orog form drag units = flag dimensions = () @@ -247,7 +247,7 @@ intent = in optional = F [do_ugwp_v1] - standard_name = do_ugwp_v1 + standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP units = flag dimensions = () @@ -255,7 +255,7 @@ intent = in optional = F [do_ugwp_v1_orog_only] - standard_name = do_ugwp_v1_orog_only + standard_name = flag_for_ugwp_version_1_orographic_gwd long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only units = flag dimensions = () @@ -263,7 +263,7 @@ intent = in optional = F [do_ugwp_v1_w_gsldrag] - standard_name = do_ugwp_v1_w_gsldrag + standard_name = flag_for_ugwp_version_1_nonorographic_gwd long_name = flag to activate ver 1 CIRES UGWP - with OGWD of GSL units = flag dimensions = () @@ -413,7 +413,7 @@ intent = in optional = F [do_gsl_drag_ls_bl] - standard_name = do_gsl_drag_ls_bl + standard_name = flag_for_gsl_drag_suite_large_scale_orographic_and_blocking_drag long_name = flag to activate GSL drag suite - large-scale GWD and blocking units = flag dimensions = () @@ -421,7 +421,7 @@ intent = in optional = F [do_gsl_drag_ss] - standard_name = do_gsl_drag_ss + standard_name = flag_for_gsl_drag_suite_small_scale_orographic_drag long_name = flag to activate GSL drag suite - small-scale GWD units = flag dimensions = () @@ -429,7 +429,7 @@ intent = in optional = F [do_gsl_drag_tofd] - standard_name = do_gsl_drag_tofd + standard_name = flag_for_gsl_drag_suite_turbulent_orographic_form_drag long_name = flag to activate GSL drag suite - turb orog form drag units = flag dimensions = () @@ -437,7 +437,7 @@ intent = in optional = F [do_ugwp_v1] - standard_name = do_ugwp_v1 + standard_name = flag_for_ugwp_version_1 long_name = flag to activate ver 1 CIRES UGWP units = flag dimensions = () @@ -445,7 +445,7 @@ intent = in optional = F [do_ugwp_v1_orog_only] - standard_name = do_ugwp_v1_orog_only + standard_name = flag_for_ugwp_version_1_orographic_gwd long_name = flag to activate ver 1 CIRES UGWP - orographic GWD only units = flag dimensions = () @@ -453,7 +453,7 @@ intent = in optional = F [do_ugwp_v1_w_gsldrag] - standard_name = do_ugwp_v1_w_gsldrag + standard_name = flag_for_ugwp_version_1_nonorographic_gwd long_name = flag to activate ver 1 CIRES UGWP - with OGWD of GSL units = flag dimensions = () @@ -806,7 +806,7 @@ intent = in optional = F [tau_amf] - standard_name = ngw_abs_momentum_flux + standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux units = various dimensions = (horizontal_loop_extent) @@ -815,7 +815,7 @@ intent = in optional = F [dudt_ogw] - standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = x momentum tendency from meso scale ogw units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -824,7 +824,7 @@ intent = out optional = F [dvdt_ogw] - standard_name = y_momentum_tendency_from_meso_scale_ogw + standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = y momentum tendency from meso scale ogw units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -832,17 +832,8 @@ kind = kind_phys intent = out optional = F -[dtdt_sso] - standard_name = tendency_of_air_temperature_due_to_sso - long_name = air temperature tendency due to subgrid-scale orography - units = K s-1 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F [du_ogwcol] - standard_name = integrated_x_momentum_flux_from_meso_scale_ogw + standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from meso scale ogw units = Pa dimensions = (horizontal_loop_extent) @@ -851,7 +842,7 @@ intent = out optional = F [dv_ogwcol] - standard_name = integrated_y_momentum_flux_from_meso_scale_ogw + standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from meso scale ogw units = Pa dimensions = (horizontal_loop_extent) @@ -860,7 +851,7 @@ intent = out optional = F [dudt_obl] - standard_name = x_momentum_tendency_from_blocking_drag_vy + standard_name = tendency_of_x_momentum_due_to_blocking_drag long_name = x momentum tendency from blocking drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -869,7 +860,7 @@ intent = out optional = F [dvdt_obl] - standard_name = y_momentum_tendency_from_blocking_drag_vy + standard_name = tendency_of_y_momentum_due_to_blocking_drag long_name = y momentum tendency from blocking drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -878,7 +869,7 @@ intent = out optional = F [du_oblcol] - standard_name = integrated_x_momentum_flux_from_blocking_drag_vy + standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag units = Pa dimensions = (horizontal_loop_extent) @@ -887,7 +878,7 @@ intent = out optional = F [dv_oblcol] - standard_name = integrated_y_momentum_flux_from_blocking_drag_vy + standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag units = Pa dimensions = (horizontal_loop_extent) @@ -896,7 +887,7 @@ intent = out optional = F [dudt_oss] - standard_name = x_momentum_tendency_from_small_scale_gwd_vy + standard_name = tendency_of_x_momentum_due_to_small_scale_gravity_wave_drag long_name = x momentum tendency from small scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -905,7 +896,7 @@ intent = out optional = F [dvdt_oss] - standard_name = y_momentum_tendency_from_small_scale_gwd_vy + standard_name = tendency_of_y_momentum_due_to_small_scale_gravity_wave_drag long_name = y momentum tendency from small scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -914,7 +905,7 @@ intent = out optional = F [du_osscol] - standard_name = integrated_x_momentum_flux_from_small_scale_gwd_vy + standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd units = Pa dimensions = (horizontal_loop_extent) @@ -923,7 +914,7 @@ intent = out optional = F [dv_osscol] - standard_name = integrated_y_momentum_flux_from_small_scale_gwd_vy + standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd units = Pa dimensions = (horizontal_loop_extent) @@ -932,7 +923,7 @@ intent = out optional = F [dudt_ofd] - standard_name = x_momentum_tendency_from_form_drag_vy + standard_name = tendency_of_x_momentum_due_to_form_drag long_name = x momentum tendency from form drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -941,7 +932,7 @@ intent = out optional = F [dvdt_ofd] - standard_name = y_momentum_tendency_from_form_drag_vy + standard_name = tendency_of_y_momentum_due_to_form_drag long_name = y momentum tendency from form drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -950,7 +941,7 @@ intent = out optional = F [du_ofdcol] - standard_name = integrated_x_momentum_flux_from_form_drag_vy + standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag units = Pa dimensions = (horizontal_loop_extent) @@ -959,7 +950,7 @@ intent = out optional = F [dv_ofdcol] - standard_name = integrated_y_momentum_flux_from_form_drag_vy + standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag units = Pa dimensions = (horizontal_loop_extent) @@ -968,7 +959,7 @@ intent = out optional = F [dudt_ngw] - standard_name = tendency_of_x_wind_due_to_ngw + standard_name = tendency_of_x_wind_due_to_nonorographic_gravity_wave_drag long_name = zonal wind tendency due to non-stationary GWs units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -977,7 +968,7 @@ intent = out optional = F [dvdt_ngw] - standard_name = tendency_of_y_wind_due_to_ngw + standard_name = tendency_of_y_wind_due_to_nonorographic_gravity_wave_drag long_name = meridional wind tendency due to non-stationary GWs units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -986,7 +977,7 @@ intent = out optional = F [dtdt_ngw] - standard_name = tendency_of_air_temperature_due_to_ngw + standard_name = tendency_of_air_temperature_due_to_nonorographic_gravity_wave_drag long_name = air temperature tendency due to non-stationary GWs units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -995,7 +986,7 @@ intent = out optional = F [kdis_ngw] - standard_name = eddy_mixing_due_to_ngw + standard_name = atmosphere_momentum_diffusivity_due_to_nonorographic_gravity_wave_drag long_name = eddy mixing due to non-stationary GWs units = m2 s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -1004,7 +995,7 @@ intent = out optional = F [dudt_gw] - standard_name = tendency_of_x_wind_due_to_allgw + standard_name = tendency_of_x_wind_due_to_gravity_wave_drag long_name = zonal wind tendency due to all GWs units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -1013,7 +1004,7 @@ intent = out optional = F [dvdt_gw] - standard_name = tendency_of_y_wind_due_to_allgw + standard_name = tendency_of_y_wind_due_to_gravity_wave_drag long_name = meridional wind tendency due to all GWs units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -1022,7 +1013,7 @@ intent = out optional = F [dtdt_gw] - standard_name = tendency_of_air_temperature_due_to_allgw + standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag long_name = air temperature tendency due to all GWs units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -1031,7 +1022,7 @@ intent = out optional = F [kdis_gw] - standard_name = eddy_mixing_due_to_allgw + standard_name = atmosphere_momentum_diffusivity_due_to_gravity_wave_drag long_name = eddy mixing due to all GWs units = m2 s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -1058,7 +1049,7 @@ intent = out optional = F [tau_oss] - standard_name = instantaneous_momentum_flux_due_to_sso + standard_name = momentum_flux_due_to_subgrid_scale_orographic_gravity_wave_drag long_name = momentum flux or stress due to SSO including OBL-OSS-OFD units = Pa dimensions = (horizontal_loop_extent) @@ -1085,7 +1076,7 @@ intent = out optional = F [zobl] - standard_name = height_of_mountain_blocking_v1 + standard_name = height_of_mountain_blocking long_name = height of mountain blocking drag_v1 units = m dimensions = (horizontal_loop_extent) @@ -1094,7 +1085,7 @@ intent = out optional = F [zngw] - standard_name = height_of_launch_level_of_nonsta_gravity_wave + standard_name = height_of_launch_level_of_nonorographic_gravity_waves long_name = height of launch level of non-stationary GWs units = m dimensions = (horizontal_loop_extent) diff --git a/physics/ugwpv1_gsldrag_post.meta b/physics/ugwpv1_gsldrag_post.meta index 9ed76d6e8..45fa4ea99 100644 --- a/physics/ugwpv1_gsldrag_post.meta +++ b/physics/ugwpv1_gsldrag_post.meta @@ -46,7 +46,7 @@ intent = in optional = F [dudt_gw] - standard_name = tendency_of_x_wind_due_to_allgw + standard_name = tendency_of_x_wind_due_to_gravity_wave_drag long_name = zonal wind tendency due to all GWs units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -55,7 +55,7 @@ intent = in optional = F [dvdt_gw] - standard_name = tendency_of_y_wind_due_to_allgw + standard_name = tendency_of_y_wind_due_to_gravity_wave_drag long_name = meridional wind tendency due to all GWs units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -64,7 +64,7 @@ intent = in optional = F [dtdt_gw] - standard_name = tendency_of_air_temperature_due_to_allgw + standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag long_name = air temperature tendency due to all GWs units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -73,7 +73,7 @@ intent = in optional = F [du_oblcol] - standard_name = integrated_x_momentum_flux_from_blocking_drag_vy + standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag units = Pa dimensions = (horizontal_loop_extent) @@ -82,7 +82,7 @@ intent = in optional = F [du_ofdcol] - standard_name = integrated_x_momentum_flux_from_form_drag_vy + standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag units = Pa dimensions = (horizontal_loop_extent) @@ -109,7 +109,7 @@ intent = in optional = F [zobl] - standard_name = height_of_mountain_blocking_v1 + standard_name = height_of_mountain_blocking long_name = height of mountain blocking drag_v1 units = m dimensions = (horizontal_loop_extent) @@ -135,7 +135,7 @@ intent = in optional = F [dudt_obl] - standard_name = x_momentum_tendency_from_blocking_drag_vy + standard_name = tendency_of_x_momentum_due_to_blocking_drag long_name = x momentum tendency from blocking drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -144,7 +144,7 @@ intent = in optional = F [dudt_ofd] - standard_name = x_momentum_tendency_from_form_drag_vy + standard_name = tendency_of_x_momentum_due_to_form_drag long_name = x momentum tendency from form drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -153,7 +153,7 @@ intent = in optional = F [dudt_ogw] - standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = x momentum tendency from meso scale ogw units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 0454ed376..7fdc43b2b 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -185,7 +185,7 @@ end subroutine unified_ugwp_finalize !>@brief These subroutines and modules execute the CIRES UGWP Version 0 !>\defgroup unified_ugwp_run Unified Gravity Wave Physics General Algorithm !> @{ -!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and background dissipation is represented by the subroutine \ref fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). +!! The physics of NGWs in the UGWP framework (Yudin et al. 2018 \cite yudin_et_al_2018) is represented by four GW-solvers, which is introduced in Lindzen (1981) \cite lindzen_1981, Hines (1997) \cite hines_1997, Alexander and Dunkerton (1999) \cite alexander_and_dunkerton_1999, and Scinocca (2003) \cite scinocca_2003. The major modification of these GW solvers is represented by the addition of the background dissipation of temperature and winds to the saturation criteria for wave breaking. This feature is important in the mesosphere and thermosphere for WAM applications and it considers appropriate scale-dependent dissipation of waves near the model top lid providing the momentum and energy conservation in the vertical column physics (Shaw and Shepherd 2009 \cite shaw_and_shepherd_2009). In the UGWP-v0, the modification of Scinocca (2003) \cite scinocca_2003 scheme for NGWs with non-hydrostatic and rotational effects for GW propagations and backgroufnd dissipation is represented by the subroutine \ref fv3_ugwp_solv2_v0. In the next release of UGWP, additional GW-solvers will be implemented along with physics-based triggering of waves and stochastic approaches for selection of GW modes characterized by horizontal phase velocities, azimuthal directions and magnitude of the vertical momentum flux (VMF). !! !! In UGWP-v0, the specification for the VMF function is adopted from the GEOS-5 global atmosphere model of GMAO NASA/GSFC, as described in Molod et al. (2015) \cite molod_et_al_2015 and employed in the MERRRA-2 reanalysis (Gelaro et al., 2017 \cite gelaro_et_al_2017). The Fortran subroutine \ref slat_geos5_tamp describes the latitudinal shape of VMF-function as displayed in Figure 3 of Molod et al. (2015) \cite molod_et_al_2015. It shows that the enhanced values of VMF in the equatorial region gives opportunity to simulate the QBO-like oscillations in the equatorial zonal winds and lead to more realistic simulations of the equatorial dynamics in GEOS-5 operational and MERRA-2 reanalysis products. For the first vertically extended version of FV3GFS in the stratosphere and mesosphere, this simplified function of VMF allows us to tune the model climate and to evaluate multi-year simulations of FV3GFS with the MERRA-2 and ERA-5 reanalysis products, along with temperature, ozone, and water vapor observations of current satellite missions. After delivery of the UGWP-code, the EMC group developed and tested approach to modulate the zonal mean NGW forcing by 3D-distributions of the total precipitation as a proxy for the excitation of NGWs by convection and the vertically-integrated (surface - tropopause) Turbulent Kinetic Energy (TKE). The verification scores with updated NGW forcing, as reported elsewhere by EMC researchers, display noticeable improvements in the forecast scores produced by FV3GFS configuration extended into the mesosphere. !! @@ -203,7 +203,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, ugrs, vgrs, tgrs, q1, prsi, prsl, prslk, phii, phil, & del, kpbl, dusfcg, dvsfcg, gw_dudt, gw_dvdt, gw_dtdt, gw_kdis, & tau_tofd, tau_mtb, tau_ogw, tau_ngw, zmtb, zlwb, zogw, & - dudt_mtb,dudt_ogw, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & + dudt_mtb, dudt_tms, du3dt_mtb, du3dt_ogw, du3dt_tms, & dudt, dvdt, dtdt, rdxzb, con_g, con_omega, con_pi, con_cp, con_rd, con_rv, & con_rerth, con_fvirt, rain, ntke, q_tke, dqdt_tke, lprnt, ipr, & ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_cgw, ldv3dt_cgw, ldt3dt_cgw, & @@ -244,7 +244,6 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, & dusfc_ss(:),dvsfc_ss(:), & & dusfc_fd(:),dvsfc_fd(:) real(kind=kind_phys), intent(out) :: & - & dtaux2d_ls(:,:),dtauy2d_ls(:,:), & & dtaux2d_bl(:,:),dtauy2d_bl(:,:), & & dtaux2d_ss(:,:),dtauy2d_ss(:,:), & & dtaux2d_fd(:,:),dtauy2d_fd(:,:) @@ -253,11 +252,12 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, & hpbl(im), & & slmsk(im) - real(kind=kind_phys), intent(out), dimension(im) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(out), dimension(im) :: zmtb, zlwb, zogw, rdxzb - real(kind=kind_phys), intent(out), dimension(im) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw - real(kind=kind_phys), intent(out), dimension(im, levs):: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis - real(kind=kind_phys), intent(out), dimension(im, levs):: dudt_mtb, dudt_ogw, dudt_tms + real(kind=kind_phys), intent(out), dimension(im) :: dusfcg, dvsfcg + real(kind=kind_phys), intent(out), dimension(im) :: zmtb, zlwb, zogw, rdxzb + real(kind=kind_phys), intent(out), dimension(im) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw + real(kind=kind_phys), intent(out), dimension(im, levs) :: gw_dudt, gw_dvdt, gw_dtdt, gw_kdis + real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms + real(kind=kind_phys), intent(out), dimension(:,:) :: dtaux2d_ls, dtauy2d_ls ! These arrays are only allocated if ldiag=.true. real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw @@ -333,10 +333,10 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & errmsg,errflg) ! -! put zeros due to xy GSL-drag style: dtauy2d_ls,dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls +! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls ! tau_mtb = 0. ; tau_ogw = 0. ; tau_tofd = 0. - dudt_mtb = 0. ; dudt_ogw = 0. ; dudt_tms = 0. + dudt_mtb = 0. ; dudt_tms = 0. end if diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index 181ffad92..edb8521e0 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -189,7 +189,7 @@ intent = in optional = F [do_ugwp_v0] - standard_name = do_ugwp_v0 + standard_name = flag_for_ugwp_version_0 long_name = flag to activate ver 0 CIRES UGWP units = flag dimensions = () @@ -197,7 +197,7 @@ intent = in optional = F [do_ugwp_v0_orog_only] - standard_name = do_ugwp_v0_orog_only + standard_name = flag_for_ugwp_version_0_orographic_gwd long_name = flag to activate ver 0 CIRES UGWP - orographic GWD only units = flag dimensions = () @@ -205,7 +205,7 @@ intent = in optional = F [do_ugwp_v0_nst_only] - standard_name = do_ugwp_v0_nst_only + standard_name = flag_for_ugwp_version_0_nonorographic_gwd long_name = flag to activate ver 0 CIRES UGWP - non-stationary GWD only units = flag dimensions = () @@ -213,7 +213,7 @@ intent = in optional = F [do_gsl_drag_ls_bl] - standard_name = do_gsl_drag_ls_bl + standard_name = flag_for_gsl_drag_suite_large_scale_orographic_and_blocking_drag long_name = flag to activate GSL drag suite - large-scale GWD and blocking units = flag dimensions = () @@ -221,7 +221,7 @@ intent = in optional = F [do_gsl_drag_ss] - standard_name = do_gsl_drag_ss + standard_name = flag_for_gsl_drag_suite_small_scale_orographic_drag long_name = flag to activate GSL drag suite - small-scale GWD units = flag dimensions = () @@ -229,7 +229,7 @@ intent = in optional = F [do_gsl_drag_tofd] - standard_name = do_gsl_drag_tofd + standard_name = flag_for_gsl_drag_suite_turbulent_orographic_form_drag long_name = flag to activate GSL drag suite - turb orog form drag units = flag dimensions = () @@ -259,7 +259,7 @@ name = unified_ugwp_finalize type = scheme [do_ugwp_v0] - standard_name = do_ugwp_v0 + standard_name = flag_for_ugwp_version_0 long_name = flag to activate ver 0 CIRES UGWP units = flag dimensions = () @@ -267,7 +267,7 @@ intent = in optional = F [do_ugwp_v0_nst_only] - standard_name = do_ugwp_v0_nst_only + standard_name = flag_for_ugwp_version_0_nonorographic_gwd long_name = flag to activate ver 0 CIRES UGWP - non-stationary GWD only units = flag dimensions = () @@ -512,80 +512,80 @@ intent = in optional = F [dusfc_ls] - standard_name = integrated_x_momentum_flux_from_large_scale_gwd + standard_name = vertically_integrated_x_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated x momentum flux from large scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_ls] - standard_name = integrated_y_momentum_flux_from_large_scale_gwd + standard_name = vertically_integrated_y_momentum_flux_due_to_mesoscale_orographic_gravity_wave_drag long_name = integrated y momentum flux from large scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dusfc_bl] - standard_name = integrated_x_momentum_flux_from_blocking_drag + standard_name = vertically_integrated_x_momentum_flux_due_to_blocking_drag long_name = integrated x momentum flux from blocking drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_bl] - standard_name = integrated_y_momentum_flux_from_blocking_drag + standard_name = vertically_integrated_y_momentum_flux_due_to_blocking_drag long_name = integrated y momentum flux from blocking drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dusfc_ss] - standard_name = integrated_x_momentum_flux_from_small_scale_gwd + standard_name = vertically_integrated_x_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated x momentum flux from small scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_ss] - standard_name = integrated_y_momentum_flux_from_small_scale_gwd + standard_name = vertically_integrated_y_momentum_flux_due_to_small_scale_gravity_wave_drag long_name = integrated y momentum flux from small scale gwd - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dusfc_fd] - standard_name = integrated_x_momentum_flux_from_form_drag + standard_name = vertically_integrated_x_momentum_flux_due_to_form_drag long_name = integrated x momentum flux from form drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dvsfc_fd] - standard_name = integrated_y_momentum_flux_from_form_drag + standard_name = vertically_integrated_y_momentum_flux_due_to_form_drag long_name = integrated y momentum flux from form drag - units = Pa s + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = out optional = F [dtaux2d_ls] - standard_name = x_momentum_tendency_from_large_scale_gwd - long_name = x momentum tendency from large scale gwd + standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag + long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) type = real @@ -593,8 +593,8 @@ intent = out optional = F [dtauy2d_ls] - standard_name = y_momentum_tendency_from_large_scale_gwd - long_name = y momentum tendency from large scale gwd + standard_name = tendency_of_y_wind_due_to_mesoscale_orographic_gravity_wave_drag + long_name = instantaneous change in y wind due to orographic gw drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) type = real @@ -602,7 +602,7 @@ intent = out optional = F [dtaux2d_bl] - standard_name = x_momentum_tendency_from_blocking_drag + standard_name = tendency_of_x_momentum_due_to_blocking_drag long_name = x momentum tendency from blocking drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -611,7 +611,7 @@ intent = out optional = F [dtauy2d_bl] - standard_name = y_momentum_tendency_from_blocking_drag + standard_name = tendency_of_y_momentum_due_to_blocking_drag long_name = y momentum tendency from blocking drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -620,7 +620,7 @@ intent = out optional = F [dtaux2d_ss] - standard_name = x_momentum_tendency_from_small_scale_gwd + standard_name = tendency_of_x_momentum_due_to_small_scale_gravity_wave_drag long_name = x momentum tendency from small scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -629,7 +629,7 @@ intent = out optional = F [dtauy2d_ss] - standard_name = y_momentum_tendency_from_small_scale_gwd + standard_name = tendency_of_y_momentum_due_to_small_scale_gravity_wave_drag long_name = y momentum tendency from small scale gwd units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -638,7 +638,7 @@ intent = out optional = F [dtaux2d_fd] - standard_name = x_momentum_tendency_from_form_drag + standard_name = tendency_of_x_momentum_due_to_form_drag long_name = x momentum tendency from form drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -647,7 +647,7 @@ intent = out optional = F [dtauy2d_fd] - standard_name = y_momentum_tendency_from_form_drag + standard_name = tendency_of_y_momentum_due_to_form_drag long_name = y momentum tendency from form drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -877,7 +877,7 @@ intent = out optional = F [gw_dudt] - standard_name = tendency_of_x_wind_due_to_ugwp + standard_name = tendency_of_x_wind_due_to_gravity_wave_drag long_name = zonal wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -886,7 +886,7 @@ intent = out optional = F [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_ugwp + standard_name = tendency_of_y_wind_due_to_gravity_wave_drag long_name = meridional wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -895,7 +895,7 @@ intent = out optional = F [gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_ugwp + standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag long_name = air temperature tendency due to UGWP units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -904,7 +904,7 @@ intent = out optional = F [gw_kdis] - standard_name = eddy_mixing_due_to_ugwp + standard_name = atmosphere_momentum_diffusivity_due_to_gravity_wave_drag long_name = eddy mixing due to UGWP units = m2 s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -984,17 +984,8 @@ kind = kind_phys intent = out optional = F -[dudt_ogw] - standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag - long_name = instantaneous change in x wind due to orographic gw drag - units = m s-2 - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = out - optional = F [dudt_tms] - standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -1267,7 +1258,7 @@ intent = in optional = F [do_ugwp_v0] - standard_name = do_ugwp_v0 + standard_name = flag_for_ugwp_version_0 long_name = flag to activate ver 0 CIRES UGWP units = flag dimensions = () @@ -1275,7 +1266,7 @@ intent = in optional = F [do_ugwp_v0_orog_only] - standard_name = do_ugwp_v0_orog_only + standard_name = flag_for_ugwp_version_0_orographic_gwd long_name = flag to activate ver 0 CIRES UGWP - orographic GWD only units = flag dimensions = () @@ -1283,7 +1274,7 @@ intent = in optional = F [do_ugwp_v0_nst_only] - standard_name = do_ugwp_v0_nst_only + standard_name = flag_for_ugwp_version_0_nonorographic_gwd long_name = flag to activate ver 0 CIRES UGWP - non-stationary GWD only units = flag dimensions = () @@ -1291,7 +1282,7 @@ intent = in optional = F [do_gsl_drag_ls_bl] - standard_name = do_gsl_drag_ls_bl + standard_name = flag_for_gsl_drag_suite_large_scale_orographic_and_blocking_drag long_name = flag to activate GSL drag suite - large-scale GWD and blocking units = flag dimensions = () @@ -1299,7 +1290,7 @@ intent = in optional = F [do_gsl_drag_ss] - standard_name = do_gsl_drag_ss + standard_name = flag_for_gsl_drag_suite_small_scale_orographic_drag long_name = flag to activate GSL drag suite - small-scale GWD units = flag dimensions = () @@ -1307,7 +1298,7 @@ intent = in optional = F [do_gsl_drag_tofd] - standard_name = do_gsl_drag_tofd + standard_name = flag_for_gsl_drag_suite_turbulent_orographic_form_drag long_name = flag to activate GSL drag suite - turb orog form drag units = flag dimensions = () diff --git a/physics/unified_ugwp_post.meta b/physics/unified_ugwp_post.meta index 85a6bff8e..0e30d4489 100644 --- a/physics/unified_ugwp_post.meta +++ b/physics/unified_ugwp_post.meta @@ -41,7 +41,7 @@ intent = in optional = F [gw_dtdt] - standard_name = tendency_of_air_temperature_due_to_ugwp + standard_name = tendency_of_air_temperature_due_to_gravity_wave_drag long_name = air temperature tendency due to UGWP units = K s-1 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -50,7 +50,7 @@ intent = in optional = F [gw_dudt] - standard_name = tendency_of_x_wind_due_to_ugwp + standard_name = tendency_of_x_wind_due_to_gravity_wave_drag long_name = zonal wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -59,7 +59,7 @@ intent = in optional = F [gw_dvdt] - standard_name = tendency_of_y_wind_due_to_ugwp + standard_name = tendency_of_y_wind_due_to_gravity_wave_drag long_name = meridional wind tendency due to UGWP units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -140,7 +140,7 @@ intent = in optional = F [dudt_ogw] - standard_name = instantaneous_change_in_x_wind_due_to_orographic_gravity_wave_drag + standard_name = tendency_of_x_wind_due_to_mesoscale_orographic_gravity_wave_drag long_name = instantaneous change in x wind due to orographic gw drag units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) @@ -149,7 +149,7 @@ intent = in optional = F [dudt_tms] - standard_name = instantaneous_change_in_x_wind_due_to_turbulent_orographic_form_drag + standard_name = tendency_of_x_wind_due_to_turbulent_orographic_form_drag long_name = instantaneous change in x wind due to TOFD units = m s-2 dimensions = (horizontal_loop_extent,vertical_dimension) From 5e50bdfa18779f6b9f4728d759c81fca40640297 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 10 Feb 2021 00:19:10 +0000 Subject: [PATCH 196/274] Cleanup for MPI implementation. --- physics/GFS_rrtmgp_gfdlmp_pre.F90 | 3 +- physics/GFS_rrtmgp_pre.F90 | 145 ++++------ physics/GFS_rrtmgp_pre.meta | 45 +-- physics/GFS_rrtmgp_sw_post.F90 | 5 +- physics/GFS_rrtmgp_sw_post.meta | 8 - physics/GFS_rrtmgp_sw_pre.F90 | 5 +- physics/GFS_rrtmgp_sw_pre.meta | 8 - physics/GFS_rrtmgp_thompsonmp_pre.F90 | 3 +- physics/rrtmgp_lw_aerosol_optics.F90 | 8 +- physics/rrtmgp_lw_aerosol_optics.meta | 16 -- physics/rrtmgp_lw_cloud_optics.F90 | 310 ++++++++++---------- physics/rrtmgp_lw_cloud_optics.meta | 60 ++-- physics/rrtmgp_lw_cloud_sampling.F90 | 10 +- physics/rrtmgp_lw_cloud_sampling.meta | 16 -- physics/rrtmgp_lw_gas_optics.F90 | 305 ++++++++++---------- physics/rrtmgp_lw_gas_optics.meta | 48 ++-- physics/rrtmgp_lw_pre.F90 | 5 +- physics/rrtmgp_lw_pre.meta | 8 - physics/rrtmgp_lw_rte.F90 | 6 +- physics/rrtmgp_lw_rte.meta | 8 - physics/rrtmgp_sw_aerosol_optics.F90 | 8 +- physics/rrtmgp_sw_aerosol_optics.meta | 16 -- physics/rrtmgp_sw_cloud_optics.F90 | 319 ++++++++++----------- physics/rrtmgp_sw_cloud_optics.meta | 53 ++-- physics/rrtmgp_sw_cloud_sampling.F90 | 11 +- physics/rrtmgp_sw_cloud_sampling.meta | 16 -- physics/rrtmgp_sw_gas_optics.F90 | 390 ++++++++++++++------------ physics/rrtmgp_sw_gas_optics.meta | 82 +++--- physics/rrtmgp_sw_rte.F90 | 6 +- physics/rrtmgp_sw_rte.meta | 8 - 30 files changed, 899 insertions(+), 1032 deletions(-) diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index 16844304b..1f3d34973 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -6,7 +6,8 @@ module GFS_rrtmgp_gfdlmp_pre use machine, only: kind_phys use rrtmgp_aux, only: check_error_msg use module_radiation_cloud_overlap, only: cmp_dcorr_lgth, get_alpha_exp - use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr + use rrtmgp_lw_cloud_optics, only: radliq_lwr => radliq_lwrLW, radliq_upr => radliq_uprLW,& + radice_lwr => radice_lwrLW, radice_upr => radice_uprLW ! Parameters real(kind_phys), parameter :: & diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 73828999f..eb5ae91ce 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -8,7 +8,6 @@ module GFS_rrtmgp_pre getgases, & ! Routine to setup trace gases getozn ! Routine to setup ozone ! RRTMGP types - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs use rrtmgp_aux, only: check_error_msg @@ -19,20 +18,7 @@ module GFS_rrtmgp_pre amdw = amd/amw, & ! Molecular weight of dry air / water vapor amdo3 = amd/amo3 ! Molecular weight of dry air / ozone - ! Some common trace gas on/off flags. - ! This allows for control over which trace gases are used in RRTMGP radiation scheme via - ! namelist. - logical :: & - isActive_h2o = .false., & ! - isActive_co2 = .false., & ! - isActive_o3 = .false., & ! - isActive_n2o = .false., & ! - isActive_ch4 = .false., & ! - isActive_o2 = .false., & ! - isActive_ccl4 = .false., & ! - isActive_cfc11 = .false., & ! - isActive_cfc12 = .false., & ! - isActive_cfc22 = .false. ! + ! Save trace gas indices. integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, & iStr_cfc11, iStr_cfc12, iStr_cfc22 @@ -45,15 +31,15 @@ module GFS_rrtmgp_pre !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, errflg) + subroutine GFS_rrtmgp_pre_init(nGases, active_gases, gas_concentrations, errmsg, errflg) ! Inputs - integer, intent(in) :: & - nGases ! Number of active gases in RRTMGP - character(len=*), intent(in) :: & - active_gases ! List of active gases from namelist. + integer, intent(in) :: & + nGases ! Number of active gases in RRTMGP + character(len=*), intent(in) :: & + active_gases ! List of active gases from namelist. ! Outputs - character(len=*),dimension(nGases), intent(out) :: & - active_gases_array ! Character array containing trace gases to include in RRTMGP + type(ty_gas_concs),intent(out) :: & + gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -63,6 +49,7 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, character(len=1) :: tempstr integer :: ij, count integer,dimension(nGases,2) :: gasIndices + character(len=32),dimension(nGases) :: active_gases_array ! Initialize errmsg = '' @@ -89,51 +76,33 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, active_gases_array, errmsg, ! Now extract the gas names do ij=1,nGases active_gases_array(ij) = active_gases(gasIndices(ij,1):gasIndices(ij,2)) + if(trim(active_gases_array(ij)) .eq. 'h2o') istr_h2o = ij + if(trim(active_gases_array(ij)) .eq. 'co2') istr_co2 = ij + if(trim(active_gases_array(ij)) .eq. 'o3') istr_o3 = ij + if(trim(active_gases_array(ij)) .eq. 'n2o') istr_n2o = ij + if(trim(active_gases_array(ij)) .eq. 'ch4') istr_ch4 = ij + if(trim(active_gases_array(ij)) .eq. 'o2') istr_o2 = ij + if(trim(active_gases_array(ij)) .eq. 'ccl4') istr_ccl4 = ij + if(trim(active_gases_array(ij)) .eq. 'cfc11') istr_cfc11 = ij + if(trim(active_gases_array(ij)) .eq. 'cfc12') istr_cfc12 = ij + if(trim(active_gases_array(ij)) .eq. 'cfc22') istr_cfc22 = ij enddo - ! Which gases are active? (This is purely for flexibility) - do ij=1,nGases - if(trim(active_gases_array(ij)) .eq. 'h2o') then - isActive_h2o = .true. - istr_h2o = ij - endif - if(trim(active_gases_array(ij)) .eq. 'co2') then - isActive_co2 = .true. - istr_co2 = ij - endif - if(trim(active_gases_array(ij)) .eq. 'o3') then - isActive_o3 = .true. - istr_o3 = ij - endif - if(trim(active_gases_array(ij)) .eq. 'n2o') then - isActive_n2o = .true. - istr_n2o = ij - endif - if(trim(active_gases_array(ij)) .eq. 'ch4') then - isActive_ch4 = .true. - istr_ch4 = ij - endif - if(trim(active_gases_array(ij)) .eq. 'o2') then - isActive_o2 = .true. - istr_o2 = ij - endif - if(trim(active_gases_array(ij)) .eq. 'ccl4') then - isActive_ccl4 = .true. - istr_ccl4 = ij - endif - if(trim(active_gases_array(ij)) .eq. 'cfc11') then - isActive_cfc11 = .true. - istr_cfc11 = ij - endif - if(trim(active_gases_array(ij)) .eq. 'cfc12') then - isActive_cfc12 = .true. - istr_cfc12 = ij - endif - if(trim(active_gases_array(ij)) .eq. 'cfc22') then - isActive_cfc22 = .true. - istr_cfc22 = ij - endif - enddo + ! Initialze RRTMGP DDTs + call check_error_msg('GFS_rrtmgp_pre_init', & + gas_concentrations%init( active_gases_array)) + call check_error_msg('GFS_rrtmgp_pre_setvmr_h2o',& + gas_concentrations%set_vmr(active_gases_array(iStr_o2), 0._kind_phys)) + call check_error_msg('GFS_rrtmgp_pre_setvmr_co2',& + gas_concentrations%set_vmr(active_gases_array(iStr_co2), 0._kind_phys)) + call check_error_msg('GFS_rrtmgp_pre_setvmr_ch4',& + gas_concentrations%set_vmr(active_gases_array(iStr_ch4), 0._kind_phys)) + call check_error_msg('GFS_rrtmgp_pre_setvmr_n2o',& + gas_concentrations%set_vmr(active_gases_array(iStr_n2o), 0._kind_phys)) + call check_error_msg('GFS_rrtmgp_pre_setvmr_h2o',& + gas_concentrations%set_vmr(active_gases_array(iStr_h2o), 0._kind_phys)) + call check_error_msg('GFS_rrtmgp_pre_setvmr_o3', & + gas_concentrations%set_vmr(active_gases_array(iStr_o3), 0._kind_phys)) end subroutine GFS_rrtmgp_pre_init @@ -143,25 +112,23 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, fhswr, & - fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, active_gases_array, con_eps,& - con_epsm1, con_fvirt, con_epsqs, lw_gas_props, & + subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, & + fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps,& + con_epsm1, con_fvirt, con_epsqs, minGPpres, & raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,& - gas_concentrations, errmsg, errflg) + gas_concentrations, errmsg, errflg) ! Inputs integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers - nGases, & ! Number of active gases in RRTMGP. nTracers, & ! Number of tracers from model. i_o3 ! Index into tracer array for ozone logical, intent(in) :: & lsswr, & ! Call SW radiation? lslwr ! Call LW radiation - character(len=*),dimension(nGases), intent(in) :: & - active_gases_array ! Character array containing trace gases to include in RRTMGP real(kind_phys), intent(in) :: & + minGPpres, & ! Minimum pressure allowed in RRTMGP fhswr, & ! Frequency of SW radiation call. fhlwr ! Frequency of LW radiation call. real(kind_phys), intent(in) :: & @@ -181,8 +148,6 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, prsi ! Pressure at model-interfaces (Pa) real(kind_phys), dimension(nCol,nLev,nTracers) :: & qgrs ! Tracer concentrations (kg/kg) - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: ! Outputs character(len=*), intent(out) :: & @@ -216,6 +181,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, real(kind_phys) :: es, tem1, tem2 real(kind_phys), dimension(nCol,nLev) :: o3_lay, tem2da, tem2db real(kind_phys), dimension(nCol,nLev, NF_VGAS) :: gas_vmr + character(len=32), dimension(gas_concentrations%get_num_gases()) :: active_gases ! Initialize CCPP error handling variables errmsg = '' @@ -258,7 +224,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, tem2db(1:nCol,2:iSFC) = log(p_lev(1:nCol,2:iSFC)) do iCol = 1, nCol tem2da(iCol,1) = log(p_lay(iCol,1) ) - tem2db(iCol,1) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,1)) ) + tem2db(iCol,1) = log(max(minGPpres, p_lev(iCol,1)) ) tem2db(iCol,iSFC) = log(p_lev(iCol,iSFC) ) enddo ! @@ -277,7 +243,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, do iCol = 1, nCol tem2da(iCol,1) = log(p_lay(iCol,1)) tem2db(iCol,1) = log(p_lev(iCol,1)) - tem2db(iCol,iTOA) = log(max(lw_gas_props%get_press_min(), p_lev(iCol,iTOA)) ) + tem2db(iCol,iTOA) = log(max(minGPpres, p_lev(iCol,iTOA)) ) enddo ! t_lev(1:NCOL,1) = tsfc(1:NCOL) @@ -333,15 +299,22 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) - ! Initialize and opulate RRTMGP DDT w/ gas-concentrations - call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o2), gas_vmr(:,:,4))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_co2), gas_vmr(:,:,1))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_ch4), gas_vmr(:,:,3))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_n2o), gas_vmr(:,:,2))) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_h2o), vmr_h2o)) - call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3)) - + ! Initialize and populate RRTMGP DDT w/ gas-concentrations + active_gases = gas_concentrations%get_gas_names() + do iGas=1,gas_concentrations%get_num_gases() + if (iGas .eq. istr_o2) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_o2', & + gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,4))) + if (iGas .eq. istr_co2) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_co2',& + gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,1))) + if (iGas .eq. istr_ch4) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_ch4',& + gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,3))) + if (iGas .eq. istr_n2o) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_n2o',& + gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,2))) + if (iGas .eq. istr_h2o) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_h2o',& + gas_concentrations%set_vmr(trim(active_gases(iGas)), vmr_h2o)) + if (iGas .eq. istr_o3) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_o3', & + gas_concentrations%set_vmr(trim(active_gases(iGas)), vmr_o3)) + enddo ! ####################################################################################### ! Radiation time step (output) (Is this really needed?) (Used by some diagnostics) ! ####################################################################################### @@ -351,7 +324,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nGases, nTracers, i_o3, lsswr, lslwr, ! Setup surface ground temperature and ground/air skin temperature if required. ! ####################################################################################### tsfg(1:NCOL) = tsfc(1:NCOL) - tsfa(1:NCOL) = t_lay(1:NCOL,iSFC)!tsfc(1:NCOL) + tsfa(1:NCOL) = t_lay(1:NCOL,iSFC) end subroutine GFS_rrtmgp_pre_run diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index fd7067ca6..28487974b 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -25,13 +25,12 @@ type = integer intent = in optional = F -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs intent = out optional = F [errmsg] @@ -71,15 +70,7 @@ dimensions = () type = integer intent = in - optional = F -[nGases] - standard_name = number_of_active_gases_used_by_RRTMGP - long_name = number of gases available used by RRTMGP (Model%nGases) - units = count - dimensions = () - type = integer - intent = in - optional = F + optional = F [nTracers] standard_name = number_of_tracers long_name = number of tracers @@ -202,15 +193,6 @@ kind = kind_phys intent = in optional = F -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* - intent = in - optional = F [con_eps] standard_name = ratio_of_dry_air_to_water_vapor_gas_constants long_name = rd/rv @@ -246,13 +228,14 @@ 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 - units = DDT + optional = F +[minGPpres] + standard_name = minimum_pressure_in_RRTMGP + long_name = minimum pressure allowed in RRTMGP + units = Pa dimensions = () - type = ty_gas_optics_rrtmgp + type = real + kind = kind_phys intent = in optional = F [raddt] diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index f89c2e7e7..14dfb798a 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -6,6 +6,7 @@ module GFS_rrtmgp_sw_post use mo_fluxes_byband, only: ty_fluxes_byband use mo_heating_rates, only: compute_heating_rate use rrtmgp_aux, only: check_error_msg + use rrtmgp_sw_gas_optics, only: sw_gas_props implicit none public GFS_rrtmgp_sw_post_init,GFS_rrtmgp_sw_post_run,GFS_rrtmgp_sw_post_finalize @@ -26,7 +27,7 @@ end subroutine GFS_rrtmgp_sw_post_init !! subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky_hr, & save_diag, fhswr, coszen, coszdg, t_lay, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sw_gas_props, fluxswUP_allsky, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, fluxswUP_allsky, & fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & mtopa, cld_frac, cldtausw, fluxr, & nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & @@ -43,8 +44,6 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky lsswr, & ! Call SW radiation? do_sw_clrsky_hr, & ! Output clear-sky SW heating-rate? save_diag ! Output radiation diagnostics? - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! DDT containing SW spectral information real(kind_phys), intent(in) :: & fhswr ! Frequency for SW radiation real(kind_phys), dimension(nCol), intent(in) :: & diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 2dc412118..eb7f1600d 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -145,14 +145,6 @@ kind = kind_phys intent = in optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [fluxswUP_allsky] standard_name = RRTMGP_sw_flux_profile_upward_allsky long_name = RRTMGP upward shortwave all-sky flux profile diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 1268ed26f..13b2e3a00 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -10,6 +10,7 @@ module GFS_rrtmgp_sw_pre cdfnor ! Routine to compute CDF (used to compute percentiles) use mo_gas_optics_rrtmgp, only: & ty_gas_optics_rrtmgp + use rrtmgp_sw_gas_optics, only: sw_gas_props public GFS_rrtmgp_sw_pre_run,GFS_rrtmgp_sw_pre_init,GFS_rrtmgp_sw_pre_finalize contains @@ -29,7 +30,7 @@ end subroutine GFS_rrtmgp_sw_pre_init subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, & - sfc_wts, p_lay, tv_lay, relhum, p_lev, sw_gas_props, nday, idxday, coszen, coszdg, & + sfc_wts, p_lay, tv_lay, relhum, p_lev, nday, idxday, coszen, coszdg, & sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, & errmsg, errflg) @@ -76,8 +77,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ relhum ! Layer relative-humidity real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer interfaces (Pa) - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: spectral information for SW calculation ! Outputs integer, intent(out) :: & diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 202f1667a..07fdf8957 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -298,14 +298,6 @@ kind = kind_phys intent = in optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [sfc_alb_nir_dir] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index ea27f3d2b..0d80e8e35 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -14,7 +14,8 @@ module GFS_rrtmgp_thompsonmp_pre make_IceNumber, & make_DropletNumber, & make_RainNumber - use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr + use rrtmgp_lw_cloud_optics, only: radliq_lwr => radliq_lwrLW, radliq_upr => radliq_uprLW,& + radice_lwr => radice_lwrLW, radice_upr => radice_uprLW implicit none ! Parameters specific to THOMPSON MP scheme. diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 index 2047deaf4..b8a21e85a 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -3,6 +3,8 @@ module rrtmgp_lw_aerosol_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_1scl use rrtmgp_aux, only: check_error_msg + use rrtmgp_sw_gas_optics, only: sw_gas_props + use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) @@ -30,7 +32,7 @@ end subroutine rrtmgp_lw_aerosol_optics_init !! subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer,& p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - lw_gas_props, sw_gas_props, aerodp, lw_optical_props_aerosol, errmsg, errflg) + aerodp, lw_optical_props_aerosol, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -55,10 +57,6 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer aerfld ! aerosol input concentrations real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer-interfaces (Pa) - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: spectral information for SW calculation - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for LW calculation ! Outputs real(kind_phys), dimension(nCol,NSPC1), intent(inout) :: & diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index 0787d3fc4..4aa1e9e9e 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -137,22 +137,6 @@ 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 - units = DDT - dimensions = () - intent = in - type = ty_gas_optics_rrtmgp - optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [aerodp] standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 341c19fc2..d8aa7e9f0 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -2,9 +2,9 @@ module rrtmgp_lw_cloud_optics use machine, only: kind_phys use mo_rte_kind, only: wl use mo_cloud_optics, only: ty_cloud_optics - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics + use rrtmgp_lw_gas_optics, only: lw_gas_props use rrtmgp_aux, only: check_error_msg use netcdf @@ -12,16 +12,51 @@ module rrtmgp_lw_cloud_optics public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize + type(ty_cloud_optics) :: lw_cloud_props + real(kind_phys) :: & + radliq_facLW, & ! Factor for calculating LUT interpolation indices for liquid + radice_facLW ! Factor for calculating LUT interpolation indices for ice + real(kind_phys), dimension(:,:), allocatable :: & + lut_extliqLW, & ! LUT shortwave liquid extinction coefficient + lut_ssaliqLW, & ! LUT shortwave liquid single scattering albedo + lut_asyliqLW, & ! LUT shortwave liquid asymmetry parameter + band_limsCLDLW ! Beginning and ending wavenumber [cm -1] for each band + real(kind_phys), dimension(:,:,:), allocatable :: & + lut_exticeLW, & ! LUT shortwave ice extinction coefficient + lut_ssaiceLW, & ! LUT shortwave ice single scattering albedo + lut_asyiceLW ! LUT shortwave ice asymmetry parameter + real(kind_phys), dimension(:), allocatable :: & + pade_sizereg_extliqLW, & ! Particle size regime boundaries for shortwave liquid extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaliqLW, & ! Particle size regime boundaries for shortwave liquid single + ! scattering albedo for Pade interpolation + pade_sizereg_asyliqLW, & ! Particle size regime boundaries for shortwave liquid asymmetry + ! parameter for Pade interpolation + pade_sizereg_exticeLW, & ! Particle size regime boundaries for shortwave ice extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaiceLW, & ! Particle size regime boundaries for shortwave ice single + ! scattering albedo for Pade interpolation + pade_sizereg_asyiceLW ! Particle size regime boundaries for shortwave ice asymmetry + ! parameter for Pade interpolation + real(kind_phys), dimension(:,:,:), allocatable :: & + pade_extliqLW, & ! PADE coefficients for shortwave liquid extinction + pade_ssaliqLW, & ! PADE coefficients for shortwave liquid single scattering albedo + pade_asyliqLW ! PADE coefficients for shortwave liquid asymmetry parameter + real(kind_phys), dimension(:,:,:,:), allocatable :: & + pade_exticeLW, & ! PADE coefficients for shortwave ice extinction + pade_ssaiceLW, & ! PADE coefficients for shortwave ice single scattering albedo + pade_asyiceLW ! PADE coefficients for shortwave ice asymmetry parameter + ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics real(kind_phys), parameter :: & absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr ! Ice particle size lower bound for LUT interpolation + radliq_lwrLW, & ! Liquid particle size lower bound for LUT interpolation + radliq_uprLW, & ! Liquid particle size upper bound for LUT interpolation + radice_lwrLW, & ! Ice particle size upper bound for LUT interpolation + radice_uprLW ! Ice particle size lower bound for LUT interpolation contains @@ -31,71 +66,34 @@ module rrtmgp_lw_cloud_optics !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & - doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_lw_file_clouds, mpicomm, & - mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + subroutine rrtmgp_lw_cloud_optics_init(nCol, nLev, nbndsGPlw, doG_cldoptics, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, & + rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs logical, intent(in) :: & - doG_cldoptics, & ! Use legacy RRTMG cloud-optics? - doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? - doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? + doG_cldoptics, & ! Use legacy RRTMG cloud-optics? + doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? + doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(inout) :: & - nrghice ! Number of ice-roughness categories - integer, intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank + nrghice ! Number of ice-roughness categories + integer, intent(in) :: & + nbndsGPlw, & ! Number of longwave bands + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank character(len=128),intent(in) :: & - rrtmgp_root_dir, & ! RTE-RRTMGP root directory - rrtmgp_lw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties - + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_lw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties + ! Outputs - type(ty_cloud_optics),intent(out) :: & - lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error code + errflg ! Error code - ! Local variables that will be passed to cloud_optics%load() - real(kind_phys) :: & - !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation - radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - !radice_lwr, & ! Ice particle size upper bound for LUT interpolation - !radice_upr, & ! Ice particle size lower bound for LUT interpolation - radice_fac ! Factor for calculating LUT interpolation indices for ice - real(kind_phys), dimension(:,:), allocatable :: & - lut_extliq, & ! LUT shortwave liquid extinction coefficient - lut_ssaliq, & ! LUT shortwave liquid single scattering albedo - lut_asyliq, & ! LUT shortwave liquid asymmetry parameter - band_lims ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & - lut_extice, & ! LUT shortwave ice extinction coefficient - lut_ssaice, & ! LUT shortwave ice single scattering albedo - lut_asyice ! LUT shortwave ice asymmetry parameter - real(kind_phys), dimension(:), allocatable :: & - pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single - ! scattering albedo for Pade interpolation - pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry - ! parameter for Pade interpolation - pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single - ! scattering albedo for Pade interpolation - pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry - ! parameter for Pade interpolation - real(kind_phys), dimension(:,:,:), allocatable :: & - pade_extliq, & ! PADE coefficients for shortwave liquid extinction - pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo - pade_asyliq ! PADE coefficients for shortwave liquid asymmetry parameter - real(kind_phys), dimension(:,:,:,:), allocatable :: & - pade_extice, & ! PADE coefficients for shortwave ice extinction - pade_ssaice, & ! PADE coefficients for shortwave ice single scattering albedo - pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter ! Dimensions integer :: & nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizeReg,& @@ -110,8 +108,13 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, errmsg = '' errflg = 0 + ! If not using RRTMGP cloud optics, return. if (doG_cldoptics) return + ! + ! Otherwise, using RRTMGP cloud-optics, continue with initialization... + ! + ! Filenames are set in the physics_nml lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) @@ -141,113 +144,104 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, status = nf90_inquire_dimension(ncid, dimid, len=npairs) ! Has the number of ice-roughnesses to use been provided from the namelist? - ! If not provided, use default number of ice-roughness categories - if (nrghice .eq. 0) then - nrghice = nrghice_default - else - nrghice = nrghice_fromfile - ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. - if (nrghice .gt. nrghice_fromfile) then - errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' - nrghice = nrghice_default - endif - endif + ! If not, use nrghice from cloud-optics data file. + if (nrghice .eq. 0) nrghice = nrghice_fromfile ! Allocate space for arrays if (doGP_cldoptics_LUT) then - allocate(lut_extliq(nSize_liq, nBand)) - allocate(lut_ssaliq(nSize_liq, nBand)) - allocate(lut_asyliq(nSize_liq, nBand)) - allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) - allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) - allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_extliqLW(nSize_liq, nBand)) + allocate(lut_ssaliqLW(nSize_liq, nBand)) + allocate(lut_asyliqLW(nSize_liq, nBand)) + allocate(lut_exticeLW(nSize_ice, nBand, nrghice)) + allocate(lut_ssaiceLW(nSize_ice, nBand, nrghice)) + allocate(lut_asyiceLW(nSize_ice, nBand, nrghice)) endif if (doGP_cldoptics_PADE) then - allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) - allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) - allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) - allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) - allocate(pade_sizereg_extliq(nBound)) - allocate(pade_sizereg_ssaliq(nBound)) - allocate(pade_sizereg_asyliq(nBound)) - allocate(pade_sizereg_extice(nBound)) - allocate(pade_sizereg_ssaice(nBound)) - allocate(pade_sizereg_asyice(nBound)) + allocate(pade_extliqLW(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliqLW(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliqLW(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_exticeLW(nBand, nSizeReg, nCoeff_ext, nrghice)) + allocate(pade_ssaiceLW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_asyiceLW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_sizereg_extliqLW(nBound)) + allocate(pade_sizereg_ssaliqLW(nBound)) + allocate(pade_sizereg_asyliqLW(nBound)) + allocate(pade_sizereg_exticeLW(nBound)) + allocate(pade_sizereg_ssaiceLW(nBound)) + allocate(pade_sizereg_asyiceLW(nBound)) endif - allocate(band_lims(2,nBand)) + allocate(band_limsCLDLW(2,nBand)) ! Read in fields from file if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_get_var(ncid,varID,radliq_lwrLW) status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_get_var(ncid,varID,radliq_uprLW) status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_get_var(ncid,varID,radliq_facLW) status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_get_var(ncid,varID,radice_lwrLW) status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_get_var(ncid,varID,radice_uprLW) status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_get_var(ncid,varID,radice_facLW) status = nf90_inq_varid(ncid,'lut_extliq',varID) - status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_get_var(ncid,varID,lut_extliqLW) status = nf90_inq_varid(ncid,'lut_ssaliq',varID) - status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_get_var(ncid,varID,lut_ssaliqLW) status = nf90_inq_varid(ncid,'lut_asyliq',varID) - status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_get_var(ncid,varID,lut_asyliqLW) status = nf90_inq_varid(ncid,'lut_extice',varID) - status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_get_var(ncid,varID,lut_exticeLW) status = nf90_inq_varid(ncid,'lut_ssaice',varID) - status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_get_var(ncid,varID,lut_ssaiceLW) status = nf90_inq_varid(ncid,'lut_asyice',varID) - status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_get_var(ncid,varID,lut_asyiceLW) status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_lims) + status = nf90_get_var(ncid,varID,band_limsCLDLW) endif if (doGP_cldoptics_PADE) then write (*,*) 'Reading RRTMGP longwave cloud data (PADE) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_get_var(ncid,varID,radliq_lwrLW) status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_get_var(ncid,varID,radliq_uprLW) status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_get_var(ncid,varID,radliq_facLW) status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_get_var(ncid,varID,radice_lwrLW) status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_get_var(ncid,varID,radice_uprLW) status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_get_var(ncid,varID,radice_facLW) status = nf90_inq_varid(ncid,'pade_extliq',varID) - status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_get_var(ncid,varID,pade_extliqLW) status = nf90_inq_varid(ncid,'pade_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_get_var(ncid,varID,pade_ssaliqLW) status = nf90_inq_varid(ncid,'pade_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_get_var(ncid,varID,pade_asyliqLW) status = nf90_inq_varid(ncid,'pade_extice',varID) - status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_get_var(ncid,varID,pade_exticeLW) status = nf90_inq_varid(ncid,'pade_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_get_var(ncid,varID,pade_ssaiceLW) status = nf90_inq_varid(ncid,'pade_asyice',varID) - status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_get_var(ncid,varID,pade_asyiceLW) status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_get_var(ncid,varID,pade_sizereg_extliqLW) status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliqLW) status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliqLW) status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_get_var(ncid,varID,pade_sizereg_exticeLW) status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaiceLW) status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_get_var(ncid,varID,pade_sizereg_asyiceLW) status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_lims) + status = nf90_get_var(ncid,varID,band_limsCLDLW) endif ! Close file @@ -256,17 +250,23 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! Load tables data for RRTMGP cloud-optics if (doGP_cldoptics_LUT) then - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & - radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & - lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) +!$omp critical (load_lw_cloud_props_LUTs) + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_limsCLDLW, & + radliq_lwrLW, radliq_uprLW, radliq_facLW, radice_lwrLW, radice_uprLW, radice_facLW, & + lut_extliqLW, lut_ssaliqLW, lut_asyliqLW, lut_exticeLW, lut_ssaiceLW, lut_asyiceLW)) +!$omp end critical (load_lw_cloud_props_LUTs) endif if (doGP_cldoptics_PADE) then - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & - pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& - pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & - pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) +!$omp critical (load_lw_cloud_props_PADE_approx) + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_limsCLDLW, & + pade_extliqLW, pade_ssaliqLW, pade_asyliqLW, pade_exticeLW, pade_ssaiceLW, pade_asyiceLW,& + pade_sizereg_extliqLW, pade_sizereg_ssaliqLW, pade_sizereg_asyliqLW, & + pade_sizereg_exticeLW, pade_sizereg_ssaiceLW, pade_sizereg_asyiceLW)) +!$omp endcritical (load_lw_cloud_props_PADE_approx) endif +!$omp critical (load_lw_cloud_props_nrghice) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) +!$omp end critical (load_lw_cloud_props_nrghice) end subroutine rrtmgp_lw_cloud_optics_init @@ -277,9 +277,9 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, nCol, nLev, nrghice, p_lay, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, nCol, nLev, nbndsGPlw, p_lay, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, lw_cloud_props, lw_gas_props, lon, lat, cldtaulw, & + cld_rerain, precip_frac, lon, lat, cldtaulw, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, errmsg, errflg) ! Inputs @@ -290,9 +290,9 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw doGP_cldoptics_LUT, & ! Use RRTMGP cloud-optics: LUTs? doGP_lwscat ! Include scattering in LW cloud-optics? integer, intent(in) :: & + nbndsGPlw, & ! Number of longwave bands nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels - nrghice, & ! Number of ice-roughness categories icliq_lw, & ! Choice of treatment of liquid cloud optical properties (RRTMG legacy) icice_lw ! Choice of treatment of ice cloud optical properties (RRTMG legacy) real(kind_phys), dimension(nCol), intent(in) :: & @@ -310,17 +310,13 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw cld_rwp, & ! Cloud rain water path cld_rerain, & ! Cloud rain effective radius precip_frac ! Precipitation fraction by layer. - type(ty_cloud_optics),intent(in) :: & - lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme ! Outputs character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error flag - type(ty_optical_props_2str),intent(inout) :: & + type(ty_optical_props_2str),intent(out) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) real(kind_phys), dimension(ncol,nLev), intent(inout) :: & @@ -328,7 +324,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw ! Local variables real(kind_phys) :: tau_rain, tau_snow - real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()) :: & + real(kind_phys), dimension(ncol,nLev,nbndsGPlw) :: & tau_cld, tau_precip integer :: iCol, iLay, iBand @@ -342,23 +338,15 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw if (.not. doLWrad) return - ! Allocate space for RRTMGP DDTs containing cloud radiative properties - ! Cloud optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& - ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - lw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys - lw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys - - ! Precipitation optics [nCol,nLev,nBands] - call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& - ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - lw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys - lw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys - ! Compute cloud-optics for RTE. if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& + ncol, nLev, lw_cloud_props%get_band_lims_wavenumber())) + lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& + ncol, nLev, lw_cloud_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + ! i) RRTMGP cloud-optics. call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(& cld_lwp, & ! IN - Cloud liquid water path (g/m2) @@ -380,7 +368,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw else tau_snow = 0.0 endif - do iBand=1,lw_gas_props%get_nband() + do iBand=1,nbndsGPlw lw_optical_props_precipByBand%tau(iCol,iLay,iBand) = tau_rain + tau_snow enddo endif @@ -388,11 +376,17 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw enddo endif if (doG_cldoptics) then + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_2str(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_precipByBand%alloc_2str(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys ! ii) RRTMG cloud-optics. if (any(cld_frac .gt. 0)) then - call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & - cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & - cld_frac, icliq_lw, icice_lw, tau_cld, tau_precip) + call rrtmg_lw_cloud_optics(ncol, nLev, nbndsGPlw, cld_lwp, cld_reliq, cld_iwp,& + cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, cld_frac, icliq_lw, & + icice_lw, tau_cld, tau_precip) lw_optical_props_cloudsByBand%tau = tau_cld lw_optical_props_precipByBand%tau = tau_precip endif diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index c57e70a33..80cf60bf5 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -7,6 +7,30 @@ [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_init type = scheme +[nbndsGPlw] + standard_name = number_of_lw_bands_rrtmgp + long_name = number of lw bands used in RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F [doG_cldoptics] standard_name = flag_to_calc_lw_cld_optics_using_RRTMG long_name = logical flag to control cloud optics scheme. @@ -98,14 +122,6 @@ type = integer intent = out optional = F -[lw_cloud_props] - standard_name = coefficients_for_lw_cloud_optics - long_name = DDT containing spectral information for RRTMGP LW radiation scheme - units = DDT - dimensions = () - type = ty_cloud_optics - intent = out - optional = F ######################################################################## [ccpp-arg-table] @@ -183,14 +199,6 @@ type = integer intent = in optional = F -[nrghice] - standard_name = number_of_rrtmgp_ice_roughness - long_name = number of ice-roughness categories in RRTMGP calculation - units = count - dimensions = () - type = integer - intent = in - optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction @@ -281,21 +289,13 @@ 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 - units = DDT - dimensions = () - intent = in - type = ty_gas_optics_rrtmgp - optional = F -[lw_cloud_props] - standard_name = coefficients_for_lw_cloud_optics - long_name = DDT containing spectral information for RRTMGP LW radiation scheme - units = DDT - dimensions = () +[nbndsGPlw] + standard_name = number_of_lw_bands_rrtmgp + long_name = number of lw bands used in RRTMGP + units = count + dimensions = () + type = integer intent = in - type = ty_cloud_optics optional = F [lon] standard_name = longitude diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 902a4e20f..8274dbd13 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -5,6 +5,7 @@ module rrtmgp_lw_cloud_sampling use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg + use rrtmgp_lw_gas_optics, only: lw_gas_props use netcdf implicit none @@ -17,10 +18,7 @@ module rrtmgp_lw_cloud_sampling !! \section arg_table_rrtmgp_lw_cloud_sampling_init !! \htmlinclude rrtmgp_lw_cloud_sampling_init.html !! - subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0, errmsg, errflg) - ! Inputs - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: K-distribution data + subroutine rrtmgp_lw_cloud_sampling_init(ipsdlw0, errmsg, errflg) ! Outputs integer, intent(out) :: & ipsdlw0 ! Initial permutation seed for McICA @@ -46,7 +44,7 @@ end subroutine rrtmgp_lw_cloud_sampling_init !! subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, iovr, & iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_lw, & - cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, lw_gas_props, & + cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & doGP_lwscat, lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, & lw_optical_props_clouds, lw_optical_props_precip, errmsg, errflg) @@ -77,8 +75,6 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, real(kind_phys), dimension(ncol,nLev), intent(in) :: & cloud_overlap_param, & ! Cloud overlap parameter precip_overlap_param ! Precipitation overlap parameter - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_2str),intent(in) :: & lw_optical_props_cloudsByBand, & ! RRTMGP DDT: Longwave optical properties in each band (clouds) lw_optical_props_precipByBand ! RRTMGP DDT: Longwave optical properties in each band (precipitation) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 2438f715c..4e54d14b0 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -7,14 +7,6 @@ [ccpp-arg-table] name = rrtmgp_lw_cloud_sampling_init type = scheme -[lw_gas_props] - standard_name = coefficients_for_lw_gas_optics - long_name = DDT containing spectral information for RRTMGP LW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [ipsdlw0] standard_name = initial_permutation_seed_lw long_name = initial seed for McICA LW @@ -192,14 +184,6 @@ 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 - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in optional = F [lw_optical_props_cloudsByBand] standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index f8a01b982..df2021864 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -8,91 +8,87 @@ module rrtmgp_lw_gas_optics use mo_compute_bc, only: compute_bc use rrtmgp_aux, only: check_error_msg use netcdf - implicit none + type(ty_gas_optics_rrtmgp) :: lw_gas_props + integer, dimension(:), allocatable :: & + kminor_start_lowerLW, & ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upperLW ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_upper\" (upper atmosphere) + integer, dimension(:,:), allocatable :: & + band2gptLW, & ! Beginning and ending gpoint for each band + minor_limits_gpt_lowerLW, & ! Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upperLW ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:,:,:), allocatable :: & + key_speciesLW ! Key species pair for each band + real(kind_phys) :: & + press_ref_tropLW, & ! Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_pLW, & ! Standard spectroscopic reference pressure [Pa] + temp_ref_tLW ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:), allocatable :: & + press_refLW, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_refLW ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + real(kind_phys), dimension(:,:), allocatable :: & + band_limsLW, & ! Beginning and ending wavenumber [cm -1] for each band + totplnkLW, & ! Integrated Planck function by band + optimal_angle_fitLW + real(kind_phys), dimension(:,:,:), allocatable :: & + vmr_refLW, & ! volume mixing ratios for reference atmospherer + kminor_lowerLW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + kminor_upperLW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + rayl_lowerLW, & ! Not used in LW, rather allocated(rayl_lower) is used + rayl_upperLW ! Not used in LW, rather allocated(rayl_upper) is used + real(kind_phys), dimension(:,:,:,:), allocatable :: & + kmajorLW, & ! Stored absorption coefficients due to major absorbing gases + planck_fracLW ! Planck fractions + character(len=32), dimension(:), allocatable :: & + gas_namesLW, & ! Names of absorbing gases + gas_minorLW, & ! Name of absorbing minor gas + identifier_minorLW, & ! Unique string identifying minor gas + minor_gases_lowerLW, & ! Names of minor absorbing gases in lower atmosphere + minor_gases_upperLW, & ! Names of minor absorbing gases in upper atmosphere + scaling_gas_lowerLW, & ! Absorption also depends on the concentration of this gas + scaling_gas_upperLW ! Absorption also depends on the concentration of this gas + logical(wl), dimension(:), allocatable :: & + minor_scales_with_density_lowerLW, & ! Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upperLW, & ! Density scaling is applied to minor absorption coefficients + scale_by_complement_lowerLW, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upperLW ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + contains ! ######################################################################################### - ! SUBROUTINE rrtmgp_sw_gas_optics_init + ! SUBROUTINE rrtmgp_lw_gas_optics_init ! ######################################################################################### !! \section arg_table_rrtmgp_lw_gas_optics_init !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! - subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_nGases, & - active_gases_array, mpicomm, mpirank, mpiroot, lw_gas_props, errmsg, errflg) + subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_concentrations,& + nCol, nLev, mpicomm, mpirank, mpiroot, minGPpres, errmsg, errflg) ! Inputs + type(ty_gas_concs), intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties - integer, intent(in) :: & - rrtmgp_nGases ! Number of trace gases active in RRTMGP - character(len=*),dimension(rrtmgp_nGases), intent(in) :: & - active_gases_array ! Character array containing trace gases to include in RRTMGP integer,intent(in) :: & + nCol, & ! Number of horizontal points + nLev, & ! Number of vertical levels mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error code - type(ty_gas_optics_rrtmgp),intent(out) :: & - lw_gas_props ! RRTMGP DDT: longwave spectral information - - ! Variables that will be passed to gas_optics%load() - type(ty_gas_concs) :: & - gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) - integer, dimension(:), allocatable :: & - kminor_start_lower, & ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_lower\" (lower atmosphere) - kminor_start_upper ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_upper\" (upper atmosphere) - integer, dimension(:,:), allocatable :: & - band2gpt, & ! Beginning and ending gpoint for each band - minor_limits_gpt_lower, & ! Beginning and ending gpoint for each minor interval in lower atmosphere - minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:,:,:), allocatable :: & - key_species ! Key species pair for each band - real(kind_phys) :: & - press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] - temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] - temp_ref_t ! Standard spectroscopic reference temperature [K] - real(kind_phys), dimension(:), allocatable :: & - press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] - temp_ref ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] - real(kind_phys), dimension(:,:), allocatable :: & - band_lims, & ! Beginning and ending wavenumber [cm -1] for each band - totplnk, & ! Integrated Planck function by band - optimal_angle_fit - real(kind_phys), dimension(:,:,:), allocatable :: & - vmr_ref, & ! volume mixing ratios for reference atmosphere - kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - kminor_upper, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - rayl_lower, & ! Not used in LW, rather allocated(rayl_lower) is used - rayl_upper ! Not used in LW, rather allocated(rayl_upper) is used - real(kind_phys), dimension(:,:,:,:), allocatable :: & - kmajor, & ! Stored absorption coefficients due to major absorbing gases - planck_frac ! Planck fractions - character(len=32), dimension(:), allocatable :: & - gas_names, & ! Names of absorbing gases - gas_minor, & ! Name of absorbing minor gas - identifier_minor, & ! Unique string identifying minor gas - minor_gases_lower, & ! Names of minor absorbing gases in lower atmosphere - minor_gases_upper, & ! Names of minor absorbing gases in upper atmosphere - scaling_gas_lower, & ! Absorption also depends on the concentration of this gas - scaling_gas_upper ! Absorption also depends on the concentration of this gas - logical(wl), dimension(:), allocatable :: & - minor_scales_with_density_lower, & ! Density scaling is applied to minor absorption coefficients - minor_scales_with_density_upper, & ! Density scaling is applied to minor absorption coefficients - scale_by_complement_lower, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) - scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) - + errflg ! CCPP error code + real(kind_phys), intent(out) :: & + minGPpres ! Minimum pressure allowed by RRTMGP. ! Dimensions integer :: & ntemps, npress, ngpts, nabsorbers, nextrabsorbers, nminorabsorbers,& @@ -101,7 +97,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ncontributors_lower, ncontributors_upper,nfit_coeffs ! Local variables - integer :: ncid, dimID, varID, status, iGas, ierr + integer :: ncid, dimID, varID, status, iGas, ierr, ii integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4, & temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4 character(len=264) :: lw_gas_props_file @@ -153,125 +149,137 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetemps) ! Allocate space for arrays - allocate(gas_names(nabsorbers)) - allocate(scaling_gas_lower(nminor_absorber_intervals_lower)) - allocate(scaling_gas_upper(nminor_absorber_intervals_upper)) - allocate(gas_minor(nminorabsorbers)) - allocate(identifier_minor(nminorabsorbers)) - allocate(minor_gases_lower(nminor_absorber_intervals_lower)) - allocate(minor_gases_upper(nminor_absorber_intervals_upper)) - allocate(minor_limits_gpt_lower(npairs,nminor_absorber_intervals_lower)) - allocate(minor_limits_gpt_upper(npairs,nminor_absorber_intervals_upper)) - allocate(band2gpt(2,nbnds)) - allocate(key_species(2,nlayers,nbnds)) - allocate(band_lims(2,nbnds)) - allocate(press_ref(npress)) - allocate(temp_ref(ntemps)) - allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) - allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) - allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) - allocate(kminor_start_lower(nminor_absorber_intervals_lower)) - allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) - allocate(kminor_start_upper(nminor_absorber_intervals_upper)) - allocate(optimal_angle_fit(nfit_coeffs,nbnds)) - allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) - allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) - allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) - allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) + allocate(gas_namesLW(nabsorbers)) + allocate(scaling_gas_lowerLW(nminor_absorber_intervals_lower)) + allocate(scaling_gas_upperLW(nminor_absorber_intervals_upper)) + allocate(gas_minorLW(nminorabsorbers)) + allocate(identifier_minorLW(nminorabsorbers)) + allocate(minor_gases_lowerLW(nminor_absorber_intervals_lower)) + allocate(minor_gases_upperLW(nminor_absorber_intervals_upper)) + allocate(minor_limits_gpt_lowerLW(npairs,nminor_absorber_intervals_lower)) + allocate(minor_limits_gpt_upperLW(npairs,nminor_absorber_intervals_upper)) + allocate(band2gptLW(2,nbnds)) + allocate(key_speciesLW(2,nlayers,nbnds)) + allocate(band_limsLW(2,nbnds)) + allocate(press_refLW(npress)) + allocate(temp_refLW(ntemps)) + allocate(vmr_refLW(nlayers, nextrabsorbers, ntemps)) + allocate(kminor_lowerLW(ncontributors_lower, nmixingfracs, ntemps)) + allocate(kmajorLW(ngpts, nmixingfracs, npress+1, ntemps)) + allocate(kminor_start_lowerLW(nminor_absorber_intervals_lower)) + allocate(kminor_upperLW(ncontributors_upper, nmixingfracs, ntemps)) + allocate(kminor_start_upperLW(nminor_absorber_intervals_upper)) + allocate(optimal_angle_fitLW(nfit_coeffs,nbnds)) + allocate(minor_scales_with_density_lowerLW(nminor_absorber_intervals_lower)) + allocate(minor_scales_with_density_upperLW(nminor_absorber_intervals_upper)) + allocate(scale_by_complement_lowerLW(nminor_absorber_intervals_lower)) + allocate(scale_by_complement_upperLW(nminor_absorber_intervals_upper)) allocate(temp1(nminor_absorber_intervals_lower)) allocate(temp2(nminor_absorber_intervals_upper)) allocate(temp3(nminor_absorber_intervals_lower)) allocate(temp4(nminor_absorber_intervals_upper)) - allocate(totplnk(ninternalSourcetemps, nbnds)) - allocate(planck_frac(ngpts, nmixingfracs, npress+1, ntemps)) + allocate(totplnkLW(ninternalSourcetemps, nbnds)) + allocate(planck_fracLW(ngpts, nmixingfracs, npress+1, ntemps)) ! Read in fields from file if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) - status = nf90_get_var( ncid, varID, gas_names) + status = nf90_get_var( ncid, varID, gas_namesLW) status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) - status = nf90_get_var( ncid, varID, scaling_gas_lower) + status = nf90_get_var( ncid, varID, scaling_gas_lowerLW) status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) - status = nf90_get_var( ncid, varID, scaling_gas_upper) + status = nf90_get_var( ncid, varID, scaling_gas_upperLW) status = nf90_inq_varid(ncid, 'gas_minor', varID) - status = nf90_get_var( ncid, varID, gas_minor) + status = nf90_get_var( ncid, varID, gas_minorLW) status = nf90_inq_varid(ncid, 'identifier_minor', varID) - status = nf90_get_var( ncid, varID, identifier_minor) + status = nf90_get_var( ncid, varID, identifier_minorLW) status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) - status = nf90_get_var( ncid, varID, minor_gases_lower) + status = nf90_get_var( ncid, varID, minor_gases_lowerLW) status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) - status = nf90_get_var( ncid, varID, minor_gases_upper) + status = nf90_get_var( ncid, varID, minor_gases_upperLW) status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) - status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) + status = nf90_get_var( ncid, varID, minor_limits_gpt_lowerLW) status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) - status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) + status = nf90_get_var( ncid, varID, minor_limits_gpt_upperLW) status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) - status = nf90_get_var( ncid, varID, band2gpt) + status = nf90_get_var( ncid, varID, band2gptLW) status = nf90_inq_varid(ncid, 'key_species', varID) - status = nf90_get_var( ncid, varID, key_species) + status = nf90_get_var( ncid, varID, key_speciesLW) status = nf90_inq_varid(ncid, 'bnd_limits_wavenumber', varID) - status = nf90_get_var( ncid, varID, band_lims) + status = nf90_get_var( ncid, varID, band_limsLW) status = nf90_inq_varid(ncid, 'press_ref', varID) - status = nf90_get_var( ncid, varID, press_ref) + status = nf90_get_var( ncid, varID, press_refLW) status = nf90_inq_varid(ncid, 'temp_ref', varID) - status = nf90_get_var( ncid, varID, temp_ref) + status = nf90_get_var( ncid, varID, temp_refLW) status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) - status = nf90_get_var( ncid, varID, temp_ref_p) + status = nf90_get_var( ncid, varID, temp_ref_pLW) status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) - status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_get_var( ncid, varID, temp_ref_tLW) status = nf90_inq_varid(ncid, 'press_ref_trop', varID) - status = nf90_get_var( ncid, varID, press_ref_trop) + status = nf90_get_var( ncid, varID, press_ref_tropLW) status = nf90_inq_varid(ncid, 'kminor_lower', varID) - status = nf90_get_var( ncid, varID, kminor_lower) + status = nf90_get_var( ncid, varID, kminor_lowerLW) status = nf90_inq_varid(ncid, 'kminor_upper', varID) - status = nf90_get_var( ncid, varID, kminor_upper) + status = nf90_get_var( ncid, varID, kminor_upperLW) status = nf90_inq_varid(ncid, 'vmr_ref', varID) - status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_get_var( ncid, varID, vmr_refLW) status = nf90_inq_varid(ncid, 'optimal_angle_fit',varID) - status = nf90_get_var( ncid, varID, optimal_angle_fit) + status = nf90_get_var( ncid, varID, optimal_angle_fitLW) status = nf90_inq_varid(ncid, 'kmajor', varID) - status = nf90_get_var( ncid, varID, kmajor) + status = nf90_get_var( ncid, varID, kmajorLW) status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) - status = nf90_get_var( ncid, varID, kminor_start_lower) + status = nf90_get_var( ncid, varID, kminor_start_lowerLW) status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) - status = nf90_get_var( ncid, varID, kminor_start_upper) + status = nf90_get_var( ncid, varID, kminor_start_upperLW) status = nf90_inq_varid(ncid, 'totplnk', varID) - status = nf90_get_var( ncid, varID, totplnk) + status = nf90_get_var( ncid, varID, totplnkLW) status = nf90_inq_varid(ncid, 'plank_fraction', varID) - status = nf90_get_var( ncid, varID, planck_frac) - + status = nf90_get_var( ncid, varID, planck_fracLW) + ! Logical fields are read in as integers and then converted to logicals. - status = nf90_inq_varid(ncid, 'minor_scales_with_density_lower', varID) + status = nf90_inq_varid(ncid,'minor_scales_with_density_lower', varID) status = nf90_get_var( ncid, varID,temp1) - minor_scales_with_density_lower(:) = .false. - where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. - status = nf90_inq_varid(ncid, 'minor_scales_with_density_upper', varID) + status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varID) status = nf90_get_var( ncid, varID,temp2) - minor_scales_with_density_upper(:) = .false. - where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. - status = nf90_inq_varid(ncid, 'scale_by_complement_lower', varID) + status = nf90_inq_varid(ncid,'scale_by_complement_lower', varID) status = nf90_get_var( ncid, varID,temp3) - scale_by_complement_lower(:) = .false. - where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. - status = nf90_inq_varid(ncid, 'scale_by_complement_upper', varID) + status = nf90_inq_varid(ncid,'scale_by_complement_upper', varID) status = nf90_get_var( ncid, varID,temp4) - scale_by_complement_upper(:) = .false. - where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. - - ! Close file - status = nf90_close(ncid) + status = nf90_close(ncid) + + do ii=1,nminor_absorber_intervals_lower + if (temp1(ii) .eq. 0) minor_scales_with_density_lowerLW(ii) = .false. + if (temp1(ii) .eq. 1) minor_scales_with_density_lowerLW(ii) = .true. + if (temp3(ii) .eq. 0) scale_by_complement_lowerLW(ii) = .false. + if (temp3(ii) .eq. 1) scale_by_complement_lowerLW(ii) = .true. + enddo + do ii=1,nminor_absorber_intervals_upper + if (temp2(ii) .eq. 0) minor_scales_with_density_upperLW(ii) = .false. + if (temp2(ii) .eq. 1) minor_scales_with_density_upperLW(ii) = .true. + if (temp4(ii) .eq. 0) scale_by_complement_upperLW(ii) = .false. + if (temp4(ii) .eq. 1) scale_by_complement_upperLW(ii) = .true. + enddo ! endif - ! Initialize gas concentrations and gas optics class - call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) - call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, & - key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & - temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & - minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & - minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & - scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, totplnk, planck_frac, rayl_lower, rayl_upper, & - optimal_angle_fit)) + ! + ! Initialize RRTMGP DDT's... + ! +!$omp critical (load_lw_gas_optics) + ! Longwave k-distribution data. + call check_error_msg('rrtmgp_lw_gas_optics_init',lw_gas_props%load(gas_concentrations, & + gas_namesLW, key_speciesLW, band2gptLW, band_limsLW, press_refLW, press_ref_tropLW,& + temp_refLW, temp_ref_pLW, temp_ref_tLW, vmr_refLW, kmajorLW, kminor_lowerLW, & + kminor_upperLW, gas_minorLW, identifier_minorLW, minor_gases_lowerLW, & + minor_gases_upperLW, minor_limits_gpt_lowerLW, minor_limits_gpt_upperLW, & + minor_scales_with_density_lowerLW, minor_scales_with_density_upperLW, & + scaling_gas_lowerLW, scaling_gas_upperLW, scale_by_complement_lowerLW, & + scale_by_complement_upperLW, kminor_start_lowerLW, kminor_start_upperLW, totplnkLW,& + planck_fracLW, rayl_lowerLW, rayl_upperLW, optimal_angle_fitLW)) +!$omp end critical (load_lw_gas_optics) + + ! The minimum pressure allowed in GP RTE calculations. Used to bound uppermost layer + ! temperature (GFS_rrtmgp_pre.F90) + minGPpres = lw_gas_props%get_press_min() end subroutine rrtmgp_lw_gas_optics_init @@ -281,7 +289,7 @@ end subroutine rrtmgp_lw_gas_optics_init !! \section arg_table_rrtmgp_lw_gas_optics_run !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! - subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_lev, t_lay,& + subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay,& t_lev, tsfg, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) ! Inputs @@ -290,8 +298,6 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ integer,intent(in) :: & ncol, & ! Number of horizontal points nLev ! Number of vertical levels - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: real(kind_phys), dimension(ncol,nLev), intent(in) :: & p_lay, & ! Pressure @ model layer-centers (hPa) t_lay ! Temperature (K) @@ -319,9 +325,10 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_ if (.not. doLWrad) return - ! Allocate and initialize - call check_error_msg('rrtmgp_lw_gas_optics_run',lw_optical_props_clrsky%alloc_1scl(ncol, nLev, lw_gas_props)) - call check_error_msg('rrtmgp_lw_gas_optics_run',sources%alloc(ncol, nLev, lw_gas_props)) + call check_error_msg('rrtmgp_lw_gas_optics_run',& + lw_optical_props_clrsky%alloc_1scl(ncol, nLev, lw_gas_props)) + call check_error_msg('rrtmgp_lw_gas_optics_run',& + sources%alloc(ncol, nLev, lw_gas_props)) ! Gas-optics call check_error_msg('rrtmgp_lw_gas_optics_run',lw_gas_props%gas_optics(& diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 3eab78be2..f256858d9 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -26,21 +26,28 @@ intent = in optional = F kind = len=128 -[rrtmgp_nGases] - standard_name = number_of_active_gases_used_by_RRTMGP - long_name = number of gases available used by RRTMGP +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension units = count - dimensions = () + dimensions = () type = integer intent = in optional = F -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer intent = in optional = F [mpirank] @@ -84,12 +91,13 @@ type = integer intent = out optional = F -[lw_gas_props] - standard_name = coefficients_for_lw_gas_optics - long_name = DDT containing spectral information for RRTMGP LW radiation scheme - units = DDT +[minGPpres] + standard_name = minimum_pressure_in_RRTMGP + long_name = minimum pressure allowed in RRTMGP + units = Pa dimensions = () - type = ty_gas_optics_rrtmgp + type = real + kind = kind_phys intent = out optional = F @@ -121,14 +129,6 @@ type = integer 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 - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [p_lay] standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure layer diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 358e49bee..907230180 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -5,6 +5,7 @@ module rrtmgp_lw_pre setemis ! Routine to compute surface-emissivity use mo_gas_optics_rrtmgp, only: & ty_gas_optics_rrtmgp + use rrtmgp_lw_gas_optics, only: lw_gas_props implicit none @@ -25,7 +26,7 @@ end subroutine rrtmgp_lw_pre_init !! \htmlinclude rrtmgp_lw_pre_run.html !! subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & - tsfg, tsfa, hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) + tsfg, tsfa, hprime, sfc_emiss_byband, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -42,8 +43,6 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc tsfg, & ! Surface ground temperature for radiation (K) tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for LW calculation ! Outputs real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 1f329dd8d..af287b2f7 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -104,14 +104,6 @@ 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 - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [semis] standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 321214a02..b654a0657 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -10,7 +10,7 @@ module rrtmgp_lw_rte use mo_fluxes_byband, only: ty_fluxes_byband use mo_source_functions, only: ty_source_func_lw use rrtmgp_aux, only: check_error_msg - + use rrtmgp_lw_gas_optics, only: lw_gas_props implicit none public rrtmgp_lw_rte_init, rrtmgp_lw_rte_run, rrtmgp_lw_rte_finalize @@ -29,7 +29,7 @@ end subroutine rrtmgp_lw_rte_init !! \htmlinclude rrtmgp_lw_rte_run.html !! subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & - nLev, p_lev, lw_gas_props, sfc_emiss_byband, sources, lw_optical_props_clrsky, & + nLev, p_lev, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, sfculw_jac, errmsg, errflg) @@ -45,8 +45,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nGauss_angles ! Number of angles used in Gaussian quadrature real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & p_lev ! Pressure @ model layer-interfaces (hPa) - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: longwave spectral information real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & sfc_emiss_byband ! Surface emissivity in each band type(ty_source_func_lw),intent(in) :: & diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index d295fa511..4d68ec4b6 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -82,14 +82,6 @@ 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 - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [lw_optical_props_clrsky] standard_name = longwave_optical_properties_for_clear_sky long_name = Fortran DDT containing RRTMGP optical properties diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index 4bb034279..fb9306b99 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -3,6 +3,8 @@ module rrtmgp_sw_aerosol_optics use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str use rrtmgp_aux, only: check_error_msg + use rrtmgp_sw_gas_optics, only: sw_gas_props + use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) @@ -30,7 +32,7 @@ end subroutine rrtmgp_sw_aerosol_optics_init !! subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer, nDay, & idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - lw_gas_props, sw_gas_props, aerodp, sw_optical_props_aerosol, errmsg, errflg ) + aerodp, sw_optical_props_aerosol, errmsg, errflg ) ! Inputs logical, intent(in) :: & @@ -58,10 +60,6 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer aerfld ! aerosol input concentrations real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & p_lev ! Pressure @ layer-interfaces (Pa) - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: spectral information for SW calculation - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for LW calculation ! Outputs real(kind_phys), dimension(nCol,NSPC1), intent(inout) :: & diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 0ad7008c0..a8405d2a7 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -153,22 +153,6 @@ 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 - units = DDT - dimensions = () - intent = in - type = ty_gas_optics_rrtmgp - optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [aerodp] standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles long_name = vertical integrated optical depth for various aerosol species diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index f08cd7181..611cb44c2 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -2,9 +2,9 @@ module rrtmgp_sw_cloud_optics use machine, only: kind_phys use mo_rte_kind, only: wl use mo_cloud_optics, only: ty_cloud_optics - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics + use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_aux, only: check_error_msg use netcdf @@ -12,6 +12,41 @@ module rrtmgp_sw_cloud_optics public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize + type(ty_cloud_optics) :: sw_cloud_props + real(kind_phys) :: & + radliq_facSW, & ! Factor for calculating LUT interpolation indices for liquid + radice_facSW ! Factor for calculating LUT interpolation indices for ice + real(kind_phys), dimension(:,:), allocatable :: & + lut_extliqSW, & ! LUT shortwave liquid extinction coefficient + lut_ssaliqSW, & ! LUT shortwave liquid single scattering albedo + lut_asyliqSW, & ! LUT shortwave liquid asymmetry parameter + band_limsCLDSW ! Beginning and ending wavenumber [cm -1] for each band + real(kind_phys), dimension(:,:,:), allocatable :: & + lut_exticeSW, & ! LUT shortwave ice extinction coefficient + lut_ssaiceSW, & ! LUT shortwave ice single scattering albedo + lut_asyiceSW ! LUT shortwave ice asymmetry parameter + real(kind_phys), dimension(:), allocatable :: & + pade_sizereg_extliqSW, & ! Particle size regime boundaries for shortwave liquid extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaliqSW, & ! Particle size regime boundaries for shortwave liquid single + ! scattering albedo for Pade interpolation + pade_sizereg_asyliqSW, & ! Particle size regime boundaries for shortwave liquid asymmetry + ! parameter for Pade interpolation + pade_sizereg_exticeSW, & ! Particle size regime boundaries for shortwave ice extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaiceSW, & ! Particle size regime boundaries for shortwave ice single + ! scattering albedo for Pade interpolation + pade_sizereg_asyiceSW ! Particle size regime boundaries for shortwave ice asymmetry + ! parameter for Pade interpolation + real(kind_phys), dimension(:,:,:), allocatable :: & + pade_extliqSW, & ! PADE coefficients for shortwave liquid extinction + pade_ssaliqSW, & ! PADE coefficients for shortwave liquid single scattering albedo + pade_asyliqSW ! PADE coefficients for shortwave liquid asymmetry parameter + real(kind_phys), dimension(:,:,:,:), allocatable :: & + pade_exticeSW, & ! PADE coefficients for shortwave ice extinction + pade_ssaiceSW, & ! PADE coefficients for shortwave ice single scattering albedo + pade_asyiceSW ! PADE coefficients for shortwave ice asymmetry parameter + ! Parameters used for rain and snow(+groupel) RRTMGP cloud-optics real(kind_phys),parameter :: & a0r = 3.07e-3, & ! @@ -19,10 +54,10 @@ module rrtmgp_sw_cloud_optics a1s = 1.5 ! real(kind_phys),dimension(:),allocatable :: b0r,b0s,b1s,c0r,c0s real(kind_phys) :: & - radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - radliq_upr, & ! Liquid particle size upper bound for LUT interpolation - radice_lwr, & ! Ice particle size upper bound for LUT interpolation - radice_upr ! Ice particle size lower bound for LUT interpolation + radliq_lwrSW, & ! Liquid particle size lower bound for LUT interpolation + radliq_uprSW, & ! Liquid particle size upper bound for LUT interpolation + radice_lwrSW, & ! Ice particle size upper bound for LUT interpolation + radice_uprSW ! Ice particle size lower bound for LUT interpolation contains ! ###################################################################################### @@ -31,9 +66,9 @@ module rrtmgp_sw_cloud_optics !! \section arg_table_rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & + subroutine rrtmgp_sw_cloud_optics_init(nCol, nLev, nbndsGPsw, doG_cldoptics, doGP_cldoptics_PADE, & doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, & - mpirank, mpiroot, sw_cloud_props, errmsg, errflg) + mpirank, mpiroot, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -43,59 +78,22 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, integer, intent(inout) :: & nrghice ! Number of ice-roughness categories integer, intent(in) :: & + nbndsGPsw, & ! Number of bands used in shortwave. mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank + mpiroot, & ! Master MPI rank + nCol, & ! Number of horizontal gridpoints + nLev ! Number of vertical levels character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_sw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties - + ! Outputs - type(ty_cloud_optics),intent(out) :: & - sw_cloud_props ! RRTMGP DDT: shortwave spectral information character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - ! Local variables that will be passed to cloud_optics%load() - real(kind_phys) :: & - !radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation - !radliq_upr, & ! Liquid particle size upper bound for LUT interpolation - radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid - !radice_lwr, & ! Ice particle size upper bound for LUT interpolation - !radice_upr, & ! Ice particle size lower bound for LUT interpolation - radice_fac ! Factor for calculating LUT interpolation indices for ice - real(kind_phys), dimension(:,:), allocatable :: & - lut_extliq, & ! LUT shortwave liquid extinction coefficient - lut_ssaliq, & ! LUT shortwave liquid single scattering albedo - lut_asyliq, & ! LUT shortwave liquid asymmetry parameter - band_lims ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & - lut_extice, & ! LUT shortwave ice extinction coefficient - lut_ssaice, & ! LUT shortwave ice single scattering albedo - lut_asyice ! LUT shortwave ice asymmetry parameter - real(kind_phys), dimension(:), allocatable :: & - pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single - ! scattering albedo for Pade interpolation - pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry - ! parameter for Pade interpolation - pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction - ! coefficient for Pade interpolation - pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single - ! scattering albedo for Pade interpolation - pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry - ! parameter for Pade interpolation - real(kind_phys), dimension(:,:,:), allocatable :: & - pade_extliq, & ! PADE coefficients for shortwave liquid extinction - pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo - pade_asyliq ! PADE coefficients for shortwave liquid asymmetry parameter - real(kind_phys), dimension(:,:,:,:), allocatable :: & - pade_extice, & ! PADE coefficients for shortwave ice extinction - pade_ssaice, & ! PADE coefficients for shortwave ice single scattering albedo - pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter ! Dimensions integer :: & nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizereg,& @@ -140,114 +138,105 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nPairs) - ! Has the number of ice-roughnesses to use been provided from the namelist? - ! If not provided, use default number of ice-roughness categories - if (nrghice .eq. 0) then - nrghice = nrghice_default - else - nrghice = nrghice_fromfile - ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. - if (nrghice .gt. nrghice_fromfile) then - errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' - nrghice = nrghice_default - endif - endif + ! Has the number of ice-roughnesses provided from the namelist? + ! If not, use nrghice from cloud-optics file + if (nrghice .eq. 0) nrghice = nrghice_fromfile ! Allocate space for arrays if (doGP_cldoptics_LUT) then - allocate(lut_extliq(nSize_liq, nBand)) - allocate(lut_ssaliq(nSize_liq, nBand)) - allocate(lut_asyliq(nSize_liq, nBand)) - allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) - allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) - allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_extliqSW(nSize_liq, nBand)) + allocate(lut_ssaliqSW(nSize_liq, nBand)) + allocate(lut_asyliqSW(nSize_liq, nBand)) + allocate(lut_exticeSW(nSize_ice, nBand, nrghice)) + allocate(lut_ssaiceSW(nSize_ice, nBand, nrghice)) + allocate(lut_asyiceSW(nSize_ice, nBand, nrghice)) endif if (doGP_cldoptics_PADE) then - allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) - allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) - allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) - allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) - allocate(pade_sizereg_extliq(nBound)) - allocate(pade_sizereg_ssaliq(nBound)) - allocate(pade_sizereg_asyliq(nBound)) - allocate(pade_sizereg_extice(nBound)) - allocate(pade_sizereg_ssaice(nBound)) - allocate(pade_sizereg_asyice(nBound)) + allocate(pade_extliqSW(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliqSW(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliqSW(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_exticeSW(nBand, nSizeReg, nCoeff_ext, nrghice)) + allocate(pade_ssaiceSW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_asyiceSW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) + allocate(pade_sizereg_extliqSW(nBound)) + allocate(pade_sizereg_ssaliqSW(nBound)) + allocate(pade_sizereg_asyliqSW(nBound)) + allocate(pade_sizereg_exticeSW(nBound)) + allocate(pade_sizereg_ssaiceSW(nBound)) + allocate(pade_sizereg_asyiceSW(nBound)) endif - allocate(band_lims(2,nBand)) + allocate(band_limsCLDSW(2,nBand)) ! Read in fields from file if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_get_var(ncid,varID,radliq_lwrSW) status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_get_var(ncid,varID,radliq_uprSW) status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_get_var(ncid,varID,radliq_facSW) status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_get_var(ncid,varID,radice_lwrSW) status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_get_var(ncid,varID,radice_uprSW) status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_get_var(ncid,varID,radice_facSW) status = nf90_inq_varid(ncid,'lut_extliq',varID) - status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_get_var(ncid,varID,lut_extliqSW) status = nf90_inq_varid(ncid,'lut_ssaliq',varID) - status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_get_var(ncid,varID,lut_ssaliqSW) status = nf90_inq_varid(ncid,'lut_asyliq',varID) - status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_get_var(ncid,varID,lut_asyliqSW) status = nf90_inq_varid(ncid,'lut_extice',varID) - status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_get_var(ncid,varID,lut_exticeSW) status = nf90_inq_varid(ncid,'lut_ssaice',varID) - status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_get_var(ncid,varID,lut_ssaiceSW) status = nf90_inq_varid(ncid,'lut_asyice',varID) - status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_get_var(ncid,varID,lut_asyiceSW) status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_lims) + status = nf90_get_var(ncid,varID,band_limsCLDSW) endif if (doGP_cldoptics_PADE) then write (*,*) 'Reading RRTMGP shortwave cloud data (PADE) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) - status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_get_var(ncid,varID,radliq_lwrSW) status = nf90_inq_varid(ncid,'radliq_upr',varID) - status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_get_var(ncid,varID,radliq_uprSW) status = nf90_inq_varid(ncid,'radliq_fac',varID) - status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_get_var(ncid,varID,radliq_facSW) status = nf90_inq_varid(ncid,'radice_lwr',varID) - status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_get_var(ncid,varID,radice_lwrSW) status = nf90_inq_varid(ncid,'radice_upr',varID) - status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_get_var(ncid,varID,radice_uprSW) status = nf90_inq_varid(ncid,'radice_fac',varID) - status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_get_var(ncid,varID,radice_facSW) status = nf90_inq_varid(ncid,'pade_extliq',varID) - status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_get_var(ncid,varID,pade_extliqSW) status = nf90_inq_varid(ncid,'pade_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_get_var(ncid,varID,pade_ssaliqSW) status = nf90_inq_varid(ncid,'pade_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_get_var(ncid,varID,pade_asyliqSW) status = nf90_inq_varid(ncid,'pade_extice',varID) - status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_get_var(ncid,varID,pade_exticeSW) status = nf90_inq_varid(ncid,'pade_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_get_var(ncid,varID,pade_ssaiceSW) status = nf90_inq_varid(ncid,'pade_asyice',varID) - status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_get_var(ncid,varID,pade_asyiceSW) status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_get_var(ncid,varID,pade_sizereg_extliqSW) status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliqSW) status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliqSW) status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_get_var(ncid,varID,pade_sizereg_exticeSW) status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaiceSW) status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) - status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_get_var(ncid,varID,pade_sizereg_asyiceSW) status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) - status = nf90_get_var(ncid,varID,band_lims) + status = nf90_get_var(ncid,varID,band_limsCLDSW) endif ! Close file @@ -256,19 +245,26 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! Load tables data for RRTMGP cloud-optics if (doGP_cldoptics_LUT) then - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & - radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & - lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) +!$omp critical (load_sw_cloud_props_LUTs) + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_limsCLDSW, & + radliq_lwrSW, radliq_uprSW, radliq_facSW, radice_lwrSW, radice_uprSW, radice_facSW, & + lut_extliqSW, lut_ssaliqSW, lut_asyliqSW, lut_exticeSW, lut_ssaiceSW, lut_asyiceSW)) +!$omp end critical (load_sw_cloud_props_LUTs) endif if (doGP_cldoptics_PADE) then - call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & - pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& - pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & - pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) +!$omp critical (load_sw_cloud_props_PADE_approx) + call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_limsCLDSW, & + pade_extliqSW, pade_ssaliqSW, pade_asyliqSW, pade_exticeSW, pade_ssaiceSW, pade_asyiceSW,& + pade_sizereg_extliqSW, pade_sizereg_ssaliqSW, pade_sizereg_asyliqSW, & + pade_sizereg_exticeSW, pade_sizereg_ssaiceSW, pade_sizereg_asyiceSW)) +!$omp end critical (load_sw_cloud_props_PADE_approx) endif +!$omp critical (load_sw_cloud_props_nrghice) call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) - +!$omp end critical (load_sw_cloud_props_nrghice) + ! Initialize coefficients for rain and snow(+groupel) cloud optics +!$omp critical (load_sw_precip_props) allocate(b0r(sw_cloud_props%get_nband()),b0s(sw_cloud_props%get_nband()), & b1s(sw_cloud_props%get_nband()),c0r(sw_cloud_props%get_nband()), & c0s(sw_cloud_props%get_nband())) @@ -282,7 +278,8 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) - +!$omp end critical (load_sw_precip_props) + end subroutine rrtmgp_sw_cloud_optics_init ! ######################################################################################### @@ -292,9 +289,9 @@ end subroutine rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_sw_cloud_optics.html !! subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nDay, idxday, nrghice, cld_frac,& + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nDay, nbndsGPsw, idxday, nrghice, cld_frac,& cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & - precip_frac, sw_cloud_props, sw_gas_props, sw_optical_props_cloudsByBand, & + precip_frac, sw_optical_props_cloudsByBand, & sw_optical_props_precipByBand, cldtausw, errmsg, errflg) ! Inputs @@ -304,6 +301,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw doGP_cldoptics_PADE, & ! Use RRTMGP cloud-optics: PADE approximation? doGP_cldoptics_LUT ! Use RRTMGP cloud-optics: LUTs? integer, intent(in) :: & + nbndsGPsw, & ! Number of shortwave bands nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels nday, & ! Number of daylit points. @@ -323,11 +321,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw cld_rwp, & ! Cloud rain water path cld_rerain, & ! Cloud rain effective radius precip_frac ! Precipitation fraction by layer - type(ty_cloud_optics),intent(in) :: & - sw_cloud_props ! RRTMGP DDT: shortwave cloud properties - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: shortwave K-distribution data - + ! Outputs character(len=*), intent(out) :: & errmsg ! CCPP error message @@ -343,9 +337,10 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw integer :: iDay, iLay, iBand real(kind_phys) :: tau_rain, tau_snow, ssa_rain, ssa_snow, asy_rain, asy_snow, & tau_prec, asy_prec, ssa_prec, asyw, ssaw, za1, za2 - real(kind_phys), dimension(nday,nLev,sw_gas_props%get_nband()) :: & + real(kind_phys), dimension(nday,nLev,nbndsGPsw) :: & tau_cld, ssa_cld, asy_cld, tau_precip, ssa_precip, asy_precip - + type(ty_optical_props_2str) :: sw_optical_props_cloudsByBand_daylit + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -355,23 +350,19 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw ! Only process sunlit points... if (nDay .gt. 0) then - ! Allocate space for RRTMGP DDTs containing cloud/precipitation radiative properties - ! Cloud optics [nday,nLev,nBands] - call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& - nday, nLev, sw_gas_props%get_band_lims_wavenumber())) - sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - sw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys - sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys - - ! Cloud-precipitation optics [nday,nLev,nBands] - call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_precipByBand%alloc_2str(& - nday, nLev, sw_gas_props%get_band_lims_wavenumber())) - sw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys - sw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys - sw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys - ! Compute cloud/precipitation optics. if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& + nday, nLev, sw_cloud_props%get_band_lims_wavenumber())) + sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys + sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_precipByBand%alloc_2str(& + nday, nLev, sw_cloud_props%get_band_lims_wavenumber())) + sw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys + sw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys + ! RRTMGP cloud-optics. call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& cld_lwp(idxday(1:nday),:), & ! IN - Cloud liquid water path @@ -393,7 +384,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw endif ! Rain/Snow single-scattering albedo and asymmetry (Band dependent) - do iBand=1,sw_cloud_props%get_nband() + do iBand=1,nbndsGPsw ! By species ssa_rain = tau_rain*(1.-b0r(iBand)) asy_rain = ssa_rain*c0r(iBand) @@ -407,27 +398,38 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw ssaw = min(1._kind_phys-0.000001, ssa_prec/tau_prec) za1 = asyw * asyw za2 = ssaw * za1 - sw_optical_props_precipByBand%tau(iDay,iLay,iBand) = (1._kind_phys - za2) * tau_prec - sw_optical_props_precipByBand%ssa(iDay,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) - sw_optical_props_precipByBand%g(iDay,iLay,iBand) = asyw/(1+asyw) + sw_optical_props_precipByBand%tau(idxday(iDay),iLay,iBand) = (1._kind_phys - za2) * tau_prec + sw_optical_props_precipByBand%ssa(idxday(iDay),iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + sw_optical_props_precipByBand%g(idxday(iDay),iLay,iBand) = asyw/(1+asyw) enddo endif enddo enddo endif if (doG_cldoptics) then + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& + nday, nLev, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%ssa(:,:,:) = 1._kind_phys + sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_precipByBand%alloc_2str(& + nday, nLev, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_precipByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_precipByBand%ssa(:,:,:) = 1._kind_phys + sw_optical_props_precipByBand%g(:,:,:) = 0._kind_phys + ! RRTMG cloud(+precipitation) optics if (any(cld_frac .gt. 0)) then - call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & - cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & - cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & - cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & - cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & - cld_frac(idxday(1:nday),:), icliq_sw, icice_sw, & - tau_cld, ssa_cld, asy_cld, & + call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & + cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & + cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & + cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & + cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & + cld_frac(idxday(1:nday),:), icliq_sw, icice_sw, & + tau_cld, ssa_cld, asy_cld, & tau_precip, ssa_precip, asy_precip) - - ! Cloud-optics (Need to reorder from G->GP band conventions) + + ! Cloud-optics (Need to reorder from G->GP band conventions) sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) @@ -441,6 +443,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw sw_optical_props_precipByBand%tau(:,:,2:sw_gas_props%get_nband()) = tau_precip(:,:,1:sw_gas_props%get_nband()-1) sw_optical_props_precipByBand%ssa(:,:,2:sw_gas_props%get_nband()) = ssa_precip(:,:,1:sw_gas_props%get_nband()-1) sw_optical_props_precipByBand%g(:,:,2:sw_gas_props%get_nband()) = asy_precip(:,:,1:sw_gas_props%get_nband()-1) + endif endif diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index 4439a607b..3999f844b 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -7,6 +7,30 @@ [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_init type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nbndsGPsw] + standard_name = number_of_sw_bands_rrtmgp + long_name = number of sw bands used in RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F [doG_cldoptics] standard_name = flag_to_calc_lw_cld_optics_using_RRTMG long_name = logical flag to control cloud optics scheme. @@ -98,15 +122,6 @@ type = integer intent = out optional = F -[sw_cloud_props] - standard_name = coefficients_for_sw_cloud_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_cloud_optics - intent = out - optional = F - ######################################################################## [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_run @@ -273,20 +288,12 @@ kind = kind_phys intent = in optional = F -[sw_cloud_props] - standard_name = coefficients_for_sw_cloud_optics - long_name = DDT containing spectral information for cloudy RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_cloud_optics - intent = in - optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp +[nbndsGPsw] + standard_name = number_of_sw_bands_rrtmgp + long_name = number of sw bands used in RRTMGP + units = count + dimensions = () + type = integer intent = in optional = F [nday] diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index e74ceb4e5..b969c50a9 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -5,6 +5,7 @@ module rrtmgp_sw_cloud_sampling use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat use rrtmgp_aux, only: check_error_msg + use rrtmgp_sw_gas_optics, only: sw_gas_props use netcdf implicit none @@ -16,10 +17,8 @@ module rrtmgp_sw_cloud_sampling !! \section arg_table_rrtmgp_sw_cloud_sampling_init !! \htmlinclude rrtmgp_sw_cloud_sampling.html !! - subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0, errmsg, errflg) - ! Inputs - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: K-distribution data + subroutine rrtmgp_sw_cloud_sampling_init(ipsdsw0, errmsg, errflg) + ! Outputs integer, intent(out) :: & ipsdsw0 ! Initial permutation seed for McICA @@ -46,7 +45,7 @@ end subroutine rrtmgp_sw_cloud_sampling_init subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, iovr, & iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_sw, & icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & - sw_gas_props, sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & + sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) ! Inputs @@ -78,8 +77,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxd real(kind_phys), dimension(ncol,nLev), intent(in) :: & cloud_overlap_param, & ! Cloud overlap parameter precip_overlap_param ! Precipitation overlap parameter - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: K-distribution data type(ty_optical_props_2str),intent(in) :: & sw_optical_props_cloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (clouds) sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index 01a311fd4..cda2aaa60 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -7,14 +7,6 @@ [ccpp-arg-table] name = rrtmgp_sw_cloud_sampling_init type = scheme -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [ipsdsw0] standard_name = initial_permutation_seed_sw long_name = initial seed for McICA SW @@ -200,14 +192,6 @@ type = real kind = kind_phys intent = in - optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in optional = F [sw_optical_props_cloudsByBand] standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index ac643e71d..668582d87 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -10,7 +10,57 @@ module rrtmgp_sw_gas_optics use netcdf implicit none - + ! RRTMGP k-distribution LUTs. + type(ty_gas_optics_rrtmgp) :: sw_gas_props + integer, dimension(:), allocatable :: & + kminor_start_lowerSW, & ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upperSW ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_upper\" (upper atmosphere) + integer, dimension(:,:), allocatable :: & + band2gptSW, & ! Beginning and ending gpoint for each band + minor_limits_gpt_lowerSW, & ! Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upperSW ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:,:,:), allocatable :: & + key_speciesSW ! Key species pair for each band + real(kind_phys) :: & + press_ref_tropSW, & ! Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_pSW, & ! Standard spectroscopic reference pressure [Pa] + temp_ref_tSW, & ! Standard spectroscopic reference temperature [K] + tsi_defaultSW, & ! + mg_defaultSW, & ! Mean value of Mg2 index over the average solar cycle from the NRLSSI2 model of solar variability + sb_defaultSW ! Mean value of sunspot index over the average solar cycle from the NRLSSI2 model of solar variability + real(kind_phys), dimension(:), allocatable :: & + press_refSW, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_refSW, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + solar_quietSW, & ! Spectrally-dependent quiet sun irradiance from the NRLSSI2 model of solar variability + solar_facularSW, & ! Spectrally-dependent facular term from the NRLSSI2 model of solar variability + solar_sunspotSW ! Spectrally-dependent sunspot term from the NRLSSI2 model of solar variability + real(kind_phys), dimension(:,:), allocatable :: & + band_limsSW ! Beginning and ending wavenumber [cm -1] for each band + real(kind_phys), dimension(:,:,:), allocatable :: & + vmr_refSW, & ! Volume mixing ratios for reference atmosphere + kminor_lowerSW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + kminor_upperSW, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + rayl_lowerSW, & ! Stored coefficients due to rayleigh scattering contribution + rayl_upperSW ! Stored coefficients due to rayleigh scattering contribution + real(kind_phys), dimension(:,:,:,:), allocatable :: & + kmajorSW ! Stored absorption coefficients due to major absorbing gases + character(len=32), dimension(:), allocatable :: & + gas_namesSW, & ! Names of absorbing gases + gas_minorSW, & ! Name of absorbing minor gas + identifier_minorSW, & ! Unique string identifying minor gas + minor_gases_lowerSW, & ! Names of minor absorbing gases in lower atmosphere + minor_gases_upperSW, & ! Names of minor absorbing gases in upper atmosphere + scaling_gas_lowerSW, & ! Absorption also depends on the concentration of this gas + scaling_gas_upperSW ! Absorption also depends on the concentration of this gas + logical(wl), dimension(:), allocatable :: & + minor_scales_with_density_lowerSW, & ! Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upperSW, & ! Density scaling is applied to minor absorption coefficients + scale_by_complement_lowerSW, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upperSW ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) contains ! ######################################################################################### @@ -19,85 +69,32 @@ module rrtmgp_sw_gas_optics !! \section arg_table_rrtmgp_sw_gas_optics_init !! \htmlinclude rrtmgp_sw_gas_optics.html !! - subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_nGases, & - active_gases_array, mpicomm, mpirank, mpiroot, sw_gas_props, errmsg, errflg) + subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, rrtmgp_sw_file_gas, gas_concentrations, & + mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties - integer, intent(in) :: & - rrtmgp_nGases ! Number of trace gases active in RRTMGP - character(len=*),dimension(rrtmgp_nGases), intent(in) :: & - active_gases_array ! Character array containing trace gases to include in RRTMGP integer,intent(in) :: & + nCol, & ! Number of horizontal gridpoints. + nLev, & ! Number of vertical levels. + nThreads, & ! Number of openMP threads mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT containing active trace gases. ! Outputs character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & errflg ! CCPP error code - type(ty_gas_optics_rrtmgp),intent(out) :: & - sw_gas_props ! RRTMGP DDT: shortwave spectral information - ! Variables that will be passed to gas_optics%load() - type(ty_gas_concs) :: & - gas_concentrations - integer, dimension(:), allocatable :: & - kminor_start_lower, & ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_lower\" (lower atmosphere) - kminor_start_upper ! Starting index in the [1, nContributors] vector for a contributor - ! given by \"minor_gases_upper\" (upper atmosphere) - integer, dimension(:,:), allocatable :: & - band2gpt, & ! Beginning and ending gpoint for each band - minor_limits_gpt_lower, & ! Beginning and ending gpoint for each minor interval in lower atmosphere - minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere - integer, dimension(:,:,:), allocatable :: & - key_species ! Key species pair for each band - real(kind_phys) :: & - press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] - temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] - temp_ref_t, & ! Standard spectroscopic reference temperature [K] - tsi_default, & ! - mg_default, & ! - sb_default ! - real(kind_phys), dimension(:), allocatable :: & - press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] - temp_ref, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] - solar_quiet, & ! - solar_facular, & ! - solar_sunspot ! - real(kind_phys), dimension(:,:), allocatable :: & - band_lims ! Beginning and ending wavenumber [cm -1] for each band - real(kind_phys), dimension(:,:,:), allocatable :: & - vmr_ref, & ! Volume mixing ratios for reference atmosphere - kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - kminor_upper, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to - ! [nTemp x nEta x nContributors] array) - rayl_lower, & ! Stored coefficients due to rayleigh scattering contribution - rayl_upper ! Stored coefficients due to rayleigh scattering contribution - real(kind_phys), dimension(:,:,:,:), allocatable :: & - kmajor ! Stored absorption coefficients due to major absorbing gases - character(len=32), dimension(:), allocatable :: & - gas_names, & ! Names of absorbing gases - gas_minor, & ! Name of absorbing minor gas - identifier_minor, & ! Unique string identifying minor gas - minor_gases_lower, & ! Names of minor absorbing gases in lower atmosphere - minor_gases_upper, & ! Names of minor absorbing gases in upper atmosphere - scaling_gas_lower, & ! Absorption also depends on the concentration of this gas - scaling_gas_upper ! Absorption also depends on the concentration of this gas - logical(wl), dimension(:), allocatable :: & - minor_scales_with_density_lower, & ! Density scaling is applied to minor absorption coefficients - minor_scales_with_density_upper, & ! Density scaling is applied to minor absorption coefficients - scale_by_complement_lower, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) - scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) ! Dimensions integer :: & - ntemps, npress, ngpts, nabsorbers, nextrabsorbers, & + ntemps, npress, ngptsSW, nabsorbers, nextrabsorbers, & nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & ncontributors_lower, ncontributors_upper @@ -137,7 +134,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp status = nf90_inq_dimid(ncid, 'bnd', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nbnds) status = nf90_inq_dimid(ncid, 'gpt', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=ngpts) + status = nf90_inquire_dimension(ncid, dimid, len=ngptsSW) status = nf90_inq_dimid(ncid, 'pair', dimid) status = nf90_inquire_dimension(ncid, dimid, len=npairs) status = nf90_inq_dimid(ncid, 'contributors_lower',dimid) @@ -150,138 +147,176 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upper) ! Allocate space for arrays - allocate(gas_names(nabsorbers)) - allocate(scaling_gas_lower(nminor_absorber_intervals_lower)) - allocate(scaling_gas_upper(nminor_absorber_intervals_upper)) - allocate(gas_minor(nminorabsorbers)) - allocate(identifier_minor(nminorabsorbers)) - allocate(minor_gases_lower(nminor_absorber_intervals_lower)) - allocate(minor_gases_upper(nminor_absorber_intervals_upper)) - allocate(minor_limits_gpt_lower(npairs,nminor_absorber_intervals_lower)) - allocate(minor_limits_gpt_upper(npairs,nminor_absorber_intervals_upper)) - allocate(band2gpt(2,nbnds)) - allocate(key_species(2,nlayers,nbnds)) - allocate(band_lims(2,nbnds)) - allocate(press_ref(npress)) - allocate(temp_ref(ntemps)) - allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) - allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) - allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) - allocate(kminor_start_lower(nminor_absorber_intervals_lower)) - allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) - allocate(kminor_start_upper(nminor_absorber_intervals_upper)) - allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) - allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) - allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) - allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) - allocate(rayl_upper(ngpts, nmixingfracs, ntemps)) - allocate(rayl_lower(ngpts, nmixingfracs, ntemps)) - allocate(solar_quiet(ngpts)) - allocate(solar_facular(ngpts)) - allocate(solar_sunspot(ngpts)) - allocate(temp1(nminor_absorber_intervals_lower)) - allocate(temp2(nminor_absorber_intervals_upper)) - allocate(temp3(nminor_absorber_intervals_lower)) - allocate(temp4(nminor_absorber_intervals_upper)) + if (.not. allocated(gas_namesSW)) & + allocate(gas_namesSW(nabsorbers)) + if (.not. allocated(scaling_gas_lowerSW)) & + allocate(scaling_gas_lowerSW(nminor_absorber_intervals_lower)) + if (.not. allocated(scaling_gas_upperSW)) & + allocate(scaling_gas_upperSW(nminor_absorber_intervals_upper)) + if (.not. allocated(gas_minorSW)) & + allocate(gas_minorSW(nminorabsorbers)) + if (.not. allocated(identifier_minorSW)) & + allocate(identifier_minorSW(nminorabsorbers)) + if (.not. allocated(minor_gases_lowerSW)) & + allocate(minor_gases_lowerSW(nminor_absorber_intervals_lower)) + if (.not. allocated(minor_gases_upperSW)) & + allocate(minor_gases_upperSW(nminor_absorber_intervals_upper)) + if (.not. allocated(minor_limits_gpt_lowerSW)) & + allocate(minor_limits_gpt_lowerSW(npairs,nminor_absorber_intervals_lower)) + if (.not. allocated(minor_limits_gpt_upperSW)) & + allocate(minor_limits_gpt_upperSW(npairs,nminor_absorber_intervals_upper)) + if (.not. allocated(band2gptSW)) & + allocate(band2gptSW(2,nbnds)) + if (.not. allocated(key_speciesSW)) & + allocate(key_speciesSW(2,nlayers,nbnds)) + if (.not. allocated(band_limsSW)) & + allocate(band_limsSW(2,nbnds)) + if (.not. allocated(press_refSW)) & + allocate(press_refSW(npress)) + if (.not. allocated(temp_refSW)) & + allocate(temp_refSW(ntemps)) + if (.not. allocated(vmr_refSW)) & + allocate(vmr_refSW(nlayers, nextrabsorbers, ntemps)) + if (.not. allocated(kminor_lowerSW)) & + allocate(kminor_lowerSW(ncontributors_lower, nmixingfracs, ntemps)) + if (.not. allocated(kmajorSW)) & + allocate(kmajorSW(ngptsSW, nmixingfracs, npress+1, ntemps)) + if (.not. allocated(kminor_start_lowerSW)) & + allocate(kminor_start_lowerSW(nminor_absorber_intervals_lower)) + if (.not. allocated(kminor_upperSW)) & + allocate(kminor_upperSW(ncontributors_upper, nmixingfracs, ntemps)) + if (.not. allocated(kminor_start_upperSW)) & + allocate(kminor_start_upperSW(nminor_absorber_intervals_upper)) + if (.not. allocated(minor_scales_with_density_lowerSW)) & + allocate(minor_scales_with_density_lowerSW(nminor_absorber_intervals_lower)) + if (.not. allocated(minor_scales_with_density_upperSW)) & + allocate(minor_scales_with_density_upperSW(nminor_absorber_intervals_upper)) + if (.not. allocated(scale_by_complement_lowerSW)) & + allocate(scale_by_complement_lowerSW(nminor_absorber_intervals_lower)) + if (.not. allocated(scale_by_complement_upperSW)) & + allocate(scale_by_complement_upperSW(nminor_absorber_intervals_upper)) + if (.not. allocated(rayl_upperSW)) & + allocate(rayl_upperSW(ngptsSW, nmixingfracs, ntemps)) + if (.not. allocated(rayl_lowerSW)) & + allocate(rayl_lowerSW(ngptsSW, nmixingfracs, ntemps)) + if (.not. allocated(solar_quietSW)) & + allocate(solar_quietSW(ngptsSW)) + if (.not. allocated(solar_facularSW)) & + allocate(solar_facularSW(ngptsSW)) + if (.not. allocated(solar_sunspotSW)) & + allocate(solar_sunspotSW(ngptsSW)) + if (.not. allocated(temp1)) & + allocate(temp1(nminor_absorber_intervals_lower)) + if (.not. allocated(temp2)) & + allocate(temp2(nminor_absorber_intervals_upper)) + if (.not. allocated(temp3)) & + allocate(temp3(nminor_absorber_intervals_lower)) + if (.not. allocated(temp4)) & + allocate(temp4(nminor_absorber_intervals_upper)) ! Read in fields from file if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) - status = nf90_get_var( ncid, varID, gas_names) + status = nf90_get_var( ncid, varID, gas_namesSW) status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) - status = nf90_get_var( ncid, varID, scaling_gas_lower) + status = nf90_get_var( ncid, varID, scaling_gas_lowerSW) status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) - status = nf90_get_var( ncid, varID, scaling_gas_upper) + status = nf90_get_var( ncid, varID, scaling_gas_upperSW) status = nf90_inq_varid(ncid, 'gas_minor', varID) - status = nf90_get_var( ncid, varID, gas_minor) + status = nf90_get_var( ncid, varID, gas_minorSW) status = nf90_inq_varid(ncid, 'identifier_minor', varID) - status = nf90_get_var( ncid, varID, identifier_minor) + status = nf90_get_var( ncid, varID, identifier_minorSW) status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) - status = nf90_get_var( ncid, varID, minor_gases_lower) + status = nf90_get_var( ncid, varID, minor_gases_lowerSW) status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) - status = nf90_get_var( ncid, varID, minor_gases_upper) + status = nf90_get_var( ncid, varID, minor_gases_upperSW) status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) - status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) + status = nf90_get_var( ncid, varID, minor_limits_gpt_lowerSW) status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) - status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) + status = nf90_get_var( ncid, varID, minor_limits_gpt_upperSW) status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) - status = nf90_get_var( ncid, varID, band2gpt) + status = nf90_get_var( ncid, varID, band2gptSW) status = nf90_inq_varid(ncid, 'key_species', varID) - status = nf90_get_var( ncid, varID, key_species) + status = nf90_get_var( ncid, varID, key_speciesSW) status = nf90_inq_varid(ncid,'bnd_limits_wavenumber', varID) - status = nf90_get_var( ncid, varID, band_lims) + status = nf90_get_var( ncid, varID, band_limsSW) status = nf90_inq_varid(ncid, 'press_ref', varID) - status = nf90_get_var( ncid, varID, press_ref) + status = nf90_get_var( ncid, varID, press_refSW) status = nf90_inq_varid(ncid, 'temp_ref', varID) - status = nf90_get_var( ncid, varID, temp_ref) + status = nf90_get_var( ncid, varID, temp_refSW) status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) - status = nf90_get_var( ncid, varID, temp_ref_p) + status = nf90_get_var( ncid, varID, temp_ref_pSW) status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) - status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_get_var( ncid, varID, temp_ref_tSW) status = nf90_inq_varid(ncid, 'tsi_default', varID) - status = nf90_get_var( ncid, varID, tsi_default) + status = nf90_get_var( ncid, varID, tsi_defaultSW) status = nf90_inq_varid(ncid, 'mg_default', varID) - status = nf90_get_var( ncid, varID, mg_default) + status = nf90_get_var( ncid, varID, mg_defaultSW) status = nf90_inq_varid(ncid, 'sb_default', varID) - status = nf90_get_var( ncid, varID, sb_default) + status = nf90_get_var( ncid, varID, sb_defaultSW) status = nf90_inq_varid(ncid, 'press_ref_trop', varID) - status = nf90_get_var( ncid, varID, press_ref_trop) + status = nf90_get_var( ncid, varID, press_ref_tropSW) status = nf90_inq_varid(ncid, 'kminor_lower', varID) - status = nf90_get_var( ncid, varID, kminor_lower) + status = nf90_get_var( ncid, varID, kminor_lowerSW) status = nf90_inq_varid(ncid, 'kminor_upper', varID) - status = nf90_get_var( ncid, varID, kminor_upper) + status = nf90_get_var( ncid, varID, kminor_upperSW) status = nf90_inq_varid(ncid, 'vmr_ref', varID) - status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_get_var( ncid, varID, vmr_refSW) status = nf90_inq_varid(ncid, 'kmajor', varID) - status = nf90_get_var( ncid, varID, kmajor) + status = nf90_get_var( ncid, varID, kmajorSW) status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) - status = nf90_get_var( ncid, varID, kminor_start_lower) + status = nf90_get_var( ncid, varID, kminor_start_lowerSW) status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) - status = nf90_get_var( ncid, varID, kminor_start_upper) + status = nf90_get_var( ncid, varID, kminor_start_upperSW) status = nf90_inq_varid(ncid, 'solar_source_quiet', varID) - status = nf90_get_var( ncid, varID, solar_quiet) + status = nf90_get_var( ncid, varID, solar_quietSW) status = nf90_inq_varid(ncid, 'solar_source_facular', varID) - status = nf90_get_var( ncid, varID, solar_facular) + status = nf90_get_var( ncid, varID, solar_facularSW) status = nf90_inq_varid(ncid, 'solar_source_sunspot', varID) - status = nf90_get_var( ncid, varID, solar_sunspot) + status = nf90_get_var( ncid, varID, solar_sunspotSW) status = nf90_inq_varid(ncid, 'rayl_lower', varID) - status = nf90_get_var( ncid, varID, rayl_lower) + status = nf90_get_var( ncid, varID, rayl_lowerSW) status = nf90_inq_varid(ncid, 'rayl_upper', varID) - status = nf90_get_var( ncid, varID, rayl_upper) + status = nf90_get_var( ncid, varID, rayl_upperSW) ! Logical fields are read in as integers and then converted to logicals. status = nf90_inq_varid(ncid,'minor_scales_with_density_lower', varID) status = nf90_get_var( ncid, varID,temp1) - minor_scales_with_density_lower(:) = .false. - where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. + minor_scales_with_density_lowerSW(:) = .false. + where(temp1 .eq. 1) minor_scales_with_density_lowerSW(:) = .true. status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varID) status = nf90_get_var( ncid, varID,temp2) - minor_scales_with_density_upper(:) = .false. - where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. + minor_scales_with_density_upperSW(:) = .false. + where(temp2 .eq. 1) minor_scales_with_density_upperSW(:) = .true. status = nf90_inq_varid(ncid,'scale_by_complement_lower', varID) status = nf90_get_var( ncid, varID,temp3) - scale_by_complement_lower(:) = .false. - where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. + scale_by_complement_lowerSW(:) = .false. + where(temp3 .eq. 1) scale_by_complement_lowerSW(:) = .true. status = nf90_inq_varid(ncid,'scale_by_complement_upper', varID) status = nf90_get_var( ncid, varID,temp4) - scale_by_complement_upper(:) = .false. - where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. + scale_by_complement_upperSW(:) = .false. + where(temp4 .eq. 1) scale_by_complement_upperSW(:) = .true. ! Close status = nf90_close(ncid) ! endif - - ! Initialize gas concentrations and gas optics class - call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) - call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names, & - key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & - temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & - minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower,minor_limits_gpt_upper, & - minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & - scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & - kminor_start_lower, kminor_start_upper, solar_quiet, solar_facular, solar_sunspot, & - tsi_default, mg_default, sb_default, rayl_lower, rayl_upper)) + ! + ! Initialize RRTMGP DDT's... + ! + ! Shortwave k-distribution data +!$omp critical (load_sw_gas_optics) + call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, & + gas_namesSW, key_speciesSW, band2gptSW, band_limsSW, press_refSW, press_ref_tropSW,& + temp_refSW, temp_ref_pSW, temp_ref_tSW, vmr_refSW, kmajorSW, kminor_lowerSW, & + kminor_upperSW, gas_minorSW, identifier_minorSW, minor_gases_lowerSW, & + minor_gases_upperSW, minor_limits_gpt_lowerSW, minor_limits_gpt_upperSW, & + minor_scales_with_density_lowerSW, minor_scales_with_density_upperSW, & + scaling_gas_lowerSW, scaling_gas_upperSW, scale_by_complement_lowerSW, & + scale_by_complement_upperSW, kminor_start_lowerSW, kminor_start_upperSW, & + solar_quietSW, solar_facularSW, solar_sunspotSW, tsi_defaultSW, mg_defaultSW, & + sb_defaultSW, rayl_lowerSW, rayl_upperSW)) +!$omp end critical (load_sw_gas_optics) end subroutine rrtmgp_sw_gas_optics_init @@ -291,21 +326,20 @@ end subroutine rrtmgp_sw_gas_optics_init !! \section arg_table_rrtmgp_sw_gas_optics_run !! \htmlinclude rrtmgp_sw_gas_optics.html !! - subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_props, p_lay,& - p_lev, toa_src_sw, t_lay, t_lev, gas_concentrations, solcon, rrtmgp_nGases, & - active_gases_array, sw_optical_props_clrsky, errmsg, errflg) + subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, ngptsGPsw, nday, idxday, p_lay, & + p_lev, toa_src_sw, t_lay, t_lev, gas_concentrations, solcon, sw_optical_props_clrsky,& + errmsg, errflg) ! Inputs logical, intent(in) :: & doSWrad ! Flag to calculate SW irradiances integer,intent(in) :: & + ngptsGPsw, & ! Number of spectral (g) points. nDay, & ! Number of daylit points. nCol, & ! Number of horizontal points nLev ! Number of vertical levels integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: spectral information for RRTMGP SW radiation scheme real(kind_phys), dimension(ncol,nLev), intent(in) :: & p_lay, & ! Pressure @ model layer-centers (hPa) t_lay ! Temperature (K) @@ -316,10 +350,6 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_pr gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) real(kind_phys), intent(in) :: & solcon ! Solar constant - integer, intent(in) :: & - rrtmgp_nGases ! Number of trace gases active in RRTMGP - character(len=*),dimension(rrtmgp_nGases), intent(in) :: & - active_gases_array ! Character array containing trace gases to include in RRTMGP ! Output character(len=*), intent(out) :: & @@ -328,15 +358,14 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_pr errflg ! CCPP error code type(ty_optical_props_2str),intent(out) :: & sw_optical_props_clrsky ! RRTMGP DDT: clear-sky shortwave optical properties, spectral (tau,ssa,g) - real(kind_phys), dimension(ncol,sw_gas_props%get_ngpt()), intent(out) :: & + real(kind_phys), dimension(nCol,ngptsGPsw), intent(out) :: & toa_src_sw ! TOA incident spectral flux (W/m2) - + character(len=32), dimension(gas_concentrations%get_num_gases()) :: active_gases ! Local variables integer :: ij,iGas real(kind_phys), dimension(ncol,nLev) :: vmrTemp - real(kind_phys), dimension(nday,sw_gas_props%get_ngpt()) :: toa_src_sw_temp - type(ty_gas_concs) :: & - gas_concentrations_daylit ! RRTMGP DDT: trace gas concentrations (vmr) + real(kind_phys), dimension(nday,ngptsGPsw) :: toa_src_sw_temp + type(ty_gas_concs) :: gas_concentrations_daylit ! Initialize CCPP error handling variables errmsg = '' @@ -344,38 +373,39 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_pr if (.not. doSWrad) return + toa_src_sw(:,:) = 0._kind_phys if (nDay .gt. 0) then + active_gases = gas_concentrations%get_gas_names() ! Allocate space - call check_error_msg('rrtmgp_sw_gas_optics_run',sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) + call check_error_msg('rrtmgp_sw_gas_optics_run_alloc_2str',& + sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) + call check_error_msg('rrtmgp_sw_gas_optics_run_init_ty_gas_concs', & + gas_concentrations_daylit%init(active_gases)) - ! Initialize gas concentrations and gas optics class - call check_error_msg('rrtmgp_sw_rte_run',gas_concentrations_daylit%init(active_gases_array)) - - ! Subset the gas concentrations, only need daylit points. - do iGas=1,rrtmgp_nGases - call check_error_msg('rrtmgp_sw_rte_run',& - gas_concentrations%get_vmr(trim(active_gases_array(iGas)),vmrTemp)) - call check_error_msg('rrtmgp_sw_rte_run',& - gas_concentrations_daylit%set_vmr(trim(active_gases_array(iGas)),vmrTemp(idxday(1:nday),:))) + ! Subset the gas concentrations. + do iGas=1,gas_concentrations%get_num_gases() + call check_error_msg('rrtmgp_sw_gas_optics_run_get_vmr',& + gas_concentrations%get_vmr(trim(active_gases(iGas)),vmrTemp)) + call check_error_msg('rrtmgp_sw_gas_optics_run_set_vmr',& + gas_concentrations_daylit%set_vmr(trim(active_gases(iGas)),vmrTemp(idxday(1:nday),:))) enddo - ! Gas-optics + ! Call SW gas-optics call check_error_msg('rrtmgp_sw_gas_optics_run',sw_gas_props%gas_optics(& - p_lay(idxday(1:nday),:), & ! IN - Pressure @ layer-centers (Pa) - p_lev(idxday(1:nday),:), & ! IN - Pressure @ layer-interfaces (Pa) - t_lay(idxday(1:nday),:), & ! IN - Temperature @ layer-centers (K) - gas_concentrations_daylit, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios - sw_optical_props_clrsky, & ! OUT - RRTMGP DDT: Shortwave optical properties, by - ! spectral point (tau,ssa,g) - toa_src_sw_temp)) ! OUT - TOA incident shortwave radiation (spectral) + p_lay(idxday(1:nday),:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(idxday(1:nday),:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(idxday(1:nday),:), & ! IN - Temperature @ layer-centers (K) + gas_concentrations_daylit, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + sw_optical_props_clrsky, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + ! spectral point (tau,ssa,g) + toa_src_sw_temp)) ! OUT - TOA incident shortwave radiation (spectral) toa_src_sw(idxday(1:nday),:) = toa_src_sw_temp + ! Scale incident flux do ij=1,nday toa_src_sw(idxday(ij),:) = toa_src_sw(idxday(ij),:)*solcon/ & sum(toa_src_sw(idxday(ij),:)) enddo - else - toa_src_sw(:,:) = 0. endif end subroutine rrtmgp_sw_gas_optics_run diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 75bcde0c8..e69b68d73 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -8,6 +8,30 @@ [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init type = scheme +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nThreads] + standard_name = omp_threads + long_name = number of OpenMP threads available to scheme + units = count + dimensions = () + type = integer + intent = in + optional = F [rrtmgp_root_dir] standard_name = directory_for_rte_rrtmgp_source_code long_name = directory for rte+rrtmgp source code @@ -26,21 +50,12 @@ intent = in optional = F kind = len=128 -[rrtmgp_nGases] - standard_name = number_of_active_gases_used_by_RRTMGP - long_name = number of gases available used by RRTMGP - units = count - dimensions = () - type = integer - intent = in - optional = F -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs intent = in optional = F [mpirank] @@ -84,14 +99,6 @@ type = integer intent = out optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = out - optional = F ######################################################################## [ccpp-arg-table] @@ -137,12 +144,12 @@ type = integer intent = in optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp +[ngptsGPsw] + standard_name = number_of_sw_spectral_points_rrtmgp + long_name = number of spectral points in RRTMGP SW calculation + units = count + dimensions = () + type = integer intent = in optional = F [p_lay] @@ -207,23 +214,6 @@ kind = kind_phys intent = in optional = F -[rrtmgp_nGases] - standard_name = number_of_active_gases_used_by_RRTMGP - long_name = number of gases available used by RRTMGP - units = count - dimensions = () - type = integer - intent = in - optional = F -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 9719c6e86..c3bee1829 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -9,7 +9,7 @@ module rrtmgp_sw_rte use mo_fluxes_byband, only: ty_fluxes_byband use module_radsw_parameters, only: cmpfsw_type use rrtmgp_aux, only: check_error_msg - + use rrtmgp_sw_gas_optics, only: sw_gas_props implicit none public rrtmgp_sw_rte_init, rrtmgp_sw_rte_run, rrtmgp_sw_rte_finalize @@ -29,7 +29,7 @@ end subroutine rrtmgp_sw_rte_init !! \htmlinclude rrtmgp_sw_rte.html !! subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, coszen, p_lay, & - t_lay, p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif,& + t_lay, p_lev, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif,& sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, errmsg, errflg) @@ -51,8 +51,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz t_lay ! Temperature (K) real(kind_phys), dimension(ncol,NLev+1), intent(in) :: & p_lev ! Pressure @ model layer-interfaces (Pa) - type(ty_gas_optics_rrtmgp),intent(in) :: & - sw_gas_props ! RRTMGP DDT: SW spectral information type(ty_optical_props_2str),intent(inout) :: & sw_optical_props_clrsky ! RRTMGP DDT: shortwave clear-sky radiative properties type(ty_optical_props_2str),intent(in) :: & diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 43febcd92..f5bf59ade 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -92,14 +92,6 @@ kind = kind_phys intent = in optional = F -[sw_gas_props] - standard_name = coefficients_for_sw_gas_optics - long_name = DDT containing spectral information for RRTMGP SW radiation scheme - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [sw_optical_props_clrsky] standard_name = shortwave_optical_properties_for_clear_sky long_name = Fortran DDT containing RRTMGP optical properties From 0467d63c8baf1f38ae5955e2094ca004df1bccd2 Mon Sep 17 00:00:00 2001 From: Ruiyu Sun Date: Wed, 10 Feb 2021 00:44:36 +0000 Subject: [PATCH 197/274] Fix bugs in the pre-rad to have correct radii and radiation fluxes --- physics/GFS_rrtmg_pre.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 109df3b65..c18396221 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -288,7 +288,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & plyr(i,k1) = prsl(i,k2) * 0.01 ! pa to mb (hpa) tlyr(i,k1) = tgrs(i,k2) prslk1(i,k1) = prslk(i,k2) - rho(i,k1) = plyr(i,k1)/(con_rd*tlyr(i,k1)) + rho(i,k1) = prsl(i,k2)/(con_rd*tlyr(i,k1)) orho(i,k1) = 1.0/rho(i,k1) !> - Compute relative humidity. @@ -774,7 +774,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & !tgs: progclduni has different limits for ice radii (10.0-150.0) than ! calc_effectRad (4.99-125.0 for WRFv3.8.1; 2.49-125.0 for WRFv4+) ! it will raise the low limit from 5 to 10, but the high limit will remain 125. - call calc_effectRad (tlyr(i,:), plyr(i,:), qv_mp(i,:), qc_mp(i,:), & + call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), & nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm ) end do From e354d11f5ff991c60ddadcef5df94e65c2f5c08f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 10 Feb 2021 16:14:02 -0700 Subject: [PATCH 198/274] Update physics/GFS_debug.F90 with additional UGWP changes --- physics/GFS_debug.F90 | 106 ++++++++++++++---------------------------- 1 file changed, 36 insertions(+), 70 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 8f072cae6..cbc65fa79 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -675,6 +675,28 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_h ', Diag%exch_h) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_m ', Diag%exch_m) end if + ! UGWP - incomplete list + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_gw ', Diag%%dudt_gw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_gw ', Diag%%dvdt_gw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtdt_gw ', Diag%%dtdt_gw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%kdis_gw ', Diag%%kdis_gw) + if (Model%do_ugwp_v1 .or. Model%gwd_opt==33 .or. Model%gwd_opt==22) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_ogw ', Diag%dvdt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_obl ', Diag%dudt_obl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_obl ', Diag%dvdt_obl ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_oss ', Diag%dudt_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_oss ', Diag%dvdt_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_ofd ', Diag%dudt_ofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_ofd ', Diag%dvdt_ofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du_ogwcol ', Diag%du_ogwcol) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv_ogwcol ', Diag%dv_ogwcol) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du_oblcol ', Diag%du_oblcol) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv_oblcol ', Diag%dv_oblcol) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du_osscol ', Diag%du_osscol) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv_osscol ', Diag%dv_osscol) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du_ofdcol ', Diag%du_ofdcol) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv_ofdcol ', Diag%dv_ofdcol) + end if ! Statein call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%phii' , Statein%phii) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%prsi' , Statein%prsi) @@ -1233,63 +1255,25 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_land ', Interstitial%zorl_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zorl_ocean ', Interstitial%zorl_ocean ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zt1d ', Interstitial%zt1d ) + ! UGWP + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_oss ', Interstitial%tau_oss ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zngw ', Interstitial%zngw ) + ! UGWP v1 if (Model%do_ugwp_v1) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_gw ', Interstitial%dudt_gw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_gw ', Interstitial%dvdt_gw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdt_gw ', Interstitial%dtdt_gw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kdis_gw ', Interstitial%kdis_gw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ngw ', Interstitial%dudt_ngw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ngw ', Interstitial%dvdt_ngw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdt_ngw ', Interstitial%dtdt_ngw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kdis_ngw ', Interstitial%kdis_ngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ogw ', Interstitial%dvdt_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_obl ', Interstitial%dudt_obl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_obl ', Interstitial%dvdt_obl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_oss ', Interstitial%dudt_oss ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_oss ', Interstitial%dvdt_oss ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ofd ', Interstitial%dudt_ofd ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ofd ', Interstitial%dvdt_ofd ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_oss ', Interstitial%tau_oss ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ogwcol ', Interstitial%du_ogwcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ogwcol ', Interstitial%dv_ogwcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_oblcol ', Interstitial%du_oblcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_oblcol ', Interstitial%dv_oblcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_osscol ', Interstitial%du_osscol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_osscol ', Interstitial%dv_osscol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ofdcol ', Interstitial%du_ofdcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ofdcol ', Interstitial%dv_ofdcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zngw ', Interstitial%zngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) - end if - ! CIRES UGWP v0 - if (Model%do_ugwp_v0 .or. Model%do_gsl_drag_ls_bl .or. Model%do_gsl_drag_ss .or. Model%do_gsl_drag_tofd) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_gw ', Interstitial%dudt_gw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_gw ', Interstitial%dvdt_gw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dtdt_gw ', Interstitial%dtdt_gw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%kdis_gw ', Interstitial%kdis_gw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_tofd ', Interstitial%tau_tofd ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zogw ', Interstitial%zogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) end if !-- GSD drag suite if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & @@ -1299,24 +1283,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%oa4ss ', Interstitial%oa4ss ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%clxss ', Interstitial%clxss ) end if - if (Model%gwd_opt==33 .or. Model%gwd_opt==22) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ogw ', Interstitial%dvdt_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ogwcol ', Interstitial%du_ogwcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ogwcol ', Interstitial%dv_ogwcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_obl ', Interstitial%dudt_obl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_obl ', Interstitial%dvdt_obl ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_oblcol ', Interstitial%du_oblcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_oblcol ', Interstitial%dv_oblcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_oss ', Interstitial%dudt_oss ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_oss ', Interstitial%dvdt_oss ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_osscol ', Interstitial%du_osscol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_osscol ', Interstitial%dv_osscol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ofd ', Interstitial%dudt_ofd ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dvdt_ogw ', Interstitial%dvdt_ogw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%du_ofdcol ', Interstitial%du_ofdcol ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dv_ofdcol ', Interstitial%dv_ofdcol ) - end if ! GFDL and Thompson MP if (Model%imp_physics == Model%imp_physics_gfdl .or. Model%imp_physics == Model%imp_physics_thompson) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%graupelmp ', Interstitial%graupelmp ) From ab9d45b53de63ff854bd40bc3edb784affbd8ce3 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 11 Feb 2021 18:16:33 +0000 Subject: [PATCH 199/274] Working on multiple threads. --- physics/GFS_rrtmgp_pre.F90 | 64 ++++++++++--------------------- physics/GFS_rrtmgp_pre.meta | 8 ---- physics/rrtmgp_lw_gas_optics.F90 | 8 ++-- physics/rrtmgp_lw_gas_optics.meta | 2 +- physics/rrtmgp_sw_gas_optics.F90 | 40 +++++++++++-------- physics/rrtmgp_sw_gas_optics.meta | 2 +- physics/rrtmgp_sw_rte.F90 | 10 ++--- physics/rrtmgp_sw_rte.meta | 17 -------- 8 files changed, 53 insertions(+), 98 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index eb5ae91ce..75e285ac6 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -21,6 +21,8 @@ module GFS_rrtmgp_pre ! Save trace gas indices. integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, & iStr_cfc11, iStr_cfc12, iStr_cfc22 + character(len=32),dimension(:),allocatable :: & + active_gases_array public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize contains @@ -31,25 +33,22 @@ module GFS_rrtmgp_pre !! \section arg_table_GFS_rrtmgp_pre_init !! \htmlinclude GFS_rrtmgp_pre_init.html !! - subroutine GFS_rrtmgp_pre_init(nGases, active_gases, gas_concentrations, errmsg, errflg) + subroutine GFS_rrtmgp_pre_init(nGases, active_gases, errmsg, errflg) ! Inputs integer, intent(in) :: & - nGases ! Number of active gases in RRTMGP + nGases ! Number of active gases in RRTMGP character(len=*), intent(in) :: & active_gases ! List of active gases from namelist. ! Outputs - type(ty_gas_concs),intent(out) :: & - gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios character(len=*), intent(out) :: & - errmsg ! Error message + errmsg ! Error message integer, intent(out) :: & - errflg ! Error flag + errflg ! Error flag ! Local variables character(len=1) :: tempstr integer :: ij, count integer,dimension(nGases,2) :: gasIndices - character(len=32),dimension(nGases) :: active_gases_array ! Initialize errmsg = '' @@ -74,6 +73,7 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, gas_concentrations, errmsg gasIndices(nGases,2)=len(trim(active_gases)) ! Now extract the gas names + allocate(active_gases_array(nGases)) do ij=1,nGases active_gases_array(ij) = active_gases(gasIndices(ij,1):gasIndices(ij,2)) if(trim(active_gases_array(ij)) .eq. 'h2o') istr_h2o = ij @@ -88,22 +88,6 @@ subroutine GFS_rrtmgp_pre_init(nGases, active_gases, gas_concentrations, errmsg if(trim(active_gases_array(ij)) .eq. 'cfc22') istr_cfc22 = ij enddo - ! Initialze RRTMGP DDTs - call check_error_msg('GFS_rrtmgp_pre_init', & - gas_concentrations%init( active_gases_array)) - call check_error_msg('GFS_rrtmgp_pre_setvmr_h2o',& - gas_concentrations%set_vmr(active_gases_array(iStr_o2), 0._kind_phys)) - call check_error_msg('GFS_rrtmgp_pre_setvmr_co2',& - gas_concentrations%set_vmr(active_gases_array(iStr_co2), 0._kind_phys)) - call check_error_msg('GFS_rrtmgp_pre_setvmr_ch4',& - gas_concentrations%set_vmr(active_gases_array(iStr_ch4), 0._kind_phys)) - call check_error_msg('GFS_rrtmgp_pre_setvmr_n2o',& - gas_concentrations%set_vmr(active_gases_array(iStr_n2o), 0._kind_phys)) - call check_error_msg('GFS_rrtmgp_pre_setvmr_h2o',& - gas_concentrations%set_vmr(active_gases_array(iStr_h2o), 0._kind_phys)) - call check_error_msg('GFS_rrtmgp_pre_setvmr_o3', & - gas_concentrations%set_vmr(active_gases_array(iStr_o3), 0._kind_phys)) - end subroutine GFS_rrtmgp_pre_init ! ######################################################################################### @@ -112,11 +96,10 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, & - fhlwr, xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps,& - con_epsm1, con_fvirt, con_epsqs, minGPpres, & - raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer,& - gas_concentrations, errmsg, errflg) + subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & + xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, & + con_epsqs, minGPpres, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, & + tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -299,22 +282,15 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) - ! Initialize and populate RRTMGP DDT w/ gas-concentrations - active_gases = gas_concentrations%get_gas_names() - do iGas=1,gas_concentrations%get_num_gases() - if (iGas .eq. istr_o2) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_o2', & - gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,4))) - if (iGas .eq. istr_co2) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_co2',& - gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,1))) - if (iGas .eq. istr_ch4) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_ch4',& - gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,3))) - if (iGas .eq. istr_n2o) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_n2o',& - gas_concentrations%set_vmr(trim(active_gases(iGas)), gas_vmr(:,:,2))) - if (iGas .eq. istr_h2o) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_h2o',& - gas_concentrations%set_vmr(trim(active_gases(iGas)), vmr_h2o)) - if (iGas .eq. istr_o3) call check_error_msg('GFS_rrtmgp_pre_run_setvmr_o3', & - gas_concentrations%set_vmr(trim(active_gases(iGas)), vmr_o3)) - enddo + ! Populate RRTMGP DDT w/ gas-concentrations + gas_concentrations%gas_name(:) = active_gases_array(:) + gas_concentrations%concs(istr_o2)%conc(:,:) = gas_vmr(:,:,4) + gas_concentrations%concs(istr_co2)%conc(:,:) = gas_vmr(:,:,1) + gas_concentrations%concs(istr_ch4)%conc(:,:) = gas_vmr(:,:,3) + gas_concentrations%concs(istr_n2o)%conc(:,:) = gas_vmr(:,:,2) + gas_concentrations%concs(istr_h2o)%conc(:,:) = vmr_h2o(:,:) + gas_concentrations%concs(istr_o3)%conc(:,:) = vmr_o3(:,:) + ! ####################################################################################### ! Radiation time step (output) (Is this really needed?) (Used by some diagnostics) ! ####################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 28487974b..521d7a8a0 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -25,14 +25,6 @@ type = integer intent = in optional = F -[gas_concentrations] - standard_name = Gas_concentrations_for_RRTMGP_suite - long_name = DDT containing gas concentrations for RRTMGP radiation scheme - units = DDT - dimensions = () - type = ty_gas_concs - intent = out - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index df2021864..1455814f4 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -7,6 +7,7 @@ module rrtmgp_lw_gas_optics use mo_optical_props, only: ty_optical_props_1scl use mo_compute_bc, only: compute_bc use rrtmgp_aux, only: check_error_msg + use GFS_rrtmgp_pre, only: active_gases_array use netcdf implicit none @@ -70,7 +71,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_co nCol, nLev, mpicomm, mpirank, mpiroot, minGPpres, errmsg, errflg) ! Inputs - type(ty_gas_concs), intent(in) :: & + type(ty_gas_concs), intent(inout) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory @@ -266,6 +267,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_co ! !$omp critical (load_lw_gas_optics) ! Longwave k-distribution data. + gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('rrtmgp_lw_gas_optics_init',lw_gas_props%load(gas_concentrations, & gas_namesLW, key_speciesLW, band2gptLW, band_limsLW, press_refLW, press_ref_tropLW,& temp_refLW, temp_ref_pLW, temp_ref_tLW, vmr_refLW, kmajorLW, kminor_lowerLW, & @@ -289,8 +291,8 @@ end subroutine rrtmgp_lw_gas_optics_init !! \section arg_table_rrtmgp_lw_gas_optics_run !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! - subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay,& - t_lev, tsfg, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) + subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_lev, tsfg,& + gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) ! Inputs logical, intent(in) :: & diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index f256858d9..6a2fea449 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -32,7 +32,7 @@ units = DDT dimensions = () type = ty_gas_concs - intent = in + intent = inout optional = F [ncol] standard_name = horizontal_loop_extent diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 668582d87..7075147b1 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -7,9 +7,11 @@ module rrtmgp_sw_gas_optics use rrtmgp_aux, only: check_error_msg use mo_optical_props, only: ty_optical_props_2str use mo_compute_bc, only: compute_bc + use GFS_rrtmgp_pre, only: active_gases_array use netcdf implicit none + ! RRTMGP k-distribution LUTs. type(ty_gas_optics_rrtmgp) :: sw_gas_props integer, dimension(:), allocatable :: & @@ -69,8 +71,8 @@ module rrtmgp_sw_gas_optics !! \section arg_table_rrtmgp_sw_gas_optics_init !! \htmlinclude rrtmgp_sw_gas_optics.html !! - subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, rrtmgp_sw_file_gas, gas_concentrations, & - mpicomm, mpirank, mpiroot, errmsg, errflg) + subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, & + rrtmgp_sw_file_gas, gas_concentrations, mpicomm, mpirank, mpiroot, errmsg, errflg) ! Inputs character(len=128),intent(in) :: & @@ -83,7 +85,7 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, rrtm mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank - type(ty_gas_concs),intent(in) :: & + type(ty_gas_concs),intent(inout) :: & gas_concentrations ! RRTMGP DDT containing active trace gases. ! Outputs @@ -92,15 +94,11 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, rrtm integer, intent(out) :: & errflg ! CCPP error code - ! Dimensions - integer :: & - ntemps, npress, ngptsSW, nabsorbers, nextrabsorbers, & - nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & - nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & - ncontributors_lower, ncontributors_upper - ! Local variables - integer :: status, ncid, dimid, varID, iGas + integer :: status, ncid, dimid, varID, iGas, ntemps, npress, ngptsSW, nabsorbers, & + nextrabsorbers, nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & + nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & + ncontributors_lower, ncontributors_upper integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: sw_gas_props_file @@ -306,6 +304,7 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, rrtm ! ! Shortwave k-distribution data !$omp critical (load_sw_gas_optics) + gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, & gas_namesSW, key_speciesSW, band2gptSW, band_limsSW, press_refSW, press_ref_tropSW,& temp_refSW, temp_ref_pSW, temp_ref_tSW, vmr_refSW, kmajorSW, kminor_lowerSW, & @@ -360,7 +359,7 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, ngptsGPsw, nday, idxday sw_optical_props_clrsky ! RRTMGP DDT: clear-sky shortwave optical properties, spectral (tau,ssa,g) real(kind_phys), dimension(nCol,ngptsGPsw), intent(out) :: & toa_src_sw ! TOA incident spectral flux (W/m2) - character(len=32), dimension(gas_concentrations%get_num_gases()) :: active_gases + ! Local variables integer :: ij,iGas real(kind_phys), dimension(ncol,nLev) :: vmrTemp @@ -375,19 +374,26 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, ngptsGPsw, nday, idxday toa_src_sw(:,:) = 0._kind_phys if (nDay .gt. 0) then - active_gases = gas_concentrations%get_gas_names() + !active_gases = gas_concentrations%get_gas_names() ! Allocate space call check_error_msg('rrtmgp_sw_gas_optics_run_alloc_2str',& sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) - call check_error_msg('rrtmgp_sw_gas_optics_run_init_ty_gas_concs', & - gas_concentrations_daylit%init(active_gases)) + + gas_concentrations_daylit%ncol = nDay + gas_concentrations_daylit%nlay = nLev + allocate(gas_concentrations_daylit%gas_name(gas_concentrations%get_num_gases())) + allocate(gas_concentrations_daylit%concs(gas_concentrations%get_num_gases())) + do iGas=1,gas_concentrations%get_num_gases() + allocate(gas_concentrations_daylit%concs(iGas)%conc(nDay, nLev)) + enddo + gas_concentrations_daylit%gas_name(:) = active_gases_array(:) ! Subset the gas concentrations. do iGas=1,gas_concentrations%get_num_gases() call check_error_msg('rrtmgp_sw_gas_optics_run_get_vmr',& - gas_concentrations%get_vmr(trim(active_gases(iGas)),vmrTemp)) + gas_concentrations%get_vmr(trim(gas_concentrations_daylit%gas_name(iGas)),vmrTemp)) call check_error_msg('rrtmgp_sw_gas_optics_run_set_vmr',& - gas_concentrations_daylit%set_vmr(trim(active_gases(iGas)),vmrTemp(idxday(1:nday),:))) + gas_concentrations_daylit%set_vmr(trim(gas_concentrations_daylit%gas_name(iGas)),vmrTemp(idxday(1:nday),:))) enddo ! Call SW gas-optics diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index e69b68d73..17d0b046b 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -56,7 +56,7 @@ units = DDT dimensions = () type = ty_gas_concs - intent = in + intent = inout optional = F [mpirank] standard_name = mpi_rank diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index c3bee1829..4ea4c36d8 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -29,10 +29,10 @@ end subroutine rrtmgp_sw_rte_init !! \htmlinclude rrtmgp_sw_rte.html !! subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, coszen, p_lay, & - t_lay, p_lev, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif,& + t_lay, p_lev, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & - sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & - fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, errmsg, errflg) + sw_optical_props_aerosol, scmpsw, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky,& + fluxswDOWN_clrsky, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -63,10 +63,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz sfc_alb_uvvis_dif ! Surface albedo (diffuse) real(kind_phys), dimension(ncol,sw_gas_props%get_ngpt()), intent(in) :: & toa_src_sw ! TOA incident spectral flux (W/m2) - integer, intent(in) :: & - rrtmgp_nGases ! Number of trace gases active in RRTMGP - character(len=*),dimension(rrtmgp_nGases), intent(in) :: & - active_gases_array ! Character array containing trace gases to include in RRTMGP ! Outputs character(len=*), intent(out) :: & diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index f5bf59ade..0558819f1 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -161,23 +161,6 @@ kind = kind_phys intent = in optional = F -[rrtmgp_nGases] - standard_name = number_of_active_gases_used_by_RRTMGP - long_name = number of gases available used by RRTMGP - units = count - dimensions = () - type = integer - intent = in - optional = F -[active_gases_array] - standard_name = list_of_active_gases_used_by_RRTMGP - long_name = list of active gases used by RRTMGP - units = none - dimensions = (number_of_active_gases_used_by_RRTMGP) - type = character - kind = len=* - intent = in - optional = F [scmpsw] standard_name = components_of_surface_downward_shortwave_fluxes long_name = derived type for special components of surface downward shortwave fluxes From 828759a2333074787b0d65f2eef93915a2b086f2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 11 Feb 2021 15:14:57 -0700 Subject: [PATCH 200/274] Update physics/GFS_debug.F90, and fix formatting in physics/ugwpv1_gsldrag.F90 --- physics/GFS_debug.F90 | 10 +- physics/ugwpv1_gsldrag.F90 | 382 ++++++++++++++++++------------------- 2 files changed, 197 insertions(+), 195 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index cbc65fa79..5ecc9d8a3 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -676,10 +676,10 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%exch_m ', Diag%exch_m) end if ! UGWP - incomplete list - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_gw ', Diag%%dudt_gw) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_gw ', Diag%%dvdt_gw) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtdt_gw ', Diag%%dtdt_gw) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%kdis_gw ', Diag%%kdis_gw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_gw ', Diag%dudt_gw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_gw ', Diag%dvdt_gw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtdt_gw ', Diag%dtdt_gw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%kdis_gw ', Diag%kdis_gw) if (Model%do_ugwp_v1 .or. Model%gwd_opt==33 .or. Model%gwd_opt==22) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_ogw ', Diag%dvdt_ogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_obl ', Diag%dudt_obl ) @@ -696,6 +696,8 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv_osscol ', Diag%dv_osscol) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du_ofdcol ', Diag%du_ofdcol) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv_ofdcol ', Diag%dv_ofdcol) + else + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_ogw ', Diag%dvdt_ogw) end if ! Statein call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%phii' , Statein%phii) diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 28a4110fc..24ab2b2d1 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -37,12 +37,12 @@ module ugwpv1_gsldrag use machine, only: kind_phys - + use cires_ugwpv1_triggers, only: slat_geos5_2020, slat_geos5_tamp_v1 - use cires_ugwpv1_module, only: cires_ugwpv1_init, ngwflux_update, calendar_ugwp - use cires_ugwpv1_module, only: knob_ugwp_version, cires_ugwp_dealloc, tamp_mpa - use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2 - use cires_ugwpv1_oro, only: orogw_v1 + use cires_ugwpv1_module, only: cires_ugwpv1_init, ngwflux_update, calendar_ugwp + use cires_ugwpv1_module, only: knob_ugwp_version, cires_ugwp_dealloc, tamp_mpa + use cires_ugwpv1_solv2, only: cires_ugwpv1_ngw_solv2 + use cires_ugwpv1_oro, only: orogw_v1 use drag_suite, only: drag_suite_run @@ -69,13 +69,13 @@ subroutine ugwpv1_gsldrag_init ( & me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, & con_pi, con_rerth, con_p0, & - con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, & + con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, & do_ugwp,do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, errmsg, errflg) - + use ugwp_common - + !---- initialization of unified_ugwp implicit none @@ -92,9 +92,9 @@ subroutine ugwpv1_gsldrag_init ( & real(kind=kind_phys), intent (in) :: dtp real(kind=kind_phys), intent (in) :: con_p0, con_pi, con_rerth - real(kind=kind_phys), intent(in) :: con_g, con_cp, con_rd, con_rv, con_omega, con_fvirt + real(kind=kind_phys), intent(in) :: con_g, con_cp, con_rd, con_rv, con_omega, con_fvirt logical, intent (in) :: do_ugwp - + logical, intent (in) :: do_ugwp_v0, do_ugwp_v0_orog_only, & do_gsl_drag_ls_bl, do_gsl_drag_ss, & do_gsl_drag_tofd, do_ugwp_v1, & @@ -115,20 +115,20 @@ subroutine ugwpv1_gsldrag_init ( & errmsg = '' errflg = 0 !============================================================================ -! +! ! gwd_opt => "1 and 2, 3, 22, 33' see previous GSL-commits -! related to GSL-oro drag suite -! for use of the new-GSL/old-GFS/EMC inputs for sub-grid orography -! see details inside /ufs-weather-model/FV3/io/FV3GFS_io.F90 +! related to GSL-oro drag suite +! for use of the new-GSL/old-GFS/EMC inputs for sub-grid orography +! see details inside /ufs-weather-model/FV3/io/FV3GFS_io.F90 ! FV3GFS_io.F90: if (Model%gwd_opt==3 .or. Model%gwd_opt==33 .or. & ! FV3GFS_io.F90: Model%gwd_opt==2 .or. Model%gwd_opt==22 ) then ! FV3GFS_io.F90: if ( (Model%gwd_opt==3 .or. Model%gwd_opt==33) .or. & ! FV3GFS_io.F90: ( (Model%gwd_opt==2 .or. Model%gwd_opt==22) .and. & ! ! gwd_opt=1 -current 14-element GFS-EMC subgrid-oro input -! gwd_opt=2 and 3 24-element -current 14-element GFS-EMC subgrid-oro input +! gwd_opt=2 and 3 24-element -current 14-element GFS-EMC subgrid-oro input ! GSL uses the gwd_opt flag to control "extra" diagnostics (22 and 33) -! CCPP may use gwd_opt to determine 14 or 24 variables for the input +! CCPP may use gwd_opt to determine 14 or 24 variables for the input ! but at present you work with "nmtvr" ! GFS_GWD_generic.F90: integer, intent(in) :: im, levs, nmtvr !GFS_GWD_generic.F90: real(kind=kind_phys), intent(in) :: mntvar(im,nmtvr) @@ -136,7 +136,7 @@ subroutine ugwpv1_gsldrag_init ( & !GFS_GWD_generic.F90: elseif (nmtvr == 10) then ???? !GFS_GWD_generic.F90: elseif (nmtvr == 6) then ???? !GFS_GWD_generic.F90: elseif (nmtvr == 24) then ! GSD_drag_suite and unified_ugwp gwd_opt=2,3 -! +! ! 1) gsldrag: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1 ! 2) CIRES-v1: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp !============================================================================== @@ -156,25 +156,25 @@ subroutine ugwpv1_gsldrag_init ( & return end if -! +! if ( do_ugwp_v0_orog_only .or. do_ugwp_v0) then - print *, ' ccpp do_ugwp_v0 active ', do_ugwp_v0 - print *, ' ccpp do_ugwp_v1_orog_only active ', do_ugwp_v0_orog_only + print *, ' ccpp do_ugwp_v0 active ', do_ugwp_v0 + print *, ' ccpp do_ugwp_v1_orog_only active ', do_ugwp_v0_orog_only write(errmsg,'(*(a))') " the CIRES CCPP-suite does not & - support schemes " + support schemes " errflg = 1 - return + return endif -! +! if (do_ugwp_v1_w_gsldrag .and. do_ugwp_v1_orog_only ) then - + print *, ' do_ugwp_v1_w_gsldrag ', do_ugwp_v1_w_gsldrag print *, ' do_ugwp_v1_orog_only ', do_ugwp_v1_orog_only - print *, ' do_gsl_drag_ls_bl ',do_gsl_drag_ls_bl + print *, ' do_gsl_drag_ls_bl ',do_gsl_drag_ls_bl write(errmsg,'(*(a))') " the CIRES CCPP-suite intend to & - support with but has Logic error" + support with but has Logic error" errflg = 1 - return + return endif !========================== ! @@ -191,64 +191,64 @@ subroutine ugwpv1_gsldrag_init ( & cpd = con_cp rd = con_rd rv = con_rv - fv = con_fvirt - - grav2 = grav + grav; rgrav = 1.0/grav ; rgrav2 = rgrav*rgrav + fv = con_fvirt + + grav2 = grav + grav; rgrav = 1.0/grav ; rgrav2 = rgrav*rgrav rdi = 1.0 / rd ; rcpd = 1./cpd; rcpd2 = 0.5/cpd - gor = grav/rd + gor = grav/rd gr2 = grav*gor grcp = grav*rcpd gocp = grcp - rcpdl = cpd*rgrav + rcpdl = cpd*rgrav grav2cpd = grav*grcp - - pi2 = 2.*pi ; pih = .5*pi + + pi2 = 2.*pi ; pih = .5*pi rad_to_deg=180.0/pi deg_to_rad=pi/180.0 - + bnv2min = (pi2/1800.)*(pi2/1800.) bnv2max = (pi2/30.)*(pi2/30.) - dw2min = 1.0 + dw2min = 1.0 velmin = sqrt(dw2min) minvel = 0.5 - + omega2 = 2.*omega1 omega3 = 3.*omega1 - + hpscale = 7000. ; hpskm = hpscale*1.e-3 rhp = 1./hpscale - rhp2 = 0.5*rhp; rh4 = 0.25*rhp + rhp2 = 0.5*rhp; rh4 = 0.25*rhp rhp4 = rhp2 * rhp2 - khp = rhp* rd/cpd + khp = rhp* rd/cpd mkzmin = pi2/80.0e3 mkz2min = mkzmin*mkzmin mkzmax = pi2/500. mkz2max = mkzmax*mkzmax - cdmin = 2.e-2/mkzmax - + cdmin = 2.e-2/mkzmax + rcpdt = rcpd/dtp if ( do_ugwp_v1 ) then call cires_ugwpv1_init (me, master, nlunit, logunit, jdat, con_pi, & con_rerth, fn_nml2, lonr, latr, levs, ak, bk, & - con_p0, dtp, errmsg, errflg) + con_p0, dtp, errmsg, errflg) end if - + if (me == master) then print *, ' ccpp: ugwpv1_gsldrag_init ' - - print *, ' ccpp do_ugwp_v1 flag ', do_ugwp_v1 - print *, ' ccpp do_gsl_drag_ls_bl flag ', do_gsl_drag_ls_bl - print *, ' ccpp do_gsl_drag_ss flag ' , do_gsl_drag_ss - print *, ' ccpp do_gsl_drag_tofd flag ', do_gsl_drag_tofd - - print *, ' ccpp: ugwpv1_gsldrag_init ' + + print *, ' ccpp do_ugwp_v1 flag ', do_ugwp_v1 + print *, ' ccpp do_gsl_drag_ls_bl flag ', do_gsl_drag_ls_bl + print *, ' ccpp do_gsl_drag_ss flag ' , do_gsl_drag_ss + print *, ' ccpp do_gsl_drag_tofd flag ', do_gsl_drag_tofd + + print *, ' ccpp: ugwpv1_gsldrag_init ' endif - - - is_initialized = .true. - + + + is_initialized = .true. + end subroutine ugwpv1_gsldrag_init @@ -303,7 +303,7 @@ end subroutine ugwpv1_gsldrag_finalize !! !> \section gen_ugwpv1_gsldrag CIRES UGWP Scheme General Algorithm !! @{ - subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kdt, & + subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kdt, & ldiag3d, lssav, flag_for_gwd_generic_tend, do_gsl_drag_ls_bl, do_gsl_drag_ss, & do_gsl_drag_tofd, do_ugwp_v1, do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, & gwd_opt, do_tofd, ldiag_ugwp, cdmbgwd, jdat, & @@ -316,22 +316,22 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd dudt_obl, dvdt_obl, du_oblcol, dv_oblcol, & dudt_oss, dvdt_oss, du_osscol, dv_osscol, & dudt_ofd, dvdt_ofd, du_ofdcol, dv_ofdcol, & - dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, kdis_gw, & - tau_ogw, tau_ngw, tau_oss, & + dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, dudt_gw, dvdt_gw, dtdt_gw, kdis_gw, & + tau_ogw, tau_ngw, tau_oss, & zogw, zlwb, zobl, zngw, dusfcg, dvsfcg, dudt, dvdt, dtdt, rdxzb, & ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw, ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw, & - lprnt, ipr, errmsg, errflg) + lprnt, ipr, errmsg, errflg) ! !######################################################################## ! Attention New Arrays and Names must be ADDED inside ! ! a) /FV3/gfsphysics/GFS_layer/GFS_typedefs.meta ! b) /FV3/gfsphysics/GFS_layer/GFS_typedefs.F90 -! c) /FV3/gfsphysics/GFS_layer/GFS_diagnostics.F90 "diag-cs is not tested" +! c) /FV3/gfsphysics/GFS_layer/GFS_diagnostics.F90 "diag-cs is not tested" !######################################################################## -! - +! + use ugwp_common, only : con_pi => pi, con_g => grav, con_rd => rd, & con_rv => rv, con_cp => cpd, con_fv => fv, & con_rerth => arad, con_omega => omega1, rgrav @@ -340,7 +340,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! Preference use (im,levs) rather than (:,:) to avoid memory-leaks ! that found in Nov-Dec 2020 -! order array-description control-logical +! order array-description control-logical ! other in-variables ! out-variables ! local-variables @@ -349,17 +349,17 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! ! ! interface variables - logical, intent(in) :: ldiag3d, lssav - logical, intent(in) :: flag_for_gwd_generic_tend + logical, intent(in) :: ldiag3d, lssav + logical, intent(in) :: flag_for_gwd_generic_tend logical, intent(in) :: lprnt - + integer, intent(in) :: ipr - + ! flags for choosing combination of GW drag schemes to run - - logical, intent (in) :: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd - logical, intent (in) :: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp - logical, intent (in) :: do_ugwp_v1_w_gsldrag ! combination of ORO and NGW schemes + + logical, intent (in) :: do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd + logical, intent (in) :: do_ugwp_v1, do_ugwp_v1_orog_only, do_tofd, ldiag_ugwp + logical, intent (in) :: do_ugwp_v1_w_gsldrag ! combination of ORO and NGW schemes integer, intent(in) :: me, master, im, levs, ntrac,lonr real(kind=kind_phys), intent(in) :: dtp, fhzero @@ -369,9 +369,9 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd integer, intent(in) :: gwd_opt !gwd_opt and nmtvr are "redundant" controls integer, intent(in) :: nmtvr real(kind=kind_phys), intent(in) :: cdmbgwd(4) ! for gsl_drag - + real(kind=kind_phys), intent(in), dimension(im) :: hprime, oc, theta, sigma, gamma - + real(kind=kind_phys), intent(in), dimension(im) :: elvmax real(kind=kind_phys), intent(in), dimension(im, 4) :: clx, oa4 @@ -383,30 +383,30 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd !===== ! real(kind=kind_phys), intent(in) :: con_g, con_omega, con_pi, con_cp, con_rd, & ! con_rv, con_rerth, con_fvirt -! grids +! grids real(kind=kind_phys), intent(in), dimension(im) :: xlat, xlat_d, sinlat, coslat, area -! State vars + PBL/slmsk +rain +! State vars + PBL/slmsk +rain real(kind=kind_phys), intent(in), dimension(im, levs) :: del, ugrs, vgrs, tgrs, prsl, prslk, phil real(kind=kind_phys), intent(in), dimension(im, levs+1) :: prsi, phii real(kind=kind_phys), intent(in), dimension(im, levs) :: q1 integer, intent(in), dimension(im) :: kpbl - + real(kind=kind_phys), intent(in), dimension(im) :: rain - real(kind=kind_phys), intent(in), dimension(im) :: br1, hpbl, slmsk + real(kind=kind_phys), intent(in), dimension(im) :: br1, hpbl, slmsk ! ! moved to GFS_phys_time_vary ! real(kind=kind_phys), intent(in), dimension(im) :: ddy_j1tau, ddy_j2tau -! integer, intent(in), dimension(im) :: jindx1_tau, jindx2_tau - real(kind=kind_phys), intent(in), dimension(im) :: tau_amf - +! integer, intent(in), dimension(im) :: jindx1_tau, jindx2_tau + real(kind=kind_phys), intent(in), dimension(im) :: tau_amf + !Output (optional): real(kind=kind_phys), intent(out), dimension(im) :: & - du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & - du_osscol, dv_osscol, du_ofdcol, dv_ofdcol + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol ! ! we may add later but due to launch in the upper layes ~ mPa comparing to ORO Pa*(0.1) ! du_ngwcol, dv_ngwcol @@ -420,12 +420,12 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd real(kind=kind_phys), intent(out) , dimension(im, levs) :: dudt_ngw, dvdt_ngw, kdis_ngw real(kind=kind_phys), intent(out) , dimension(im, levs) :: dudt_gw, dvdt_gw, kdis_gw - - real(kind=kind_phys), intent(out) , dimension(im, levs) :: dtdt_ngw, dtdt_gw - + + real(kind=kind_phys), intent(out) , dimension(im, levs) :: dtdt_ngw, dtdt_gw + real(kind=kind_phys), intent(out) , dimension(im) :: zogw, zlwb, zobl, zngw -! -! +! +! real(kind=kind_phys), intent(inout), dimension(im, levs) :: dudt, dvdt, dtdt ! @@ -435,7 +435,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! real(kind=kind_phys), intent(inout), dimension(im,levs) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw real(kind=kind_phys), intent(inout), dimension(im,levs) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw - + real(kind=kind_phys), intent(out), dimension(im) :: rdxzb ! for stoch phys. mtb-level @@ -445,22 +445,22 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! local variables integer :: i, k - real(kind=kind_phys), dimension(im) :: sgh30 + real(kind=kind_phys), dimension(im) :: sgh30 real(kind=kind_phys), dimension(im, levs) :: Pdvdt, Pdudt real(kind=kind_phys), dimension(im, levs) :: Pdtdt, Pkdis !------------ ! ! from ugwp_driver_v0.f -> cires_ugwp_initialize.F90 -> module ugwp_wmsdis_init -! now in the namelist of cires_ugwp "knob_ugwp_tauamp" controls tamp_mpa +! now in the namelist of cires_ugwp "knob_ugwp_tauamp" controls tamp_mpa ! ! tamp_mpa =knob_ugwp_tauamp !amplitude for GEOS-5/MERRA-2 !------------ ! real(kind=kind_phys), parameter :: tamp_mpa_v0=30.e-3 ! large flux to help "GFS-ensembles" in July 2019 ! switches that activate impact of OGWs and NGWs - + ! integer :: nmtvr_temp - + real(kind=kind_phys), dimension(im, levs) :: zmet ! geopotential height at model Layer centers real(kind=kind_phys), dimension(im, levs+1) :: zmeti ! geopotential height at model layer interfaces @@ -476,45 +476,45 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! Initialize CCPP error handling variables - + errmsg = '' errflg = 0 ! 1) ORO stationary GWs ! ------------------ -! +! ! for all oro-suites can uze geo-meters having "hpbl" -! +! ! ! All GW-schemes operate with Zmet =phil*inv_g, passing Zmet/Zmeti can be more robust ! + rho*dz = =delp * inv_g can be also pre-comp for all "GW-schemes" ! zmeti = phii* rgrav zmet = phil* rgrav - + !=============================================================== ! ORO-diag - - dudt_ogw(:,:) = 0. ; dvdt_ogw(:,:)=0. ; dudt_obl(:,:)=0. ; dvdt_obl(:,:)=0. - dudt_oss(:,:) = 0. ; dvdt_oss(:,:)=0. ; dudt_ofd(:,:)=0. ; dvdt_ofd(:,:)=0. - - dusfcg (:) = 0. ; dvsfcg(:) =0. - - du_ogwcol(:)=0. ; dv_ogwcol(:)=0. ; du_oblcol(:)=0. ; dv_oblcol(:)=0. - du_osscol(:)=0. ; dv_osscol(:)=0. ;du_ofdcol(:)=0. ; dv_ofdcol(:)=0. - -! - dudt_ngw(:,:)=0. ; dvdt_ngw(:,:)=0. ; dtdt_ngw(:,:)=0. ; kdis_ngw(:,:)=0. - -! ngw+ogw - diag - - dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; kdis_gw(:,:)=0. + + dudt_ogw(:,:) = 0. ; dvdt_ogw(:,:)=0. ; dudt_obl(:,:)=0. ; dvdt_obl(:,:)=0. + dudt_oss(:,:) = 0. ; dvdt_oss(:,:)=0. ; dudt_ofd(:,:)=0. ; dvdt_ofd(:,:)=0. + + dusfcg (:) = 0. ; dvsfcg(:) =0. + + du_ogwcol(:)=0. ; dv_ogwcol(:)=0. ; du_oblcol(:)=0. ; dv_oblcol(:)=0. + du_osscol(:)=0. ; dv_osscol(:)=0. ;du_ofdcol(:)=0. ; dv_ofdcol(:)=0. + +! + dudt_ngw(:,:)=0. ; dvdt_ngw(:,:)=0. ; dtdt_ngw(:,:)=0. ; kdis_ngw(:,:)=0. + +! ngw+ogw - diag + + dudt_gw(:,:)=0. ; dvdt_gw(:,:)=0. ; dtdt_gw(:,:)=0. ; kdis_gw(:,:)=0. ! source fluxes - - tau_ogw(:)=0. ; tau_ngw(:)=0. ; tau_oss(:)=0. - + + tau_ogw(:)=0. ; tau_ngw(:)=0. ; tau_oss(:)=0. + ! launch layers - + zlwb(:)= 0. ; zogw(:)=0. ; zobl(:)=0. ; zngw(:)=0. !=============================================================== ! diag tendencies due to all-SSO schemes (ORO-physics) @@ -525,10 +525,10 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd Pdvdt(i,k) = 0.0 Pdudt(i,k) = 0.0 Pdtdt(i,k) = 0.0 - Pkdis(i,k) = 0.0 + Pkdis(i,k) = 0.0 enddo enddo -! +! ! Run the appropriate large-scale (large-scale GWD + blocking) scheme ! Note: In case of GSL drag_suite, this includes ss and tofd @@ -539,7 +539,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl,dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd ! du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, du_osscol, dv_osscol, du_ofdcol dv_ofdcol ! dusfcg, dvsfcg -! +! ! call drag_suite_run(im,levs, Pdvdt, Pdudt, Pdtdt, & ugrs,vgrs,tgrs,q1, & @@ -556,33 +556,33 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & errmsg,errflg) -! +! ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol -! -! if (kdt <= 2 .and. me == master) then -! print *, ' unified drag_suite_run ', kdt -! print *, ' GSL drag du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 -! print *, ' GSL drag dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 -! -! zero print *, ' unified drag_GSL dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 -! -! if (gwd_opt == 22 .or. gwd_opt == 33) then -! print *, ' unified drag_GSL dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 -! print *, ' unified drag_GSL dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 -! print *, ' unified drag_GSL dUOGW/dt ', maxval(dudt_ogw)*86400, minval(dudt_ogw)*86400 -! print *, ' unified drag_GSL dVOGW/dt ', maxval(dvdt_ogw)*86400, minval(dvdt_ogw)*86400 -! print *, ' unified drag_GSL dUOss/dt ', maxval(dudt_oss)*86400, minval(dudt_oss)*86400 -! print *, ' unified drag_GSL dVOSS/dt ', maxval(dvdt_oss)*86400, minval(dvdt_oss)*86400 -! print *, ' unified drag_GSL dUOfd/dt ', maxval(dudt_ofd)*86400, minval(dudt_ofd)*86400 -! print *, ' unified drag_GSL dVOfd/dt ', maxval(dvdt_ofd)*86400, minval(dvdt_ofd)*86400 -! endif -! endif - - else +! +! if (kdt <= 2 .and. me == master) then +! print *, ' unified drag_suite_run ', kdt +! print *, ' GSL drag du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 +! print *, ' GSL drag dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 +! +! zero print *, ' unified drag_GSL dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 +! +! if (gwd_opt == 22 .or. gwd_opt == 33) then +! print *, ' unified drag_GSL dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 +! print *, ' unified drag_GSL dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 +! print *, ' unified drag_GSL dUOGW/dt ', maxval(dudt_ogw)*86400, minval(dudt_ogw)*86400 +! print *, ' unified drag_GSL dVOGW/dt ', maxval(dvdt_ogw)*86400, minval(dvdt_ogw)*86400 +! print *, ' unified drag_GSL dUOss/dt ', maxval(dudt_oss)*86400, minval(dudt_oss)*86400 +! print *, ' unified drag_GSL dVOSS/dt ', maxval(dvdt_oss)*86400, minval(dvdt_oss)*86400 +! print *, ' unified drag_GSL dUOfd/dt ', maxval(dudt_ofd)*86400, minval(dudt_ofd)*86400 +! print *, ' unified drag_GSL dVOfd/dt ', maxval(dvdt_ofd)*86400, minval(dvdt_ofd)*86400 +! endif +! endif + + else ! ! not gsldrag oro-scheme for example "do_ugwp_v1_orog_only" -! - +! + if ( do_ugwp_v1_orog_only ) then ! ! for TOFD we use now "varss" of GSL-drag /not sgh30=abs(oro-oro_f)/ @@ -591,38 +591,38 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! OROGW_V1 introduce "orchestration" between OGW-effects and Mountain Blocking ! it starts to examines options for the Scale-Aware (SA)formulation of SSO-effects ! if ( me == master .and. kdt == 1) print *, ' bf orogw_v1 nmtvr=', nmtvr, ' do_tofd=', do_tofd - + if (gwd_opt ==1 )sgh30 = 0.15*hprime ! portion of the mesoscale SSO (~[oro_unfilt -oro_filt) if (gwd_opt >1 ) sgh30 = varss ! as in gsldrag: see drag_suite_run - + call orogw_v1 (im, levs, lonr, me, master,dtp, kdt, do_tofd, & xlat_d, sinlat, coslat, area, & cdmbgwd(1:2), hprime, oc, oa4, clx, theta, & - sigma, gamma, elvmax, sgh30, kpbl, ugrs, & - vgrs, tgrs, q1, prsi,del,prsl,prslk, zmeti, zmet, & - Pdvdt, Pdudt, Pdtdt, Pkdis, DUSFCg, DVSFCg,rdxzb, & + sigma, gamma, elvmax, sgh30, kpbl, ugrs, & + vgrs, tgrs, q1, prsi,del,prsl,prslk, zmeti, zmet, & + Pdvdt, Pdudt, Pdtdt, Pkdis, DUSFCg, DVSFCg,rdxzb, & zobl, zlwb, zogw, tau_ogw, dudt_ogw, dvdt_ogw, & dudt_obl, dvdt_obl,dudt_ofd, dvdt_ofd, & du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & du_ofdcol, dv_ofdcol, errmsg,errflg ) -! +! ! orogw_v1: dusfcg = du_ogwcol + du_oblcol + du_ofdcol only 3 terms ! ! ! if (kdt <= 2 .and. me == master) then -! -! print *, ' unified_ugwp orogw_v1 ', kdt, me, nmtvr -! print *, ' unified_ugwp orogw_v1 du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 -! print *, ' unified_ugwp orogw_v1 dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 -! print *, ' unified_ugwp orogw_v1 dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 -! print *, ' unified_ugwp orogw_v1 dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 -! print *, ' unified_ugwp orogw_v1 dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 -! endif - - +! +! print *, ' unified_ugwp orogw_v1 ', kdt, me, nmtvr +! print *, ' unified_ugwp orogw_v1 du/dt ', maxval(Pdudt)*86400, minval(Pdudt)*86400 +! print *, ' unified_ugwp orogw_v1 dv/dt ', maxval(Pdvdt)*86400, minval(Pdvdt)*86400 +! print *, ' unified_ugwp orogw_v1 dT/dt ', maxval(Pdtdt)*86400, minval(Pdtdt)*86400 +! print *, ' unified_ugwp orogw_v1 dUBL/dt ', maxval(dudt_obl)*86400, minval(dudt_obl)*86400 +! print *, ' unified_ugwp orogw_v1 dVBL/dt ', maxval(dvdt_obl)*86400, minval(dvdt_obl)*86400 +! endif + + end if ! -! for old-fashioned GFS-style diag-cs like dt3dt(:.:, 1:14) collections +! for old-fashioned GFS-style diag-cs like dt3dt(:.:, 1:14) collections ! if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then do k=1,levs @@ -633,7 +633,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd enddo enddo endif - ENDIF + ENDIF ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Begin non-stationary GW schemes @@ -641,54 +641,54 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (do_ugwp_v1) then - -!================================================================== -! call slat_geos5_tamp_v1(im, tamp_mpa, xlat_d, tau_ngw) + +!================================================================== +! call slat_geos5_tamp_v1(im, tamp_mpa, xlat_d, tau_ngw) ! ! 2020 updates of MERRA/GEOS tau_ngw for the C96-QBO FV3GFS-127L runs -!================================================================== - +!================================================================== + call slat_geos5_2020(im, tamp_mpa, xlat_d, tau_ngw) - y4 = jdat(1); month = jdat(2); day = jdat(3) -! -! hour = jdat(5) + y4 = jdat(1); month = jdat(2); day = jdat(3) +! +! hour = jdat(5) ! fhour = float(hour)+float(jdat(6))/60. + float(jdat(7))/3600. ! fhour = (kdt-1)*dtp/3600. ! fhrday = fhour/24. - nint(fhour/24.) - - - call calendar_ugwp(y4, month, day, ddd_ugwp) + + + call calendar_ugwp(y4, month, day, ddd_ugwp) curdate = y4*1000 + ddd_ugwp -! +! call ngwflux_update(me, master, im, levs, kdt, ddd_ugwp,curdate, & - tau_amf, xlat_d, sinlat,coslat, rain, tau_ngw) - + tau_amf, xlat_d, sinlat,coslat, rain, tau_ngw) + call cires_ugwpv1_ngw_solv2(me, master, im, levs, kdt, dtp, & tau_ngw, tgrs, ugrs, vgrs, q1, prsl, prsi, & zmet, zmeti,prslk, xlat_d, sinlat, coslat, & dudt_ngw, dvdt_ngw, dtdt_ngw, kdis_ngw, zngw) -! +! ! => con_g, con_cp, con_rd, con_rv, con_omega, con_pi, con_fvirt ! ! if (me == master .and. kdt <= 2) then ! print * ! write(6,*)'FV3GFS finished fv3_ugwp_solv2_v1 ' ! write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' -! print * -! -! print *, ' ugwp_v1 ', kdt -! print *, ' ugwp_v1 du/dt ', maxval(dudt_ngw)*86400, minval(dudt_ngw)*86400 -! print *, ' ugwp_v1 dv/dt ', maxval(dvdt_ngw)*86400, minval(dvdt_ngw)*86400 -! print *, ' ugwp_v1 dT/dt ', maxval(dtdt_ngw)*86400, minval(dtdt_ngw)*86400 +! print * +! +! print *, ' ugwp_v1 ', kdt +! print *, ' ugwp_v1 du/dt ', maxval(dudt_ngw)*86400, minval(dudt_ngw)*86400 +! print *, ' ugwp_v1 dv/dt ', maxval(dvdt_ngw)*86400, minval(dvdt_ngw)*86400 +! print *, ' ugwp_v1 dT/dt ', maxval(dtdt_ngw)*86400, minval(dtdt_ngw)*86400 ! endif - + end if ! do_ugwp_v1 - + ! ! GFS-style diag dt3dt(:.:, 1:14) time-averaged -! +! if(ldiag3d .and. lssav .and. .not. flag_for_gwd_generic_tend) then do k=1,levs do i=1,im @@ -698,21 +698,21 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd enddo enddo endif - + ! ! get total sso-OGW + NGW ! dudt_gw = Pdudt +dudt_ngw dvdt_gw = Pdvdt +dvdt_ngw - dtdt_gw = Pdtdt +dtdt_ngw - kdis_gw = Pkdis +kdis_ngw + dtdt_gw = Pdtdt +dtdt_ngw + kdis_gw = Pkdis +kdis_ngw ! -! accumulate "tendencies" as in the GFS-ipd (pbl + ugwp + zero-RF) +! accumulate "tendencies" as in the GFS-ipd (pbl + ugwp + zero-RF) ! dudt = dudt + dudt_ngw - dvdt = dvdt + dvdt_ngw - dtdt = dtdt + dtdt_ngw - + dvdt = dvdt + dvdt_ngw + dtdt = dtdt + dtdt_ngw + end subroutine ugwpv1_gsldrag_run !! @} !>@} From ea77544735b4c07ac59ee9a477f4e435eaa42569 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 11 Feb 2021 15:54:52 -0700 Subject: [PATCH 201/274] physics/ugwpv1_gsldrag.F90: adjust formatting --- physics/ugwpv1_gsldrag.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 24ab2b2d1..87cbbb853 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -69,7 +69,7 @@ subroutine ugwpv1_gsldrag_init ( & me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, & con_pi, con_rerth, con_p0, & - con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, & + con_g, con_omega, con_cp, con_rd, con_rv,con_fvirt, & do_ugwp,do_ugwp_v0, do_ugwp_v0_orog_only, do_gsl_drag_ls_bl, & do_gsl_drag_ss, do_gsl_drag_tofd, do_ugwp_v1, & do_ugwp_v1_orog_only, do_ugwp_v1_w_gsldrag, errmsg, errflg) From 04ecde307c086c8ff49105757a506ccdfc561457 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 12 Feb 2021 15:02:42 -0700 Subject: [PATCH 202/274] Bugfix in physics/ugwpv1_gsldrag.F90, 3d diagnostic arrays may not be allocated --- physics/ugwpv1_gsldrag.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 87cbbb853..00fd42dbd 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -433,8 +433,8 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! ! Version of COORDE updated by CCPP-dev for time-aver ! - real(kind=kind_phys), intent(inout), dimension(im,levs) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw - real(kind=kind_phys), intent(inout), dimension(im,levs) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ogw, ldv3dt_ogw, ldt3dt_ogw + real(kind=kind_phys), intent(inout), dimension(:,:) :: ldu3dt_ngw, ldv3dt_ngw, ldt3dt_ngw From d8f4ffbfbe519ee627c6144505d029c4720bd9f3 Mon Sep 17 00:00:00 2001 From: Greg Thompson Date: Sat, 13 Feb 2021 07:13:55 -0700 Subject: [PATCH 203/274] update Thompson more similar to WRF-v4.3 --- physics/module_mp_thompson.F90 | 437 +++++++++++++++------------------ 1 file changed, 194 insertions(+), 243 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index c19b594dd..fcbcb8164 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -53,6 +53,10 @@ !! perturbations to the graupel intercept parameter, !! the cloud water shape parameter, and the number !! concentration of nucleated aerosols. +!! - Last modified: 12 Feb 2021 G. Thompson updated to align more closely +!! with his WRF version, including bug fixes and designed +!! changes. + MODULE module_mp_thompson USE machine, only : kind_phys @@ -120,8 +124,8 @@ MODULE module_mp_thompson !.. mixing ratio. Also, when mu_g is non-zero, these become equiv !.. y-intercept for an exponential distrib and proper values are !.. computed based on same mixing ratio and total number concentration. - REAL, PARAMETER, PRIVATE:: gonv_min = 1.E4 - REAL, PARAMETER, PRIVATE:: gonv_max = 3.E6 + REAL, PARAMETER, PRIVATE:: gonv_min = 1.E2 + REAL, PARAMETER, PRIVATE:: gonv_max = 1.E6 !..Mass power law relations: mass = am*D**bm !.. Snow from Field et al. (2005), others assume spherical form. @@ -183,7 +187,7 @@ MODULE module_mp_thompson REAL, PRIVATE:: Sc3 !..Homogeneous freezing temperature - REAL, PARAMETER, PRIVATE:: HGFR = 235.16 !< Homogeneous freezing temperature + REAL, PARAMETER, PRIVATE:: HGFR = 235.16 !..Water vapor and air gas constants at constant pressure REAL, PARAMETER, PRIVATE:: Rv = 461.5 @@ -214,6 +218,15 @@ MODULE module_mp_thompson REAL, PARAMETER, PRIVATE:: D0g = 250.E-6 REAL, PRIVATE:: D0i, xm0s, xm0g +!..Min and max radiative effective radius of cloud water, cloud ice, and snow; +!.. performed by subroutine calc_effectRad + REAL, PARAMETER:: re_qc_min = 2.50E-6 ! 2.5 microns + REAL, PARAMETER:: re_qc_max = 50.0E-6 ! 50 microns + REAL, PARAMETER:: re_qi_min = 2.50E-6 ! 2.5 microns + REAL, PARAMETER:: re_qi_max = 125.0E-6 ! 125 microns + REAL, PARAMETER:: re_qs_min = 5.00E-6 ! 5 microns + REAL, PARAMETER:: re_qs_max = 999.0E-6 ! 999 microns (1 mm) + !..Lookup table dimensions INTEGER, PARAMETER, PRIVATE:: nbins = 100 INTEGER, PARAMETER, PRIVATE:: nbc = nbins @@ -226,7 +239,7 @@ MODULE module_mp_thompson INTEGER, PARAMETER, PRIVATE:: ntb_r = 37 INTEGER, PARAMETER, PRIVATE:: ntb_s = 28 INTEGER, PARAMETER, PRIVATE:: ntb_g = 28 - INTEGER, PARAMETER, PRIVATE:: ntb_g1 = 28 + INTEGER, PARAMETER, PRIVATE:: ntb_g1 = 37 INTEGER, PARAMETER, PRIVATE:: ntb_r1 = 37 INTEGER, PARAMETER, PRIVATE:: ntb_i1 = 55 INTEGER, PARAMETER, PRIVATE:: ntb_t = 9 @@ -299,10 +312,11 @@ MODULE module_mp_thompson !> Lookup tables for graupel y-intercept parameter (/m**4). REAL, DIMENSION(ntb_g1), PARAMETER, PRIVATE:: & - N0g_exp = (/1.e4,2.e4,3.e4,4.e4,5.e4,6.e4,7.e4,8.e4,9.e4, & + N0g_exp = (/1.e2,2.e2,3.e2,4.e2,5.e2,6.e2,7.e2,8.e2,9.e2, & + 1.e3,2.e3,3.e3,4.e3,5.e3,6.e3,7.e3,8.e3,9.e3, & + 1.e4,2.e4,3.e4,4.e4,5.e4,6.e4,7.e4,8.e4,9.e4, & 1.e5,2.e5,3.e5,4.e5,5.e5,6.e5,7.e5,8.e5,9.e5, & - 1.e6,2.e6,3.e6,4.e6,5.e6,6.e6,7.e6,8.e6,9.e6, & - 1.e7/) + 1.e6/) !> Lookup tables for ice number concentration (/m**3). REAL, DIMENSION(ntb_i1), PARAMETER, PRIVATE:: & @@ -354,6 +368,15 @@ MODULE module_mp_thompson !.. and temperature array indices. Variables beginning with t-p/c/m/n !.. represent lookup tables. Save compile-time memory by making !.. allocatable (2009Jun12, J. Michalakes). + +!..To permit possible creation of new lookup tables as variables expand/change, +!.. specify a name of external file(s) including version number for pre-computed +!.. Thompson tables. + character(len=*), parameter :: thomp_table_file = 'thompson_tables_precomp_v2.sl' + character(len=*), parameter :: qr_acr_qg_file = 'qr_acr_qgV2.dat' + character(len=*), parameter :: qr_acr_qs_file = 'qr_acr_qsV2.dat' + character(len=*), parameter :: freeze_h2o_file = 'freezeH2O.dat' + INTEGER, PARAMETER, PRIVATE:: R8SIZE = 8 INTEGER, PARAMETER, PRIVATE:: R4SIZE = 4 REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:,:,:,:):: & @@ -748,7 +771,7 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & mpi_communicator = mpicomm #ifdef SION call cpu_time(stime) - call readwrite_tables("read", mpicomm, mpirank, mpiroot, ierr) + call readwrite_tables(thomp_table_file, "read", mpicomm, mpirank, mpiroot, ierr) call cpu_time(etime) if (ierr==0) then precomputed_tables = .true. @@ -897,6 +920,10 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & if (mpirank==mpiroot) write(0,*) ' creating rain evap table' call table_dropEvap +!> - Call qi_aut_qs() to create conversion of some ice mass into snow category + if (mpirank==mpiroot) write(0,*) ' creating ice converting to snow table' + call qi_aut_qs + call cpu_time(etime) if (mpirank==mpiroot) print '("Calculating Thompson tables part 1 took ",f10.3," seconds.")', etime-stime @@ -945,19 +972,12 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & call cpu_time(etime) if (mpirank==mpiroot) print '("Computing freezing of water drops table took ",f10.3," seconds.")', etime-stime -!> - Call qi_aut_qs() to create conversion of some ice mass into snow category - if (mpirank==mpiroot) write(0,*) ' creating ice converting to snow table' - call cpu_time(stime) - call qi_aut_qs - call cpu_time(etime) - if (mpirank==mpiroot) print '("Computing ice converting to snow table took ",f10.3," seconds.")', etime-stime - call cpu_time(etime) if (mpirank==mpiroot) print '("Calculating Thompson tables part 2 took ",f10.3," seconds.")', etime-stime #ifdef SION call cpu_time(stime) - call readwrite_tables("write", mpicomm, mpirank, mpiroot, ierr) + call readwrite_tables(thomp_table_file, "write", mpicomm, mpirank, mpiroot, ierr) if (ierr/=0) then write(0,*) "An error occurred writing Thompson tables to disk" stop 1 @@ -1019,7 +1039,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & nc, nwfa, nifa REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN):: nwfa2d, nifa2d - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(OUT):: & + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & re_cloud, re_ice, re_snow INTEGER, INTENT(IN) :: rand_perturb_on, kme_stoch REAL, DIMENSION(ims:ime,kms:kme_stoch,jms:jme), INTENT(IN), OPTIONAL:: & @@ -1059,7 +1079,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & REAL, DIMENSION(its:ite, jts:jte):: pcp_ra, pcp_sn, pcp_gr, pcp_ic REAL:: dt, pptrain, pptsnow, pptgraul, pptice REAL:: qc_max, qr_max, qs_max, qi_max, qg_max, ni_max, nr_max - REAL:: nwfa1 REAL:: rand1, rand2, rand3, min_rand INTEGER:: i, j, k, m INTEGER:: imax_qc,imax_qr,imax_qi,imax_qs,imax_qg,imax_ni,imax_nr @@ -1195,8 +1214,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ! 5 gives both 1+4 ! 6 gives both 2+4 ! 7 gives all 1+2+4 -! For now (22Mar2018), standard deviation should be only 0.25 and cut-off at 1.5 -! in order to constrain the various perturbations from being too extreme. +! For now (22Mar2018), standard deviation should be up to 0.75 and cut-off at 3.0 +! stddev in order to constrain the various perturbations from being too extreme. !+---+-----------------------------------------------------------------+ rand1 = 0.0 rand2 = 0.0 @@ -1206,7 +1225,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & m = RSHIFT(ABS(rand_perturb_on),1) if (MOD(m,2) .ne. 0) rand2 = rand_pert(i,1,j)*2. m = RSHIFT(ABS(rand_perturb_on),2) - if (MOD(m,2) .ne. 0) rand3 = 0.1*(rand_pert(i,1,j)+ABS(min_rand)) + if (MOD(m,2) .ne. 0) rand3 = 0.25*(rand_pert(i,1,j)+ABS(min_rand)) m = RSHIFT(ABS(rand_perturb_on),3) endif !+---+-----------------------------------------------------------------+ @@ -1244,6 +1263,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qg1d(k) = qg(i,k,j) ni1d(k) = ni(i,k,j) nr1d(k) = nr(i,k,j) + rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) enddo if (is_aerosol_aware) then do k = kts, kte @@ -1251,10 +1271,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nwfa1d(k) = nwfa(i,k,j) nifa1d(k) = nifa(i,k,j) enddo - nwfa1 = nwfa2d(i,j) else do k = kts, kte - rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) nc1d(k) = Nt_c/rho(k) nwfa1d(k) = 11.1E6/rho(k) nifa1d(k) = naIN1*0.01/rho(k) @@ -1305,7 +1323,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & !.. Changed 13 May 2013 to fake emissions in which nwfa2d is aerosol !.. number tendency (number per kg per second). if (is_aerosol_aware) then -!-GT nwfa1d(kts) = nwfa1 nwfa1d(kts) = nwfa1d(kts) + nwfa2d(i,j)*dt_in nifa1d(kts) = nifa1d(kts) + nifa2d(i,j)*dt_in @@ -1439,17 +1456,17 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & IF (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) THEN do k = kts, kte - re_qc1d(k) = 2.50E-6 ! 2.49E-6 - re_qi1d(k) = 5.00E-6 ! 4.99E-6 - re_qs1d(k) = 1.00E-5 ! 9.99E-6 + re_qc1d(k) = re_qc_min + re_qi1d(k) = re_qi_min + re_qs1d(k) = re_qs_min enddo !> - Call calc_effectrad() call calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & re_qc1d, re_qi1d, re_qs1d, kts, kte) do k = kts, kte - re_cloud(i,k,j) = MAX(2.50E-6, MIN(re_qc1d(k), 50.E-6)) ! MAX(2.49E-6, MIN(re_qc1d(k), 50.E-6)) - re_ice(i,k,j) = MAX(5.00E-6, MIN(re_qi1d(k), 125.E-6)) ! MAX(4.99E-6, MIN(re_qi1d(k), 125.E-6)) - re_snow(i,k,j) = MAX(1.00E-5, MIN(re_qs1d(k), 999.E-6)) ! MAX(9.99E-6, MIN(re_qs1d(k), 999.E-6)) + re_cloud(i,k,j) = MAX(re_qc_min, MIN(re_qc1d(k), re_qc_max)) + re_ice(i,k,j) = MAX(re_qi_min, MIN(re_qi1d(k), re_qi_max)) + re_snow(i,k,j) = MAX(re_qs_min, MIN(re_qs1d(k), re_qs_max)) enddo ENDIF @@ -1631,7 +1648,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL:: r_frac, g_frac REAL:: Ef_rw, Ef_sw, Ef_gw, Ef_rr REAL:: Ef_ra, Ef_sa, Ef_ga - REAL:: dtsave, odts, odt, odzq, hgt_agl + REAL:: dtsave, odts, odt, odzq, hgt_agl, SR REAL:: xslw1, ygra1, zans1, eva_factor INTEGER:: i, k, k2, n, nn, nstep, k_0, kbot, IT, iexfrq INTEGER, DIMENSION(5):: ksed1 @@ -1785,14 +1802,17 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nwfa(k) = MAX(11.1E6, MIN(9999.E6, nwfa1d(k)*rho(k))) nifa(k) = MAX(naIN1*0.01, MIN(9999.E6, nifa1d(k)*rho(k))) mvd_r(k) = D0r + mvd_c(k) = D0c if (qc1d(k) .gt. R1) then no_micro = .false. rc(k) = qc1d(k)*rho(k) nc(k) = MAX(2., MIN(nc1d(k)*rho(k), Nt_c_max)) L_qc(k) = .true. - if (rand2 .eq. 0.0) then - nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + if (nc(k).gt.10000.E6) then + nu_c = 2 + elseif (nc(k).lt.100.) then + nu_c = 15 else nu_c = NINT(1000.E6/nc(k)) + 2 nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) @@ -1820,8 +1840,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ri(k) = qi1d(k)*rho(k) ni(k) = MAX(R2, ni1d(k)*rho(k)) if (ni(k).le. R2) then - lami = cie(2)/25.E-6 - ni(k) = MIN(499.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + lami = cie(2)/5.E-6 + ni(k) = MIN(9999.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) endif L_qi(k) = .true. lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi @@ -1829,7 +1849,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xDi = (bm_i + mu_i + 1.) * ilami if (xDi.lt. 5.E-6) then lami = cie(2)/5.E-6 - ni(k) = MIN(499.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + ni(k) = MIN(9999.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) elseif (xDi.gt. 300.E-6) then lami = cie(2)/300.E-6 ni(k) = cig(1)*oig2*ri(k)/am_i*lami**bm_i @@ -2033,26 +2053,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - N0_min = gonv_max - k_0 = kts - do k = kte, kts, -1 - if (temp(k).ge.270.65) k_0 = MAX(k_0, k) - enddo do k = kte, kts, -1 - if (k.gt.k_0 .and. L_qr(k) .and. mvd_r(k).gt.100.E-6) then - xslw1 = 4.01 + alog10(mvd_r(k)) - else - xslw1 = 0.01 - endif - ygra1 = 4.31 + alog10(max(5.E-5, rg(k))) - zans1 = (3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1))) + rand1 - if (rand1 .ne. 0.0) then - zans1 = MAX(2., MIN(zans1, 7.)) - endif + ygra1 = alog10(max(1.E-9, rg(k))) + zans1 = 3.0 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - N0_min = MIN(N0_exp, N0_min) - N0_exp = N0_min lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg ilamg(k) = 1./lamg @@ -2087,10 +2092,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pnr_rcr(k) = Ef_rr * 2.0*nr(k)*rr(k) endif - mvd_c(k) = D0c if (L_qc(k)) then - if (rand2 .eq. 0.0) then - nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + if (nc(k).gt.10000.E6) then + nu_c = 2 + elseif (nc(k).lt.100.) then + nu_c = 15 else nu_c = NINT(1000.E6/nc(k)) + 2 nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) @@ -2098,6 +2104,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xDc = MAX(D0c*1.E6, ((rc(k)/(am_r*nc(k)))**obmr) * 1.E6) lamc = (nc(k)*am_r* ccg(2,nu_c) * ocg1(nu_c) / rc(k))**obmr mvd_c(k) = (3.0+nu_c+0.672) / lamc + mvd_c(k) = MAX(D0c, MIN(mvd_c(k), D0r)) endif !> - Autoconversion follows Berry & Reinhardt (1974) with characteristic @@ -2113,7 +2120,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tau = 3.72/(rc(k)*taud) prr_wau(k) = zeta/tau prr_wau(k) = MIN(DBLE(rc(k)*odts), prr_wau(k)) - pnr_wau(k) = prr_wau(k) / (am_r*nu_c*D0r*D0r*D0r) ! RAIN2M + pnr_wau(k) = prr_wau(k) / (am_r*nu_c*200.*D0r*D0r*D0r) ! RAIN2M pnc_wau(k) = MIN(DBLE(nc(k)*odts), prr_wau(k) & / (am_r*mvd_c(k)*mvd_c(k)*mvd_c(k))) ! Qc2M endif @@ -2153,7 +2160,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ if (.not. iiwarm) then do k = kts, kte - vts_boost(k) = 1.5 + vts_boost(k) = 1.0 + xDs = 0.0 + if (L_qs(k)) xDs = smoc(k) / smob(k) !> - Temperature lookup table indexes. tempc = temp(k) - 273.15 @@ -2305,13 +2314,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Snow collecting cloud water. In CE, assume Dc< - Snow and graupel collecting aerosols, wet scavenging. if (rs(k) .gt. r_s(1)) then - xDs = smoc(k) / smob(k) Ef_sa = Eff_aero(xDs,0.04E-6,visco(k),rho(k),temp(k),'s') pna_sca(k) = rhof(k)*t1_qs_qc*Ef_sa*nwfa(k)*smoe(k) pna_sca(k) = MIN(DBLE(nwfa(k)*odts), pna_sca(k)) @@ -2387,6 +2394,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & + tnr_racs2(idx_s,idx_t,idx_r1,idx_r) & + tnr_sacr1(idx_s,idx_t,idx_r1,idx_r) & + tnr_sacr2(idx_s,idx_t,idx_r1,idx_r) + pnr_rcs(k) = MIN(DBLE(nr(k)*odts), pnr_rcs(k)) else prs_rcs(k) = -tcs_racs1(idx_s,idx_t,idx_r1,idx_r) & - tms_sacr1(idx_s,idx_t,idx_r1,idx_r) & @@ -2394,10 +2402,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & + tcr_sacr2(idx_s,idx_t,idx_r1,idx_r) prs_rcs(k) = MAX(DBLE(-rs(k)*odts), prs_rcs(k)) prr_rcs(k) = -prs_rcs(k) - pnr_rcs(k) = tnr_racs2(idx_s,idx_t,idx_r1,idx_r) & ! RAIN2M - + tnr_sacr2(idx_s,idx_t,idx_r1,idx_r) endif - pnr_rcs(k) = MIN(DBLE(nr(k)*odts), pnr_rcs(k)) endif !> - Rain collecting graupel. Cannot assume Wisner (1972) approximation @@ -2422,17 +2427,59 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & endif endif + if (temp(k).lt.T_0) then + rate_max = (qv(k)-qvsi(k))*rho(k)*odts*0.999 + +!> - Deposition/sublimation of snow/graupel follows Srivastava & Coen (1992) + if (L_qs(k)) then + C_snow = C_sqrd + (tempc+1.5)*(C_cube-C_sqrd)/(-30.+1.5) + C_snow = MAX(C_sqrd, MIN(C_snow, C_cube)) + prs_sde(k) = C_snow*t1_subl*diffu(k)*ssati(k)*rvs & + * (t1_qs_sd*smo1(k) & + + t2_qs_sd*rhof2(k)*vsc2(k)*smof(k)) + if (prs_sde(k).lt. 0.) then + prs_sde(k) = MAX(DBLE(-rs(k)*odts), prs_sde(k), DBLE(rate_max)) + else + prs_sde(k) = MIN(prs_sde(k), DBLE(rate_max)) + endif + endif + + if (L_qg(k) .and. ssati(k).lt. -eps) then + prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & + * N0_g(k) * (t1_qg_sd*ilamg(k)**cge(10) & + + t2_qg_sd*vsc2(k)*rhof2(k)*ilamg(k)**cge(11)) + if (prg_gde(k).lt. 0.) then + prg_gde(k) = MAX(DBLE(-rg(k)*odts), prg_gde(k), DBLE(rate_max)) + else + prg_gde(k) = MIN(prg_gde(k), DBLE(rate_max)) + endif + endif + +!> - A portion of rimed snow converts to graupel but some remains snow. +!! Interp from 15 to 95% as riming factor increases from 5.0 to 30.0 +!! 0.028 came from (.75-.15)/(30.-5.). This remains ad-hoc and should +!! be revisited. + if (prs_scw(k).gt.5.0*prs_sde(k) .and. & + prs_sde(k).gt.eps) then + r_frac = MIN(30.0D0, prs_scw(k)/prs_sde(k)) + g_frac = MIN(0.75, 0.15 + (r_frac-5.)*.028) + vts_boost(k) = MIN(1.5, 1.1 + (r_frac-5.)*.016) + prg_scw(k) = g_frac*prs_scw(k) + prs_scw(k) = (1. - g_frac)*prs_scw(k) + endif + + endif + !+---+-----------------------------------------------------------------+ !> - Next IF block handles only those processes below 0C. !+---+-----------------------------------------------------------------+ if (temp(k).lt.T_0) then - vts_boost(k) = 1.0 rate_max = (qv(k)-qvsi(k))*rho(k)*odts*0.999 !+---+---------------- BEGIN NEW ICE NUCLEATION -----------------------+ -!> - Begin NEW ICE NUCLEATION: Freezing of supercooled water (rain or cloud) is influenced by dust +!> - Freezing of supercooled water (rain or cloud) is influenced by dust !! but still using Bigg 1953 with a temperature adjustment of a few !! degrees depending on dust concentration. A default value by way !! of idx_IN is 1.0 per Liter of air is used when dustyIce flag is @@ -2475,7 +2522,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pnr_rfz(k) = MIN(DBLE(nr(k)*odts), pnr_rfz(k)) elseif (rr(k).gt. R1 .and. temp(k).lt.HGFR) then pri_rfz(k) = rr(k)*odts - pnr_rfz(k) = nr(k)*odts ! RAIN2M pni_rfz(k) = pnr_rfz(k) endif @@ -2496,7 +2542,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & .and. temp(k).lt.253.15) ) then if (dustyIce .AND. is_aerosol_aware) then xnc = iceDeMott(tempc,qv(k),qvs(k),qvsi(k),rho(k),nifa(k)) - xnc = xnc*(1.0 + 3.*rand3) + xnc = xnc*(1.0 + 50.*rand3) else xnc = MIN(250.E3, TNO*EXP(ATO*(T_0-temp(k)))) endif @@ -2508,7 +2554,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Freezing of aqueous aerosols based on Koop et al (2001, Nature) xni = smo0(k)+ni(k) + (pni_rfz(k)+pni_wfz(k)+pni_inu(k))*dtsave - if (is_aerosol_aware .AND. homogIce .AND. (xni.le.500.E3) & + if (is_aerosol_aware .AND. homogIce .AND. (xni.le.999.E3) & & .AND.(temp(k).lt.238).AND.(ssati(k).ge.0.4) ) then xnc = iceKoop(temp(k),qv(k),qvs(k),nwfa(k), dtsave) pni_iha(k) = xnc*odts @@ -2554,32 +2600,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & endif endif -!> - Deposition/sublimation of snow/graupel follows Srivastava & Coen -!! (1992). - if (L_qs(k)) then - C_snow = C_sqrd + (tempc+1.5)*(C_cube-C_sqrd)/(-30.+1.5) - C_snow = MAX(C_sqrd, MIN(C_snow, C_cube)) - prs_sde(k) = C_snow*t1_subl*diffu(k)*ssati(k)*rvs & - * (t1_qs_sd*smo1(k) & - + t2_qs_sd*rhof2(k)*vsc2(k)*smof(k)) - if (prs_sde(k).lt. 0.) then - prs_sde(k) = MAX(DBLE(-rs(k)*odts), prs_sde(k), DBLE(rate_max)) - else - prs_sde(k) = MIN(prs_sde(k), DBLE(rate_max)) - endif - endif - - if (L_qg(k) .and. ssati(k).lt. -eps) then - prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & - * N0_g(k) * (t1_qg_sd*ilamg(k)**cge(10) & - + t2_qg_sd*vsc2(k)*rhof2(k)*ilamg(k)**cge(11)) - if (prg_gde(k).lt. 0.) then - prg_gde(k) = MAX(DBLE(-rg(k)*odts), prg_gde(k), DBLE(rate_max)) - else - prg_gde(k) = MIN(prg_gde(k), DBLE(rate_max)) - endif - endif - !> - Snow collecting cloud ice. In CE, assume Di< - A portion of rimed snow converts to graupel but some remains snow. -!! Interp from 15 to 95% as riming factor increases from 2.0 to 30.0 -!! 0.028 came from (.95-.15)/(30.-2.). This remains ad-hoc and should -!! be revisited. - if (prs_scw(k).gt.2.0*prs_sde(k) .and. & - prs_sde(k).gt.eps) then - r_frac = MIN(30.0D0, prs_scw(k)/prs_sde(k)) - g_frac = MIN(0.95, 0.15 + (r_frac-2.)*.028) - vts_boost(k) = MIN(1.5, 1.1 + (r_frac-2.)*.016) - prg_scw(k) = g_frac*prs_scw(k) - prs_scw(k) = (1. - g_frac)*prs_scw(k) - endif - else !> - Melt snow and graupel and enhance from collisions with liquid. @@ -2643,12 +2650,13 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & if (L_qs(k)) then prr_sml(k) = (tempc*tcond(k)-lvap0*diffu(k)*delQvs(k)) & * (t1_qs_me*smo1(k) + t2_qs_me*rhof2(k)*vsc2(k)*smof(k)) - prr_sml(k) = prr_sml(k) + 4218.*olfus*tempc & - * (prr_rcs(k)+prs_scw(k)) + if (prr_sml(k) .gt. 0.) then + prr_sml(k) = prr_sml(k) + 4218.*olfus*tempc & + * (prr_rcs(k)+prs_scw(k)) + endif prr_sml(k) = MIN(DBLE(rs(k)*odts), MAX(0.D0, prr_sml(k))) pnr_sml(k) = smo0(k)/rs(k)*prr_sml(k) * 10.0**(-0.25*tempc) ! RAIN2M pnr_sml(k) = MIN(DBLE(smo0(k)*odts), pnr_sml(k)) -! if (tempc.gt.3.5 .or. rs(k).lt.0.005E-3) pnr_sml(k)=0.0 if (ssati(k).lt. 0.) then prs_sde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & @@ -2667,7 +2675,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prr_gml(k) = MIN(DBLE(rg(k)*odts), MAX(0.D0, prr_gml(k))) pnr_gml(k) = N0_g(k)*cgg(2)*ilamg(k)**cge(2) / rg(k) & ! RAIN2M * prr_gml(k) * 10.0**(-0.5*tempc) -! if (tempc.gt.7.5 .or. rg(k).lt.0.005E-3) pnr_gml(k)=0.0 if (ssati(k).lt. 0.) then prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & @@ -2677,7 +2684,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & endif endif -!> - This change will be required if users run adaptive time step that +!> - This change will be required if users run adaptive time step that !! results in delta-t that is generally too long to allow cloud water !! collection by snow/graupel above melting temperature. !! Credit to Bjorn-Egil Nygaard for discovering. @@ -2835,8 +2842,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xrc=MAX(R1, (qc1d(k) + qcten(k)*dtsave)*rho(k)) xnc=MAX(2., (nc1d(k) + ncten(k)*dtsave)*rho(k)) if (xrc .gt. R1) then - if (rand2 .eq. 0.0) then - nu_c = MIN(15, NINT(1000.E6/xnc) + 2) + if (xnc.gt.10000.E6) then + nu_c = 2 + elseif (xnc.lt.100.) then + nu_c = 15 else nu_c = NINT(1000.E6/xnc) + 2 nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) @@ -2881,7 +2890,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xDi = (bm_i + mu_i + 1.) * ilami if (xDi.lt. 5.E-6) then lami = cie(2)/5.E-6 - xni = MIN(499.D3, cig(1)*oig2*xri/am_i*lami**bm_i) + xni = MIN(9999.D3, cig(1)*oig2*xri/am_i*lami**bm_i) niten(k) = (xni-ni1d(k)*rho(k))*odts*orho elseif (xDi.gt. 300.E-6) then lami = cie(2)/300.E-6 @@ -2905,7 +2914,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Rain number tendency nrten(k) = nrten(k) + (pnr_wau(k) + pnr_sml(k) + pnr_gml(k) & - (pnr_rfz(k) + pnr_rcr(k) + pnr_rcg(k) & - + pnr_rcs(k) + pnr_rci(k)) ) & + + pnr_rcs(k) + pnr_rci(k) + pni_rfz(k)) ) & * orho !> - Rain mass/number balance; keep median volume diameter between @@ -2993,7 +3002,9 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & lvt2(k)=lvap(k)*lvap(k)*ocp(k)*oRv*otemp*otemp nwfa(k) = MAX(11.1E6, (nwfa1d(k) + nwfaten(k)*DT)*rho(k)) + enddo + do k = kts, kte if ((qc1d(k) + qcten(k)*DT) .gt. R1) then rc(k) = (qc1d(k) + qcten(k)*DT)*rho(k) nc(k) = MAX(2., MIN((nc1d(k)+ncten(k)*DT)*rho(k), Nt_c_max)) @@ -3118,26 +3129,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !+---+-----------------------------------------------------------------+ !> - Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ - N0_min = gonv_max - k_0 = kts - do k = kte, kts, -1 - if (temp(k).ge.270.65) k_0 = MAX(k_0, k) - enddo do k = kte, kts, -1 - if (k.gt.k_0 .and. L_qr(k) .and. mvd_r(k).gt.100.E-6) then - xslw1 = 4.01 + alog10(mvd_r(k)) - else - xslw1 = 0.01 - endif - ygra1 = 4.31 + alog10(max(5.E-5, rg(k))) - zans1 = (3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1))) + rand1 - if (rand1 .ne. 0.0) then - zans1 = MAX(2., MIN(zans1, 7.)) - endif + ygra1 = alog10(max(1.E-9, rg(k))) + zans1 = 3.0 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - N0_min = MIN(N0_exp, N0_min) - N0_exp = N0_min lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg ilamg(k) = 1./lamg @@ -3313,11 +3309,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !..TEST: G. Thompson 10 May 2013 !> - Reduce the rain evaporation in same places as melting graupel occurs. -!Rationale: falling and simultaneous melting graupel in subsaturated -!regions will not melt as fast because particle temperature stays -!..at 0C. Also not much shedding of the water from the graupel so -!..likely that the water-coated graupel evaporating much slower than -!..if the water was immediately shed off. +!! Rationale: falling and simultaneous melting graupel in subsaturated +!! regions will not melt as fast because particle temperature stays +!! at 0C. Also not much shedding of the water from the graupel so +!! likely that the water-coated graupel evaporating much slower than +!! if the water was immediately shed off. IF (prr_gml(k).gt.0.0) THEN eva_factor = MIN(1.0, 0.01+(0.99-0.01)*(tempc/20.0)) prv_rev(k) = prv_rev(k)*eva_factor @@ -3420,8 +3416,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & do k = ksed1(5), kts, -1 vtc = 0. if (rc(k) .gt. R1 .and. w1d(k) .lt. 1.E-1) then - if (rand2 .eq. 0.0) then - nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) + if (nc(k).gt.10000.E6) then + nu_c = 2 + elseif (nc(k).lt.100.) then + nu_c = 15 else nu_c = NINT(1000.E6/nc(k)) + 2 nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) @@ -3490,13 +3488,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & t4_vts = Kap1*Mrat**mu_s*csg(7)*ils2**cse(7) vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts) if (temp(k).gt. (T_0+0.1)) then - vtsk(k) = MAX(vts*vts_boost(k), & - & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) ! -! DH* The version below is supposed to be a better formulation, -! but gave worse results in RAPv5/HRRRv4 than the line above. - ! this formulation for RAPv5/HRRRv4, reverted 20 Feb 2020 - ! SR = rs(k)/(rs(k)+rr(k)) ! bug fix from G. Thompson, 10 May 2019 - ! vtsk(k) = vts*SR + (1.-SR)*vtrk(k) +! vtsk(k) = MAX(vts*vts_boost(k), & +! & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) + SR = rs(k)/(rs(k)+rr(k)) + vtsk(k) = vts*SR + (1.-SR)*vtrk(k) else vtsk(k) = vts*vts_boost(k) endif @@ -3547,10 +3542,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !> - Sedimentation of mixing ratio is the integral of v(D)*m(D)*N(D)*dD, !! whereas neglect m(D) term for number concentration. Therefore, !! cloud ice has proper differential sedimentation. -!.. New in v3.0+ is computing separate for rain, ice, snow, and -!.. graupel species thus making code faster with credit to J. Schmidt. -!.. Bug fix, 2013Nov01 to tendencies using rho(k+1) correction thanks to -!.. Eric Skyllingstad. !+---+-----------------------------------------------------------------+ if (ANY(L_qr .eqv. .true.)) then @@ -3580,11 +3571,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(1)) enddo -#if 1 if (rr(kts).gt.R1*10.) & -#else - if (rr(kts).gt.R1*1000.) & -#endif pptrain = pptrain + sed_r(kts)*DT*onstep(1) enddo endif @@ -3635,11 +3622,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(2)) enddo -#if 1 if (ri(kts).gt.R1*10.) & -#else - if (ri(kts).gt.R1*1000.) & -#endif pptice = pptice + sed_i(kts)*DT*onstep(2) enddo endif @@ -3666,11 +3649,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(3)) enddo -#if 1 if (rs(kts).gt.R1*10.) & -#else - if (rs(kts).gt.R1*1000.) & -#endif pptsnow = pptsnow + sed_s(kts)*DT*onstep(3) enddo endif @@ -3697,11 +3676,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(4)) enddo -#if 1 if (rg(kts).gt.R1*10.) & -#else - if (rg(kts).gt.R1*1000.) & -#endif pptgraul = pptgraul + sed_g(kts)*DT*onstep(4) enddo endif @@ -3742,19 +3717,21 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qv1d(k) = MAX(1.E-10, qv1d(k) + qvten(k)*DT) qc1d(k) = qc1d(k) + qcten(k)*DT nc1d(k) = MAX(2./rho(k), MIN(nc1d(k) + ncten(k)*DT, Nt_c_max)) - nwfa1d(k) = MAX(11.1E6/rho(k), MIN(9999.E6/rho(k), & + nwfa1d(k) = MAX(11.1E6, MIN(9999.E6, & (nwfa1d(k)+nwfaten(k)*DT))) - nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6/rho(k), & + nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6, & (nifa1d(k)+nifaten(k)*DT))) if (qc1d(k) .le. R1) then qc1d(k) = 0.0 nc1d(k) = 0.0 else - if (rand2 .eq. 0.0) then - nu_c = MIN(15, NINT(1000.E6/(nc1d(k)*rho(k))) + 2) + if (nc1d(k)*rho(k).gt.10000.E6) then + nu_c = 2 + elseif (nc1d(k)*rho(k).lt.100.) then + nu_c = 15 else - nu_c = NINT(1000.E6/(nc1d(k)*rho(k))) + 2 - nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) + nu_c = NINT(1000.E6/(nc1d(k)*rho(k)) + 2 + nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) endif lamc = (am_r*ccg(2,nu_c)*ocg1(nu_c)*nc1d(k)/qc1d(k))**obmr xDc = (bm_r + nu_c + 1.) / lamc @@ -3782,7 +3759,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & lami = cie(2)/300.E-6 endif ni1d(k) = MIN(cig(1)*oig2*qi1d(k)/am_i*lami**bm_i, & - 499.D3/rho(k)) + 9999.D3/rho(k)) endif qr1d(k) = qr1d(k) + qrten(k)*DT nr1d(k) = MAX(R2/rho(k), nr1d(k) + nrten(k)*DT) @@ -3837,13 +3814,12 @@ subroutine qr_acr_qg good = 0 - INQUIRE(FILE="qr_acr_qg.dat",EXIST=lexist) + INQUIRE(FILE=qr_acr_qg_file, EXIST=lexist) #ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) #endif IF ( lexist ) THEN - !write(0,*) "ThompMP: read qr_acr_qg.dat instead of computing" - OPEN(63,file="qr_acr_qg.dat",form="unformatted",err=1234) + OPEN(63,file=qr_acr_qg_file,form="unformatted",err=1234) !sms$serial begin READ(63,err=1234) tcg_racg READ(63,err=1234) tmr_racg @@ -3858,13 +3834,13 @@ subroutine qr_acr_qg INQUIRE(63,opened=lopen) IF (lopen) THEN IF( force_read_thompson ) THEN - write(0,*) "Error reading qr_acr_qg.dat. Aborting because force_read_thompson is .true." + write(0,*) "Error reading "//qr_acr_qg_file//" Aborting because force_read_thompson is .true." return ENDIF CLOSE(63) ELSE IF( force_read_thompson ) THEN - write(0,*) "Error opening qr_acr_qg.dat. Aborting because force_read_thompson is .true." + write(0,*) "Error opening "//qr_acr_qg_file//" Aborting because force_read_thompson is .true." return ENDIF ENDIF @@ -3876,7 +3852,7 @@ subroutine qr_acr_qg ENDIF ELSE IF( force_read_thompson ) THEN - write(0,*) "Non-existent qr_acr_qg.dat. Aborting because force_read_thompson is .true." + write(0,*) "Non-existent "//qr_acr_qg_file//" Aborting because force_read_thompson is .true." return ENDIF ENDIF @@ -3959,7 +3935,7 @@ subroutine qr_acr_qg tcg_racg(i,j,k,m) = t1 tmr_racg(i,j,k,m) = DMIN1(z1, r_r(m)*1.0d0) tcr_gacr(i,j,k,m) = t2 - tmg_gacr(i,j,k,m) = z2 + tmg_gacr(i,j,k,m) = DMIN1(z2, r_g(j)*1.0d0) tnr_racg(i,j,k,m) = y1 tnr_gacr(i,j,k,m) = y2 enddo @@ -3967,8 +3943,8 @@ subroutine qr_acr_qg enddo IF ( write_thompson_tables ) THEN - write(0,*) "Writing qr_acr_qg.dat in Thompson MP init" - OPEN(63,file="qr_acr_qg.dat",form="unformatted",err=9234) + write(0,*) "Writing "//qr_acr_qg_file//" in Thompson MP init" + OPEN(63,file=qr_acr_qg_file,form="unformatted",err=9234) WRITE(63,err=9234) tcg_racg WRITE(63,err=9234) tmr_racg WRITE(63,err=9234) tcr_gacr @@ -3978,7 +3954,7 @@ subroutine qr_acr_qg CLOSE(63) RETURN ! ----- RETURN 9234 CONTINUE - write(0,*) "Error writing qr_acr_qg.dat" + write(0,*) "Error writing //qr_acr_qg_file return ENDIF ENDIF @@ -4013,13 +3989,13 @@ subroutine qr_acr_qs write_thompson_tables = .false. good = 0 - INQUIRE(FILE="qr_acr_qs.dat",EXIST=lexist) + INQUIRE(FILE=qr_acr_qs_file, EXIST=lexist) #ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) #endif IF ( lexist ) THEN - !write(0,*) "ThompMP: read qr_acr_qs.dat instead of computing" - OPEN(63,file="qr_acr_qs.dat",form="unformatted",err=1234) + !write(0,*) "ThompMP: read "//qr_acr_qs_file//" instead of computing" + OPEN(63,file=qr_acr_qs_file,form="unformatted",err=1234) !sms$serial begin READ(63,err=1234)tcs_racs1 READ(63,err=1234)tmr_racs1 @@ -4040,13 +4016,13 @@ subroutine qr_acr_qs INQUIRE(63,opened=lopen) IF (lopen) THEN IF( force_read_thompson ) THEN - write(0,*) "Error reading qr_acr_qs.dat. Aborting because force_read_thompson is .true." + write(0,*) "Error reading "//qr_acr_qs_file//" Aborting because force_read_thompson is .true." return ENDIF CLOSE(63) ELSE IF( force_read_thompson ) THEN - write(0,*) "Error opening qr_acr_qs.dat. Aborting because force_read_thompson is .true." + write(0,*) "Error opening "//qr_acr_qs_file//" Aborting because force_read_thompson is .true." return ENDIF ENDIF @@ -4058,7 +4034,7 @@ subroutine qr_acr_qs ENDIF ELSE IF( force_read_thompson ) THEN - write(0,*) "Non-existent qr_acr_qs.dat. Aborting because force_read_thompson is .true." + write(0,*) "Non-existent "//qr_acr_qs_file//" Aborting because force_read_thompson is .true." return ENDIF ENDIF @@ -4219,8 +4195,8 @@ subroutine qr_acr_qs enddo IF ( write_thompson_tables ) THEN - write(0,*) "Writing qr_acr_qs.dat in Thompson MP init" - OPEN(63,file="qr_acr_qs.dat",form="unformatted",err=9234) + write(0,*) "Writing "//qr_acr_qs_file//" in Thompson MP init" + OPEN(63,file=qr_acr_qs_file,form="unformatted",err=9234) WRITE(63,err=9234)tcs_racs1 WRITE(63,err=9234)tmr_racs1 WRITE(63,err=9234)tcs_racs2 @@ -4236,7 +4212,7 @@ subroutine qr_acr_qs CLOSE(63) RETURN ! ----- RETURN 9234 CONTINUE - write(0,*) "Error writing qr_acr_qs.dat" + write(0,*) "Error writing "//qr_acr_qs_file ENDIF ENDIF @@ -4274,13 +4250,13 @@ subroutine freezeH2O(threads) write_thompson_tables = .false. good = 0 - INQUIRE(FILE="freezeH2O.dat",EXIST=lexist) + INQUIRE(FILE=freeze_h2o_file",EXIST=lexist) #ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) #endif IF ( lexist ) THEN - !write(0,*) "ThompMP: read freezeH2O.dat instead of computing" - OPEN(63,file="freezeH2O.dat",form="unformatted",err=1234) + !write(0,*) "ThompMP: read "//freeze_h2o_file//" instead of computing" + OPEN(63,file=freeze_h2o_file,form="unformatted",err=1234) !sms$serial begin READ(63,err=1234)tpi_qrfz READ(63,err=1234)tni_qrfz @@ -4295,13 +4271,13 @@ subroutine freezeH2O(threads) INQUIRE(63,opened=lopen) IF (lopen) THEN IF( force_read_thompson ) THEN - write(0,*) "Error reading freezeH2O.dat. Aborting because force_read_thompson is .true." + write(0,*) "Error reading "//freeze_h2o_file//" Aborting because force_read_thompson is .true." return ENDIF CLOSE(63) ELSE IF( force_read_thompson ) THEN - write(0,*) "Error opening freezeH2O.dat. Aborting because force_read_thompson is .true." + write(0,*) "Error opening "//freeze_h2o_file//" Aborting because force_read_thompson is .true." return ENDIF ENDIF @@ -4313,7 +4289,7 @@ subroutine freezeH2O(threads) ENDIF ELSE IF( force_read_thompson ) THEN - write(0,*) "Non-existent freezeH2O.dat. Aborting because force_read_thompson is .true." + write(0,*) "Non-existent "//freeze_h2o_file//" Aborting because force_read_thompson is .true." return ENDIF ENDIF @@ -4397,8 +4373,8 @@ subroutine freezeH2O(threads) enddo IF ( write_thompson_tables ) THEN - write(0,*) "Writing freezeH2O.dat in Thompson MP init" - OPEN(63,file="freezeH2O.dat",form="unformatted",err=9234) + write(0,*) "Writing "//freeze_h2o_file//" in Thompson MP init" + OPEN(63,file=freeze_h2o_file,form="unformatted",err=9234) WRITE(63,err=9234)tpi_qrfz WRITE(63,err=9234)tni_qrfz WRITE(63,err=9234)tpg_qrfz @@ -4408,7 +4384,7 @@ subroutine freezeH2O(threads) CLOSE(63) RETURN ! ----- RETURN 9234 CONTINUE - write(0,*) "Error writing freezeH2O.dat" + write(0,*) "Error writing "//freeze_h2o_file return ENDIF ENDIF @@ -5120,7 +5096,7 @@ real function iceDeMott(tempc, qv, qvs, qvsi, rho, nifa) ! mux = hx*p_alpha*n_in*rho ! xni = mux*((6700.*nifa)-200.)/((6700.*5.E5)-200.) ! elseif (satw.ge.0.985 .and. tempc.gt.HGFR-273.15) then - nifa_cc = nifa*RHO_NOT0*1.E-6/rho + nifa_cc = MAX(0.5, nifa*RHO_NOT0*1.E-6/rho) ! xni = 3.*nifa_cc**(1.25)*exp((0.46*(-tempc))-11.6) ! [DeMott, 2015] xni = (5.94e-5*(-tempc)**3.33) & ! [DeMott, 2010] * (nifa_cc**((-0.0264*(tempc))+0.0033)) @@ -5233,23 +5209,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & has_qi = .false. has_qs = .false. -! DH* 2020-06-08 Moved the initial values and bounds from -! the calling routines into calc_effectRad (to prevent -! multiple definitions that may be inconsistent). The -! initial values and bounds from the calling routines were -! -! re_cloud(i,k) = MAX(2.49, MIN(re_cloud(i,k)*1.e6, 50.)) -! re_ice(i,k) = MAX(4.99, MIN(re_ice(i,k)*1.e6, 125.)) -! re_snow(i,k) = MAX(9.99, MIN(re_snow(i,k)*1.e6, 999.)) -! -! independent of the version of Thompson MP. These values -! are consistent with the WRFv3.8.1 settings, but inconsistent -! with the WRFv4+ settings. In order to apply the same bounds -! as before this change, use the WRF v3.8.1 settings throughout. - re_qc1d(:) = 2.50E-6 ! 2.49E-6 - re_qi1d(:) = 5.00E-6 ! 4.99E-6 - re_qs1d(:) = 1.00E-5 ! 9.99E-6 - do k = kts, kte rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) rc(k) = MAX(R1, qc1d(k)*rho(k)) @@ -5274,7 +5233,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & inu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) endif lamc = (nc(k)*am_r*g_ratio(inu_c)/rc(k))**obmr - re_qc1d(k) = MAX(2.51E-6, MIN(SNGL(0.5D0 * DBLE(3.+inu_c)/lamc), 50.E-6)) + re_qc1d(k) = SNGL(0.5D0 * DBLE(3.+inu_c)/lamc) enddo endif @@ -5282,7 +5241,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & do k = kts, kte if (ri(k).le.R1 .or. ni(k).le.R2) CYCLE lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi - re_qi1d(k) = MAX(5.01E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) + re_qi1d(k) = SNGL(0.5D0 * DBLE(3.+mu_i)/lami) enddo endif @@ -5322,7 +5281,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & & + sb(7)*tc0*tc0*cse(1) + sb(8)*tc0*cse(1)*cse(1) & & + sb(9)*tc0*tc0*tc0 + sb(10)*cse(1)*cse(1)*cse(1) smoc = a_ * smo2**b_ - re_qs1d(k) = MAX(1.01E-5, MIN(0.5*(smoc/smob), 999.E-6)) + re_qs1d(k) = 0.5*(smoc/smob) enddo endif @@ -5441,8 +5400,15 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ !..Calculate y-intercept, slope, and useful moments for snow. !+---+-----------------------------------------------------------------+ + do k = kts, kte + smo2(k) = 0. + smob(k) = 0. + smoc(k) = 0. + smoz(k) = 0. + enddo if (ANY(L_qs .eqv. .true.)) then do k = kts, kte + if (.not. L_qs(k)) CYCLE tc0 = MIN(-0.1, temp(k)-273.15) smob(k) = rs(k)*oams @@ -5498,26 +5464,11 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ if (ANY(L_qg .eqv. .true.)) then - N0_min = gonv_max - k_0 = kts - do k = kte, kts, -1 - if (temp(k).ge.270.65) k_0 = MAX(k_0, k) - enddo do k = kte, kts, -1 - if (k.gt.k_0 .and. L_qr(k) .and. mvd_r(k).gt.100.E-6) then - xslw1 = 4.01 + alog10(mvd_r(k)) - else - xslw1 = 0.01 - endif - ygra1 = 4.31 + alog10(max(5.E-5, rg(k))) - zans1 = (3.1 + (100./(300.*xslw1*ygra1/(10./xslw1+1.+0.25*ygra1)+30.+10.*ygra1))) + rand1 - if (rand1 .ne. 0.0) then - zans1 = MAX(2., MIN(zans1, 7.)) - endif + ygra1 = alog10(max(1.E-9, rg(k))) + zans1 = 3.0 + 2./7.*(ygra1+8.) + rand1 N0_exp = 10.**(zans1) N0_exp = MAX(DBLE(gonv_min), MIN(N0_exp, DBLE(gonv_max))) - N0_min = MIN(N0_exp, N0_min) - N0_exp = N0_min lam_exp = (N0_exp*am_g*cgg(1)/rg(k))**oge1 lamg = lam_exp * (cgg(3)*ogg2*ogg1)**obmg ilamg(k) = 1./lamg @@ -5666,7 +5617,7 @@ end subroutine calc_refl10cm #ifdef SION !>\ingroup aathompson - subroutine readwrite_tables(mode, mpicomm, mpirank, mpiroot, ierr) + subroutine readwrite_tables(filename, mode, mpicomm, mpirank, mpiroot, ierr) #ifdef MPI use mpi @@ -5676,6 +5627,7 @@ subroutine readwrite_tables(mode, mpicomm, mpirank, mpiroot, ierr) implicit none ! Interface variables + character(len=*), intent(in) :: filename character(len=*), intent(in) :: mode integer, intent(in) :: mpicomm integer, intent(in) :: mpirank @@ -5702,7 +5654,6 @@ subroutine readwrite_tables(mode, mpicomm, mpirank, mpiroot, ierr) logical :: exists integer*8 :: tables_size real*8 :: checksum - character(len=*), parameter :: filename = 'thompson_tables_precomp.sl' integer :: i From 68113c9989ddaa203a7c84a1dabbc58adcc86f39 Mon Sep 17 00:00:00 2001 From: Greg Thompson Date: Sat, 13 Feb 2021 11:50:04 -0700 Subject: [PATCH 204/274] simplify initialization a bit and add convert_dry_rho flag --- physics/module_mp_thompson.F90 | 17 +-- physics/mp_thompson.F90 | 245 +++++++++++---------------------- 2 files changed, 86 insertions(+), 176 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index fcbcb8164..444e867ae 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -219,7 +219,7 @@ MODULE module_mp_thompson REAL, PRIVATE:: D0i, xm0s, xm0g !..Min and max radiative effective radius of cloud water, cloud ice, and snow; -!.. performed by subroutine calc_effectRad +!.. performed by subroutine calc_effectRad. On purpose, these should stay PUBLIC. REAL, PARAMETER:: re_qc_min = 2.50E-6 ! 2.5 microns REAL, PARAMETER:: re_qc_max = 50.0E-6 ! 50 microns REAL, PARAMETER:: re_qi_min = 2.50E-6 ! 2.5 microns @@ -440,24 +440,17 @@ MODULE module_mp_thompson !! lookup tables in Thomspson scheme. !>\section gen_thompson_init thompson_init General Algorithm !> @{ - SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & - mpicomm, mpirank, mpiroot, & + SUBROUTINE thompson_init(mpicomm, mpirank, mpiroot, & threads, errmsg, errflg) IMPLICIT NONE -!..OPTIONAL variables that control application of aerosol-aware scheme - - REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: nwfa, nifa - REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: nwfa2d, nifa2d INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg INTEGER, INTENT(INOUT) :: errflg - INTEGER:: i, j, k, l, m, n - REAL:: h_01, airmass, niIN3, niCCN3, max_test LOGICAL:: micro_init real :: stime, etime #ifdef SION @@ -467,14 +460,8 @@ SUBROUTINE thompson_init(nwfa2d, nifa2d, nwfa, nifa, & LOGICAL, PARAMETER :: precomputed_tables = .FALSE. #endif - is_aerosol_aware = .FALSE. micro_init = .FALSE. - if (present(nwfa2d) .and. & - present(nifa2d) .and. & - present(nwfa) .and. & - present(nifa) ) is_aerosol_aware = .true. - !> - Allocate space for lookup tables (J. Michalakes 2009Jun08). if (.NOT. ALLOCATED(tcg_racg) ) then diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index ec19945b0..e22d82316 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -10,6 +10,7 @@ module mp_thompson use module_mp_thompson, only : thompson_init, mp_gt_driver, thompson_finalize, calc_effectRad use module_mp_thompson, only : naIN0, naIN1, naCCN0, naCCN1, eps, Nt_c + use module_mp_thompson, only : re_qc_min, re_qc_max, re_qi_min, re_qi_max, re_qs_min, re_qs_max use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber, make_RainNumber @@ -20,6 +21,7 @@ module mp_thompson private logical :: is_initialized = .False. + logical :: convert_dry_rho = .False. contains @@ -80,17 +82,8 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & character(len=*), intent( out) :: errmsg integer, intent( out) :: errflg - ! Hydrometeors - real(kind_phys) :: qv_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qc_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qr_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qi_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qs_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qg_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: ni_mp(1:ncol,1:nlev) !< kg-1 - real(kind_phys) :: nr_mp(1:ncol,1:nlev) !< kg-1 - real(kind_phys) :: nc_mp(1:ncol,1:nlev) !< kg-1 ! + real(kind_phys) :: qv(1:ncol,1:nlev) ! kg kg-1 (water vapor mixing ratio) real(kind_phys) :: hgt(1:ncol,1:nlev) ! m real(kind_phys) :: rho(1:ncol,1:nlev) ! kg m-3 real(kind_phys) :: orho(1:ncol,1:nlev) ! m3 kg-1 @@ -120,16 +113,9 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & end if ! Call Thompson init - if (is_aerosol_aware) then - call thompson_init(nwfa2d=nwfa2d, nifa2d=nifa2d, nwfa=nwfa, nifa=nifa, & - mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads, errmsg=errmsg, errflg=errflg) - if (errflg /= 0) return - else - call thompson_init(mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads, errmsg=errmsg, errflg=errflg) - if (errflg /= 0) return - end if + call thompson_init(mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & + threads=threads, errmsg=errmsg, errflg=errflg) + if (errflg /= 0) return ! For restart runs, the init is done here if (restart) then @@ -137,25 +123,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & return end if - ! Fix initial values of hydrometeors - where(spechum<0) spechum = 0.0 - where(qc<0) qc = 0.0 - where(qr<0) qr = 0.0 - where(qi<0) qi = 0.0 - where(qs<0) qs = 0.0 - where(qg<0) qg = 0.0 - where(ni<0) ni = 0.0 - where(nr<0) nr = 0.0 - - if (is_aerosol_aware) then - ! Fix initial values of aerosols - where(nc<0) nc = 0.0 - where(nwfa<0) nwfa = 0.0 - where(nifa<0) nifa = 0.0 - where(nwfa2d<0) nwfa2d = 0.0 - where(nifa2d<0) nifa2d = 0.0 - end if - ! Geopotential height in m2 s-2 to height in m hgt = phil/con_g @@ -163,49 +130,33 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & rho = prsl/(con_rd*tgrs) orho = 1.0/rho - ! Prior to calling the functions: make_DropletNumber, make_IceNumber, make_RainNumber, - ! the incoming mixing ratios should be converted to units of mass/num per cubic meter - ! rather than per kg of air. So, to pass back to the model state variables, - ! they also need to be switched back to mass/number per kg of air, because - ! what is returned by the functions is in units of number per cubic meter. - ! They also need to be converted to dry mixing ratios. - - !> - Convert specific humidity/moist mixing ratios to dry mixing ratios - qv_mp = spechum/(1.0_kind_phys-spechum) - qc_mp = qc/(1.0_kind_phys-spechum) - qr_mp = qr/(1.0_kind_phys-spechum) - qi_mp = qi/(1.0_kind_phys-spechum) - qs_mp = qs/(1.0_kind_phys-spechum) - qg_mp = qg/(1.0_kind_phys-spechum) - - !> - Convert number concentrations from moist to dry - ni_mp = ni/(1.0_kind_phys-spechum) - nr_mp = nr/(1.0_kind_phys-spechum) - if (is_aerosol_aware) then - nc_mp = nc/(1.0_kind_phys-spechum) - end if + ! Ensure non-negative mass mixing ratios of all water variables + where(spechum<0) spechum = 1.0E-10 ! COMMENT, gthompsn, spechum should *never* be identically zero. + where(qc<0) qc = 0.0 + where(qr<0) qr = 0.0 + where(qi<0) qi = 0.0 + where(qs<0) qs = 0.0 + where(qg<0) qg = 0.0 - ! If qi is in boundary conditions but ni is not, calculate ni from qi, rho and tgrs - if (maxval(qi_mp)>0.0 .and. maxval(ni_mp)==0.0) then - ni_mp = make_IceNumber(qi_mp*rho, tgrs) * orho - end if + ! Convert specific humidity to water vapor mixing ratio + qv = spechum/(1.0_kind_phys-spechum) - ! If ni is in boundary conditions but qi is not, reset ni to zero - if (maxval(ni_mp)>0.0 .and. maxval(qi_mp)==0.0) ni_mp = 0.0 + ! Ensure we have 1st guess ice number where mass non-zero but no number. + where(qi <= 0.0) ni=0.0 + where(qi > 0 .and. ni <= 0.0) ni = make_IceNumber(qi*rho, tgrs) * orho + where(qi = 0.0 .and. ni > 0.0) ni=0.0 - ! If qr is in boundary conditions but nr is not, calculate nr from qr, rho and tgrs - if (maxval(qr_mp)>0.0 .and. maxval(nr_mp)==0.0) then - nr_mp = make_RainNumber(qr_mp*rho, tgrs) * orho - end if + ! Ensure we have 1st guess rain number where mass non-zero but no number. + where(qr <= 0.0) nr=0.0 + where(qr > 0 .and. nr <= 0.0) nr = make_RainNumber(qr*rho, tgrs) * orho + where(qr = 0.0 .and. nr > 0.0) nr=0.0 - ! If nr is in boundary conditions but qr is not, reset nr to zero - if (maxval(nr_mp)>0.0 .and. maxval(qr_mp)==0.0) nr_mp = 0.0 !..Check for existing aerosol data, both CCN and IN aerosols. If missing !.. fill in just a basic vertical profile, somewhat boundary-layer following. if (is_aerosol_aware) then - ! CCN + ! Potential cloud condensation nuclei (CCN) if (MAXVAL(nwfa) .lt. eps) then if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosols.' do i = 1, ncol @@ -219,7 +170,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 nwfa(i,1) = naCCN1+naCCN0*exp(-((hgt(i,2)-hgt(i,1))/1000.)*niCCN3) airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg - nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) + nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*5.E-11) do k = 2, nlev nwfa(i,k) = naCCN1+naCCN0*exp(-((hgt(i,k)-hgt(i,1))/1000.)*niCCN3) enddo @@ -227,8 +178,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & else if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosols are present.' if (MAXVAL(nwfa2d) .lt. eps) then -! Hard-coded switch between new (from WRFv4.0, top) and old (until WRFv3.9.1.1, bottom) surface emission rate calculations -#if 0 !+---+-----------------------------------------------------------------+ !..Scale the lowest level aerosol data into an emissions rate. This is !.. very far from ideal, but need higher emissions where larger amount @@ -239,41 +188,16 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & !.. that was tested as ~(20kmx20kmx50m = 2.E10 m**-3) !+---+-----------------------------------------------------------------+ if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' - if (mpirank==mpiroot) write(*,*) ' Use new (WRFv4+) formula to calculate CCN surface emission rates.' do i = 1, ncol airmass = 1./orho(i,1) * (hgt(i,2)-hgt(i,1))*area(i) ! kg - nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*2.E-10) - enddo -#else - !+---+-----------------------------------------------------------------+ - !..Scale the lowest level aerosol data into an emissions rate. This is - !.. very far from ideal, but need higher emissions where larger amount - !.. of existing and lesser emissions where not already lots of aerosols - !.. for first-order simplistic approach. Later, proper connection to - !.. emission inventory would be better, but, for now, scale like this: - !.. where: Nwfa=50 per cc, emit 0.875E4 aerosols per kg per second - !.. Nwfa=500 per cc, emit 0.875E5 aerosols per kg per second - !.. Nwfa=5000 per cc, emit 0.875E6 aerosols per kg per second - !.. for a grid with 20km spacing and scale accordingly for other spacings. - !+---+-----------------------------------------------------------------+ - if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial CCN aerosol surface emission rates.' - if (mpirank==mpiroot) write(*,*) ' Use old (pre WRFv4) formula to calculate CCN surface emission rates.' - do i = 1, ncol - if (SQRT(area(i))/20000.0 .ge. 1.0) then - h_01 = 0.875 - else - h_01 = (0.875 + 0.125*((20000.-SQRT(area(i)))/16000.)) * SQRT(area(i))/20000. - endif - nwfa2d(i) = 10.0**(LOG10(nwfa(i,1)*1.E-6)-3.69897) - nwfa2d(i) = nwfa2d(i)*h_01 * 1.E6 + nwfa2d(i) = nwfa(i,1) * 0.000196 * (airmass*5.E-11) enddo -#endif else if (mpirank==mpiroot) write(*,*) ' Apparently initial CCN aerosol surface emission rates are present.' endif endif - ! IN + ! Potential ice nuclei (IN) if (MAXVAL(nifa) .lt. eps) then if (mpirank==mpiroot) write(*,*) ' Apparently there are no initial IN aerosols.' do i = 1, ncol @@ -302,19 +226,20 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & endif endif - ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa - if (maxval(qc_mp)>0.0 .and. maxval(nc_mp)==0.0) then - nc_mp = make_DropletNumber(qc_mp*rho, nwfa) * orho - end if + ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number. + where(qc <= 0.0) nc=0.0 + where(qc > 0 .and. nc <= 0.0) nc = make_DropletNumber(qc*rho, nwfa) * orho + where(qc = 0.0 .and. nc > 0.0) nc=0.0 - ! If nc is in boundary conditions but qc is not, reset nc to zero - if (maxval(nc_mp)>0.0 .and. maxval(qc_mp)==0.0) nc_mp = 0.0 + ! Ensure non-negative aerosol number concentrations. + where(nwfa <= 0.0) nwfa = 1.1E6 + where(nifa <= 0.0) nifa = naIN1*0.01 else ! Constant droplet concentration for single moment cloud water as in ! module_mp_thompson.F90, only needed for effective radii calculation - nc_mp = Nt_c/rho + nc = Nt_c/rho end if @@ -322,9 +247,14 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then ! Effective radii [m] are now intent(out), bounds applied in calc_effectRad do i = 1, ncol - call calc_effectRad (tgrs(i,:), prsl(i,:), qv_mp(i,:), qc_mp(i,:), & - nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & + call calc_effectRad (tgrs(i,:), prsl(i,:), qv(i,:), qc(i,:), & + nc(i,:), qi(i,:), ni(i,:), qs(i,:), & re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) + do k = 1, nlev + re_cloud(i,k) = MAX(re_qc_min, MIN(re_cloud(i,k), re_qc_max)) + re_ice(i,k) = MAX(re_qi_min, MIN(re_ice(i,k), re_qi_max)) + re_snow(i,k) = MAX(re_qs_min, MIN(re_snow(i,k), re_qs_max)) + end do end do !! Convert to micron: required for bit-for-bit identical restarts; !! otherwise entering mp_thompson_init and converting mu to m and @@ -341,13 +271,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & return end if - !> - Convert number concentrations from dry to moist - ni = ni_mp/(1.0_kind_phys+qv_mp) - nr = nr_mp/(1.0_kind_phys+qv_mp) - if (is_aerosol_aware) then - nc = nc_mp/(1.0_kind_phys+qv_mp) - end if - is_initialized = .true. end subroutine mp_thompson_init @@ -428,17 +351,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! Air density real(kind_phys) :: rho(1:ncol,1:nlev) !< kg m-3 - ! Hydrometeors - real(kind_phys) :: qv_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qc_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qr_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qi_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qs_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: qg_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) - real(kind_phys) :: ni_mp(1:ncol,1:nlev) !< kg-1 - real(kind_phys) :: nr_mp(1:ncol,1:nlev) !< kg-1 - real(kind_phys) :: nc_mp(1:ncol,1:nlev) !< kg-1 - + ! Water vapor mixing ratio (instead of specific humidity) + real(kind_phys) :: qv(1:ncol,1:nlev) !< kg kg-1 ! Vertical velocity and level width real(kind_phys) :: w(1:ncol,1:nlev) !< m s-1 real(kind_phys) :: dz(1:ncol,1:nlev) !< m @@ -494,19 +408,26 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & return end if - !> - Convert specific humidity/moist mixing ratios to dry mixing ratios - qv_mp = spechum/(1.0_kind_phys-spechum) - qc_mp = qc/(1.0_kind_phys-spechum) - qr_mp = qr/(1.0_kind_phys-spechum) - qi_mp = qi/(1.0_kind_phys-spechum) - qs_mp = qs/(1.0_kind_phys-spechum) - qg_mp = qg/(1.0_kind_phys-spechum) - - !> - Convert number concentrations from moist to dry - ni_mp = ni/(1.0_kind_phys-spechum) - nr_mp = nr/(1.0_kind_phys-spechum) - if (is_aerosol_aware) then - nc_mp = nc/(1.0_kind_phys-spechum) + !> - Convert specific humidity to water vapor mixing ratio. + !> - Also, hydrometeor variables are mass or number mixing ratio + !> - either kg of species per kg of dry air, or per kg of (dry + vapor). + + qv = spechum/(1.0_kind_phys-spechum) + + if (convert_dry_rho) then + qc = qc/(1.0_kind_phys-spechum) + qr = qr/(1.0_kind_phys-spechum) + qi = qi/(1.0_kind_phys-spechum) + qs = qs/(1.0_kind_phys-spechum) + qg = qg/(1.0_kind_phys-spechum) + + ni = ni/(1.0_kind_phys-spechum) + nr = nr/(1.0_kind_phys-spechum) + if (is_aerosol_aware) then + nc = nc/(1.0_kind_phys-spechum) + nwfa = nwfa/(1.0_kind_phys-spechum) + nifa = nifa/(1.0_kind_phys-spechum) + end if end if !> - Density of air in kg m-3 @@ -582,9 +503,8 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & !> - Call mp_gt_driver() with or without aerosols if (is_aerosol_aware) then - call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & - ni=ni_mp, nr=nr_mp, nc=nc_mp, & - nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & + call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & + nc=nc, nwfa=nwfa, nifa=nifa, nwfa2d=nwfa2d, nifa2d=nifa2d, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -604,8 +524,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & errmsg=errmsg, errflg=errflg, reset=reset) else - call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & - ni=ni_mp, nr=nr_mp, & + call mp_gt_driver(qv=qv, qc=qc, qr=qr, qi=qi, qs=qs, qg=qg, ni=ni, nr=nr, & tt=tgrs, p=prsl, w=w, dz=dz, dt_in=dtp, & rainnc=rain_mp, rainncv=delta_rain_mp, & snownc=snow_mp, snowncv=delta_snow_mp, & @@ -626,19 +545,23 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & end if if (errflg/=0) return - !> - Convert dry mixing ratios to specific humidity/moist mixing ratios - spechum = qv_mp/(1.0_kind_phys+qv_mp) - qc = qc_mp/(1.0_kind_phys+qv_mp) - qr = qr_mp/(1.0_kind_phys+qv_mp) - qi = qi_mp/(1.0_kind_phys+qv_mp) - qs = qs_mp/(1.0_kind_phys+qv_mp) - qg = qg_mp/(1.0_kind_phys+qv_mp) - - !> - Convert number concentrations from dry to moist - ni = ni_mp/(1.0_kind_phys+qv_mp) - nr = nr_mp/(1.0_kind_phys+qv_mp) - if (is_aerosol_aware) then - nc = nc_mp/(1.0_kind_phys+qv_mp) + !> - Convert water vapor mixing ratio back to specific humidity + spechum = qv/(1.0_kind_phys+qv) + + if (convert_dry_rho) then + qc = qc/(1.0_kind_phys+qv) + qr = qr/(1.0_kind_phys+qv) + qi = qi/(1.0_kind_phys+qv) + qs = qs/(1.0_kind_phys+qv) + qg = qg/(1.0_kind_phys+qv) + + ni = ni/(1.0_kind_phys+qv) + nr = nr/(1.0_kind_phys+qv) + if (is_aerosol_aware) then + nc = nc/(1.0_kind_phys+qv) + nwfa = nwfa/(1.0_kind_phys+qv) + nifa = nifa/(1.0_kind_phys+qv) + end if end if !> - Convert rainfall deltas from mm to m (on physics timestep); add to inout variables From 8e4caf10a39ac7530e7c0eabc0aa1e0dd8deb959 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 16 Feb 2021 07:20:08 -0700 Subject: [PATCH 205/274] Bugfix in physics/GFS_debug.F90 --- physics/GFS_debug.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 5ecc9d8a3..3e8e987c7 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -681,6 +681,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtdt_gw ', Diag%dtdt_gw) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%kdis_gw ', Diag%kdis_gw) if (Model%do_ugwp_v1 .or. Model%gwd_opt==33 .or. Model%gwd_opt==22) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_ogw ', Diag%dudt_ogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_ogw ', Diag%dvdt_ogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_obl ', Diag%dudt_obl ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_obl ', Diag%dvdt_obl ) @@ -697,7 +698,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%du_ofdcol ', Diag%du_ofdcol) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dv_ofdcol ', Diag%dv_ofdcol) else - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvdt_ogw ', Diag%dvdt_ogw) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dudt_ogw ', Diag%dudt_ogw) end if ! Statein call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Statein%phii' , Statein%phii) @@ -1264,7 +1265,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ngw ', Interstitial%tau_ngw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_oss ', Interstitial%tau_oss ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_mtb ', Interstitial%dudt_mtb ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_ogw ', Interstitial%dudt_ogw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%dudt_tms ', Interstitial%dudt_tms ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zmtb ', Interstitial%zmtb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zlwb ', Interstitial%zlwb ) From 7fe6ab42fa86812222a94a58ab5a014ff5e5846b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 16 Feb 2021 18:32:18 +0000 Subject: [PATCH 206/274] Define interstitial for minimum temperature allowed by GP. --- physics/GFS_rrtmgp_pre.F90 | 11 ++++++----- physics/GFS_rrtmgp_pre.meta | 9 +++++++++ physics/rrtmgp_lw_gas_optics.F90 | 4 +++- physics/rrtmgp_lw_gas_optics.meta | 9 +++++++++ 4 files changed, 27 insertions(+), 6 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 9fc12963d..220248231 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -98,8 +98,8 @@ end subroutine GFS_rrtmgp_pre_init !! subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, & - con_epsqs, minGPpres, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, & - tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) + con_epsqs, minGPpres, minGPtemp, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, & + qs_lay, q_lay, tv_lay, relhum, tracer, gas_concentrations, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -111,7 +111,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f lsswr, & ! Call SW radiation? lslwr ! Call LW radiation real(kind_phys), intent(in) :: & - minGPpres, & ! Minimum pressure allowed in RRTMGP + minGPtemp, & ! Minimum temperature allowed in RRTMGP. + minGPpres, & ! Minimum pressure allowed in RRTMGP. fhswr, & ! Frequency of SW radiation call. fhlwr ! Frequency of LW radiation call. real(kind_phys), intent(in) :: & @@ -204,8 +205,8 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f ! Bound temperature at layer centers. do iCol=1,NCOL do iLay=1,nLev - if (t_lay(iCol,iLay) .le. lw_gas_props%get_temp_min()) then - t_lay = lw_gas_props%get_temp_min() + epsilon(lw_gas_props%get_temp_min()) + if (t_lay(iCol,iLay) .le. minGPtemp) then + t_lay = minGPtemp + epsilon(minGPtemp) endif enddo enddo diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 521d7a8a0..cb53b8f86 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -230,6 +230,15 @@ kind = kind_phys intent = in optional = F +[minGPtemp] + standard_name = minimum_temperature_in_RRTMGP + long_name = minimum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F [raddt] standard_name = time_step_for_radiation long_name = radiation time step diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 1455814f4..e2a24cea1 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -68,7 +68,7 @@ module rrtmgp_lw_gas_optics !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_concentrations,& - nCol, nLev, mpicomm, mpirank, mpiroot, minGPpres, errmsg, errflg) + nCol, nLev, mpicomm, mpirank, mpiroot, minGPpres, minGPtemp, errmsg, errflg) ! Inputs type(ty_gas_concs), intent(inout) :: & @@ -89,6 +89,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_co integer, intent(out) :: & errflg ! CCPP error code real(kind_phys), intent(out) :: & + minGPtemp, & ! Minimum temperature allowed by RRTMGP. minGPpres ! Minimum pressure allowed by RRTMGP. ! Dimensions integer :: & @@ -282,6 +283,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_co ! The minimum pressure allowed in GP RTE calculations. Used to bound uppermost layer ! temperature (GFS_rrtmgp_pre.F90) minGPpres = lw_gas_props%get_press_min() + minGPtemp = lw_gas_props%get_temp_min() end subroutine rrtmgp_lw_gas_optics_init diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 6a2fea449..c6eb3d145 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -100,6 +100,15 @@ kind = kind_phys intent = out optional = F +[minGPtemp] + standard_name = minimum_temperature_in_RRTMGP + long_name = minimum temperature allowed in RRTMGP + units = K + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F ######################################################################## [ccpp-arg-table] From b204497750d1fad78f9752eff8a7dabc60eb8a83 Mon Sep 17 00:00:00 2001 From: Greg Thompson Date: Wed, 17 Feb 2021 10:05:14 -0700 Subject: [PATCH 207/274] fix bug to include rho(air) in nwfa --- physics/mp_thompson.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index e22d82316..ac8437262 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -228,7 +228,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number. where(qc <= 0.0) nc=0.0 - where(qc > 0 .and. nc <= 0.0) nc = make_DropletNumber(qc*rho, nwfa) * orho + where(qc > 0 .and. nc <= 0.0) nc = make_DropletNumber(qc*rho, nwfa*rho) * orho where(qc = 0.0 .and. nc > 0.0) nc=0.0 ! Ensure non-negative aerosol number concentrations. From 8cc60d34c49426b78d2fe14a9c16fc719c558041 Mon Sep 17 00:00:00 2001 From: Ruiyu Sun Date: Wed, 17 Feb 2021 17:17:16 +0000 Subject: [PATCH 208/274] a bug fix in radiation_clouds.f for Thompson MP --- physics/radiation_clouds.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/radiation_clouds.f b/physics/radiation_clouds.f index 056bede28..dacf6e38e 100644 --- a/physics/radiation_clouds.f +++ b/physics/radiation_clouds.f @@ -3189,7 +3189,7 @@ subroutine progcld6 & endif ! Call subroutine get_alpha_exp to define alpha parameter for exponential cloud overlap options - if ( iovr == 4 .or. iovr == 5) then + if ( iovr == 3 .or. iovr == 4 .or. iovr == 5) then call get_alpha_exp(ix, nLay, dzlay, de_lgth, alpha) else de_lgth(:) = 0. From 1ba6619a25ae9938c1dc1e3b9ccfa5de71b31bd8 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 17 Feb 2021 18:12:00 +0000 Subject: [PATCH 209/274] MPI broadcast working in sw gas optics init. Error later in _run routine when referencing. --- physics/rrtmgp_sw_gas_optics.F90 | 160 +++++++++++++++++++++++++++++-- 1 file changed, 151 insertions(+), 9 deletions(-) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 7075147b1..99c7c38a0 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -9,6 +9,9 @@ module rrtmgp_sw_gas_optics use mo_compute_bc, only: compute_bc use GFS_rrtmgp_pre, only: active_gases_array use netcdf +#ifdef MPI + use mpi +#endif implicit none @@ -98,19 +101,31 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, integer :: status, ncid, dimid, varID, iGas, ntemps, npress, ngptsSW, nabsorbers, & nextrabsorbers, nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & - ncontributors_lower, ncontributors_upper + ncontributors_lower, ncontributors_upper, mpierr integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: sw_gas_props_file + ! Variables to create structured MPI data type + integer, parameter :: & + nVars = 35 ! Number of fields in DDT + integer,dimension(nVars) :: & + displacement_array, blocklength_array, type_array + integer :: & + base, iVar + ! Initialize errmsg = '' errflg = 0 - ! Filenames are set in the gphysics_nml + ! Filenames are set in the gfphysics_nml sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) - ! Read dimensions for k-distribution fields (only on master processor(0)) -! if (mpirank .eq. mpiroot) then + ! Read dimensions for k-distribution fields. + ! Only on master processor(0), if MPI enabled. +#ifdef MPI + call mpi_barrier(mpicomm, mpierr) + if (mpirank .eq. mpiroot) then +#endif ! Open file status = nf90_open(trim(sw_gas_props_file), NF90_NOWRITE, ncid) @@ -143,8 +158,8 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lower) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upper) - - ! Allocate space for arrays + + ! Allocate space for arrays (all processors) if (.not. allocated(gas_namesSW)) & allocate(gas_namesSW(nabsorbers)) if (.not. allocated(scaling_gas_lowerSW)) & @@ -212,7 +227,7 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, if (.not. allocated(temp4)) & allocate(temp4(nminor_absorber_intervals_upper)) - ! Read in fields from file + ! Read in files ... if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_namesSW) @@ -297,12 +312,139 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! Close status = nf90_close(ncid) -! endif + if (mpirank==mpiroot) write (*,*) ' complete' + + ! Broadcast data to other processors... +#ifdef MPI + if (mpirank==mpiroot) write (*,*) 'MPI Broadcasting RRTMGP shortwave k-distribution data ... ' + + ! Real scalars + call mpi_bcast(press_ref_tropSW, & + 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_1',mpierr) + call mpi_bcast(temp_ref_pSW, & + 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_2',mpierr) + call mpi_bcast(temp_ref_tSW, & + 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_3',mpierr) + call mpi_bcast(tsi_defaultSW, & + 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_4',mpierr) + call mpi_bcast(mg_defaultSW, & + 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_5',mpierr) + call mpi_bcast(sb_defaultSW, & + 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_6',mpierr) + + ! Integer arrays + call mpi_bcast(kminor_start_lowerSW, & + size(kminor_start_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_7',mpierr) + call mpi_bcast(kminor_start_upperSW, & + size(kminor_start_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_8',mpierr) + call mpi_bcast(band2gptSW, & + size(band2gptSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_9',mpierr) + call mpi_bcast(minor_limits_gpt_lowerSW, & + size(minor_limits_gpt_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_10',mpierr) + call mpi_bcast(minor_limits_gpt_upperSW, & + size(minor_limits_gpt_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_11',mpierr) + call mpi_bcast(key_speciesSW, & + size(key_speciesSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_12',mpierr) + + ! Real arrays + call mpi_bcast(press_refSW, & + size(press_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_13',mpierr) + call mpi_bcast(temp_refSW, & + size(temp_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_14',mpierr) + call mpi_bcast(solar_quietSW, & + size(solar_quietSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_15',mpierr) + call mpi_bcast(solar_facularSW, & + size(solar_facularSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_16',mpierr) + call mpi_bcast(solar_sunspotSW, & + size(solar_sunspotSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_17',mpierr) + call mpi_bcast(band_limsSW, & + size(band_limsSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_18',mpierr) + call mpi_bcast(vmr_refSW, & + size(vmr_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_19',mpierr) + call mpi_bcast(kminor_lowerSW, & + size(kminor_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_20',mpierr) + call mpi_bcast(kminor_upperSW, & + size(kminor_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_21',mpierr) + call mpi_bcast(rayl_lowerSW, & + size(rayl_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_22',mpierr) + call mpi_bcast(rayl_upperSW, & + size(rayl_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_23',mpierr) + call mpi_bcast(kmajorSW, & + size(kmajorSW), MPI_REAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_24',mpierr) + + ! Characters + call mpi_bcast(gas_namesSW, & + size(gas_namesSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_25',mpierr) + call mpi_bcast(gas_minorSW, & + size(gas_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_26',mpierr) + call mpi_bcast(identifier_minorSW, & + size(identifier_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_27',mpierr) + call mpi_bcast(minor_gases_lowerSW, & + size(minor_gases_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_28',mpierr) + call mpi_bcast(minor_gases_upperSW, & + size(minor_gases_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_29',mpierr) + call mpi_bcast(scaling_gas_lowerSW, & + size(scaling_gas_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_30',mpierr) + call mpi_bcast(scaling_gas_upperSW, & + size(scaling_gas_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_31',mpierr) + + ! Logicals + call mpi_bcast(minor_scales_with_density_lowerSW, & + size(minor_scales_with_density_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_32',mpierr) + call mpi_bcast(minor_scales_with_density_upperSW, & + size(minor_scales_with_density_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_33',mpierr) + call mpi_bcast(scale_by_complement_lowerSW, & + size(scale_by_complement_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_34',mpierr) + call mpi_bcast(scale_by_complement_upperSW, & + size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call check_error_msg('sw_gas_optics_mpi_bcast_35',mpierr) + + ! + if (mpirank==mpiroot) write (*,*) ' complete' + endif + ! All other processors wait for master to finish the broadcast... + write (*,*) ' process waiting... ',mpirank + call mpi_barrier(mpicomm, mpierr) + write (*,*) ' master process complete ',mpirank +#endif ! ! Initialize RRTMGP DDT's... ! - ! Shortwave k-distribution data !$omp critical (load_sw_gas_optics) gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, & From 7cb5d21aa6c7479cb7e29e5f016575353f9d2461 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 17 Feb 2021 18:23:22 +0000 Subject: [PATCH 210/274] Removed error checking calls. --- physics/rrtmgp_sw_gas_optics.F90 | 45 +------------------------------- 1 file changed, 1 insertion(+), 44 deletions(-) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 99c7c38a0..9402f8e5d 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -105,14 +105,6 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: sw_gas_props_file - ! Variables to create structured MPI data type - integer, parameter :: & - nVars = 35 ! Number of fields in DDT - integer,dimension(nVars) :: & - displacement_array, blocklength_array, type_array - integer :: & - base, iVar - ! Initialize errmsg = '' errflg = 0 @@ -159,7 +151,7 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upper) - ! Allocate space for arrays (all processors) + ! Allocate space for arrays if (.not. allocated(gas_namesSW)) & allocate(gas_namesSW(nabsorbers)) if (.not. allocated(scaling_gas_lowerSW)) & @@ -321,117 +313,82 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! Real scalars call mpi_bcast(press_ref_tropSW, & 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_1',mpierr) call mpi_bcast(temp_ref_pSW, & 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_2',mpierr) call mpi_bcast(temp_ref_tSW, & 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_3',mpierr) call mpi_bcast(tsi_defaultSW, & 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_4',mpierr) call mpi_bcast(mg_defaultSW, & 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_5',mpierr) call mpi_bcast(sb_defaultSW, & 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_6',mpierr) ! Integer arrays call mpi_bcast(kminor_start_lowerSW, & size(kminor_start_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_7',mpierr) call mpi_bcast(kminor_start_upperSW, & size(kminor_start_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_8',mpierr) call mpi_bcast(band2gptSW, & size(band2gptSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_9',mpierr) call mpi_bcast(minor_limits_gpt_lowerSW, & size(minor_limits_gpt_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_10',mpierr) call mpi_bcast(minor_limits_gpt_upperSW, & size(minor_limits_gpt_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_11',mpierr) call mpi_bcast(key_speciesSW, & size(key_speciesSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_12',mpierr) ! Real arrays call mpi_bcast(press_refSW, & size(press_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_13',mpierr) call mpi_bcast(temp_refSW, & size(temp_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_14',mpierr) call mpi_bcast(solar_quietSW, & size(solar_quietSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_15',mpierr) call mpi_bcast(solar_facularSW, & size(solar_facularSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_16',mpierr) call mpi_bcast(solar_sunspotSW, & size(solar_sunspotSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_17',mpierr) call mpi_bcast(band_limsSW, & size(band_limsSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_18',mpierr) call mpi_bcast(vmr_refSW, & size(vmr_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_19',mpierr) call mpi_bcast(kminor_lowerSW, & size(kminor_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_20',mpierr) call mpi_bcast(kminor_upperSW, & size(kminor_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_21',mpierr) call mpi_bcast(rayl_lowerSW, & size(rayl_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_22',mpierr) call mpi_bcast(rayl_upperSW, & size(rayl_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_23',mpierr) call mpi_bcast(kmajorSW, & size(kmajorSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_24',mpierr) ! Characters call mpi_bcast(gas_namesSW, & size(gas_namesSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_25',mpierr) call mpi_bcast(gas_minorSW, & size(gas_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_26',mpierr) call mpi_bcast(identifier_minorSW, & size(identifier_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_27',mpierr) call mpi_bcast(minor_gases_lowerSW, & size(minor_gases_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_28',mpierr) call mpi_bcast(minor_gases_upperSW, & size(minor_gases_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_29',mpierr) call mpi_bcast(scaling_gas_lowerSW, & size(scaling_gas_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_30',mpierr) call mpi_bcast(scaling_gas_upperSW, & size(scaling_gas_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_31',mpierr) ! Logicals call mpi_bcast(minor_scales_with_density_lowerSW, & size(minor_scales_with_density_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_32',mpierr) call mpi_bcast(minor_scales_with_density_upperSW, & size(minor_scales_with_density_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_33',mpierr) call mpi_bcast(scale_by_complement_lowerSW, & size(scale_by_complement_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_34',mpierr) call mpi_bcast(scale_by_complement_upperSW, & size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call check_error_msg('sw_gas_optics_mpi_bcast_35',mpierr) ! if (mpirank==mpiroot) write (*,*) ' complete' From f3e963ff23a01427b8841cc00476de3d26a7dd03 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 17 Feb 2021 21:38:31 +0000 Subject: [PATCH 211/274] Making progress. Not all fields being broadcast correctly. --- physics/rrtmgp_sw_gas_optics.F90 | 411 +++++++++++++++++-------------- 1 file changed, 232 insertions(+), 179 deletions(-) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 9402f8e5d..6bc0f1e16 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -17,6 +17,10 @@ module rrtmgp_sw_gas_optics ! RRTMGP k-distribution LUTs. type(ty_gas_optics_rrtmgp) :: sw_gas_props + integer :: & + ntempsSW, npressSW, ngptsSW, nabsorbersSW, nextrabsorbersSW, nminorabsorbersSW, & + nmixingfracsSW, nlayersSW, nbndsSW, npairsSW, nminor_absorber_intervals_lowerSW,& + nminor_absorber_intervals_upperSW, ncontributors_lowerSW, ncontributors_upperSW integer, dimension(:), allocatable :: & kminor_start_lowerSW, & ! Starting index in the [1, nContributors] vector for a contributor ! given by \"minor_gases_lower\" (lower atmosphere) @@ -98,10 +102,7 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, errflg ! CCPP error code ! Local variables - integer :: status, ncid, dimid, varID, iGas, ntemps, npress, ngptsSW, nabsorbers, & - nextrabsorbers, nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & - nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & - ncontributors_lower, ncontributors_upper, mpierr + integer :: status, ncid, dimid, varID, iGas, mpierr integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: sw_gas_props_file @@ -112,115 +113,164 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! Filenames are set in the gfphysics_nml sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) - ! Read dimensions for k-distribution fields. - ! Only on master processor(0), if MPI enabled. + ! ####################################################################################### + ! + ! Read dimensions for k-distribution fields... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### #ifdef MPI - call mpi_barrier(mpicomm, mpierr) if (mpirank .eq. mpiroot) then #endif + write (*,*) 'Reading RRTMGP shortwave k-distribution metadata ... ' + ! Open file status = nf90_open(trim(sw_gas_props_file), NF90_NOWRITE, ncid) ! Read dimensions for k-distribution fields status = nf90_inq_dimid(ncid, 'temperature', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=ntemps) + status = nf90_inquire_dimension(ncid, dimid, len=ntempsSW) status = nf90_inq_dimid(ncid, 'pressure', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=npress) + status = nf90_inquire_dimension(ncid, dimid, len=npressSW) status = nf90_inq_dimid(ncid, 'absorber', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nabsorbers) + status = nf90_inquire_dimension(ncid, dimid, len=nabsorbersSW) status = nf90_inq_dimid(ncid, 'minor_absorber',dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nminorabsorbers) + status = nf90_inquire_dimension(ncid, dimid, len=nminorabsorbersSW) status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nextrabsorbers) + status = nf90_inquire_dimension(ncid, dimid, len=nextrabsorbersSW) status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nmixingfracs) + status = nf90_inquire_dimension(ncid, dimid, len=nmixingfracsSW) status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nlayers) + status = nf90_inquire_dimension(ncid, dimid, len=nlayersSW) status = nf90_inq_dimid(ncid, 'bnd', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nbnds) + status = nf90_inquire_dimension(ncid, dimid, len=nbndsSW) status = nf90_inq_dimid(ncid, 'gpt', dimid) status = nf90_inquire_dimension(ncid, dimid, len=ngptsSW) status = nf90_inq_dimid(ncid, 'pair', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_inquire_dimension(ncid, dimid, len=npairsSW) status = nf90_inq_dimid(ncid, 'contributors_lower',dimid) - status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_lower) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_lowerSW) status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_upper) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_upperSW) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lower) + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lowerSW) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upper) - - ! Allocate space for arrays - if (.not. allocated(gas_namesSW)) & - allocate(gas_namesSW(nabsorbers)) - if (.not. allocated(scaling_gas_lowerSW)) & - allocate(scaling_gas_lowerSW(nminor_absorber_intervals_lower)) - if (.not. allocated(scaling_gas_upperSW)) & - allocate(scaling_gas_upperSW(nminor_absorber_intervals_upper)) - if (.not. allocated(gas_minorSW)) & - allocate(gas_minorSW(nminorabsorbers)) - if (.not. allocated(identifier_minorSW)) & - allocate(identifier_minorSW(nminorabsorbers)) - if (.not. allocated(minor_gases_lowerSW)) & - allocate(minor_gases_lowerSW(nminor_absorber_intervals_lower)) - if (.not. allocated(minor_gases_upperSW)) & - allocate(minor_gases_upperSW(nminor_absorber_intervals_upper)) - if (.not. allocated(minor_limits_gpt_lowerSW)) & - allocate(minor_limits_gpt_lowerSW(npairs,nminor_absorber_intervals_lower)) - if (.not. allocated(minor_limits_gpt_upperSW)) & - allocate(minor_limits_gpt_upperSW(npairs,nminor_absorber_intervals_upper)) - if (.not. allocated(band2gptSW)) & - allocate(band2gptSW(2,nbnds)) - if (.not. allocated(key_speciesSW)) & - allocate(key_speciesSW(2,nlayers,nbnds)) - if (.not. allocated(band_limsSW)) & - allocate(band_limsSW(2,nbnds)) - if (.not. allocated(press_refSW)) & - allocate(press_refSW(npress)) - if (.not. allocated(temp_refSW)) & - allocate(temp_refSW(ntemps)) - if (.not. allocated(vmr_refSW)) & - allocate(vmr_refSW(nlayers, nextrabsorbers, ntemps)) - if (.not. allocated(kminor_lowerSW)) & - allocate(kminor_lowerSW(ncontributors_lower, nmixingfracs, ntemps)) - if (.not. allocated(kmajorSW)) & - allocate(kmajorSW(ngptsSW, nmixingfracs, npress+1, ntemps)) - if (.not. allocated(kminor_start_lowerSW)) & - allocate(kminor_start_lowerSW(nminor_absorber_intervals_lower)) - if (.not. allocated(kminor_upperSW)) & - allocate(kminor_upperSW(ncontributors_upper, nmixingfracs, ntemps)) - if (.not. allocated(kminor_start_upperSW)) & - allocate(kminor_start_upperSW(nminor_absorber_intervals_upper)) - if (.not. allocated(minor_scales_with_density_lowerSW)) & - allocate(minor_scales_with_density_lowerSW(nminor_absorber_intervals_lower)) - if (.not. allocated(minor_scales_with_density_upperSW)) & - allocate(minor_scales_with_density_upperSW(nminor_absorber_intervals_upper)) - if (.not. allocated(scale_by_complement_lowerSW)) & - allocate(scale_by_complement_lowerSW(nminor_absorber_intervals_lower)) - if (.not. allocated(scale_by_complement_upperSW)) & - allocate(scale_by_complement_upperSW(nminor_absorber_intervals_upper)) - if (.not. allocated(rayl_upperSW)) & - allocate(rayl_upperSW(ngptsSW, nmixingfracs, ntemps)) - if (.not. allocated(rayl_lowerSW)) & - allocate(rayl_lowerSW(ngptsSW, nmixingfracs, ntemps)) - if (.not. allocated(solar_quietSW)) & - allocate(solar_quietSW(ngptsSW)) - if (.not. allocated(solar_facularSW)) & - allocate(solar_facularSW(ngptsSW)) - if (.not. allocated(solar_sunspotSW)) & - allocate(solar_sunspotSW(ngptsSW)) - if (.not. allocated(temp1)) & - allocate(temp1(nminor_absorber_intervals_lower)) - if (.not. allocated(temp2)) & - allocate(temp2(nminor_absorber_intervals_upper)) - if (.not. allocated(temp3)) & - allocate(temp3(nminor_absorber_intervals_lower)) - if (.not. allocated(temp4)) & - allocate(temp4(nminor_absorber_intervals_upper)) - - ! Read in files ... - if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upperSW) + +#ifdef MPI + endif ! On master processor + + ! Other processors waiting... + write (*,*) ' process waiting... ',mpirank + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### + ! + ! Broadcast dimensions... + ! (ALL processors) + ! + ! ####################################################################################### + call mpi_bcast(nbndsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ngptsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nmixingfracsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ntempsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(npressSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nabsorbersSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nextrabsorbersSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nminorabsorbersSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlayersSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(npairsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ncontributors_upperSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ncontributors_lowerSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nminor_absorber_intervals_upperSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nminor_absorber_intervals_lowerSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! + ! Allocate space for arrays... + ! (ALL processors) + ! + ! ####################################################################################### + write (*,*) 'Allocating RRTMGP shortwave k-distribution data ... ' + if (.not. allocated(gas_namesSW)) & + allocate(gas_namesSW(nabsorbersSW)) + if (.not. allocated(scaling_gas_lowerSW)) & + allocate(scaling_gas_lowerSW(nminor_absorber_intervals_lowerSW)) + if (.not. allocated(scaling_gas_upperSW)) & + allocate(scaling_gas_upperSW(nminor_absorber_intervals_upperSW)) + if (.not. allocated(gas_minorSW)) & + allocate(gas_minorSW(nminorabsorbersSW)) + if (.not. allocated(identifier_minorSW)) & + allocate(identifier_minorSW(nminorabsorbersSW)) + if (.not. allocated(minor_gases_lowerSW)) & + allocate(minor_gases_lowerSW(nminor_absorber_intervals_lowerSW)) + if (.not. allocated(minor_gases_upperSW)) & + allocate(minor_gases_upperSW(nminor_absorber_intervals_upperSW)) + if (.not. allocated(minor_limits_gpt_lowerSW)) & + allocate(minor_limits_gpt_lowerSW(npairsSW,nminor_absorber_intervals_lowerSW)) + if (.not. allocated(minor_limits_gpt_upperSW)) & + allocate(minor_limits_gpt_upperSW(npairsSW,nminor_absorber_intervals_upperSW)) + if (.not. allocated(band2gptSW)) & + allocate(band2gptSW(2,nbndsSW)) + if (.not. allocated(key_speciesSW)) & + allocate(key_speciesSW(2,nlayersSW,nbndsSW)) + if (.not. allocated(band_limsSW)) & + allocate(band_limsSW(2,nbndsSW)) + if (.not. allocated(press_refSW)) & + allocate(press_refSW(npressSW)) + if (.not. allocated(temp_refSW)) & + allocate(temp_refSW(ntempsSW)) + if (.not. allocated(vmr_refSW)) & + allocate(vmr_refSW(nlayersSW, nextrabsorbersSW, ntempsSW)) + if (.not. allocated(kminor_lowerSW)) & + allocate(kminor_lowerSW(ncontributors_lowerSW, nmixingfracsSW, ntempsSW)) + if (.not. allocated(kmajorSW)) & + allocate(kmajorSW(ngptsSW, nmixingfracsSW, npressSW+1, ntempsSW)) + if (.not. allocated(kminor_start_lowerSW)) & + allocate(kminor_start_lowerSW(nminor_absorber_intervals_lowerSW)) + if (.not. allocated(kminor_upperSW)) & + allocate(kminor_upperSW(ncontributors_upperSW, nmixingfracsSW, ntempsSW)) + if (.not. allocated(kminor_start_upperSW)) & + allocate(kminor_start_upperSW(nminor_absorber_intervals_upperSW)) + if (.not. allocated(minor_scales_with_density_lowerSW)) & + allocate(minor_scales_with_density_lowerSW(nminor_absorber_intervals_lowerSW)) + if (.not. allocated(minor_scales_with_density_upperSW)) & + allocate(minor_scales_with_density_upperSW(nminor_absorber_intervals_upperSW)) + if (.not. allocated(scale_by_complement_lowerSW)) & + allocate(scale_by_complement_lowerSW(nminor_absorber_intervals_lowerSW)) + if (.not. allocated(scale_by_complement_upperSW)) & + allocate(scale_by_complement_upperSW(nminor_absorber_intervals_upperSW)) + if (.not. allocated(rayl_upperSW)) & + allocate(rayl_upperSW(ngptsSW, nmixingfracsSW, ntempsSW)) + if (.not. allocated(rayl_lowerSW)) & + allocate(rayl_lowerSW(ngptsSW, nmixingfracsSW, ntempsSW)) + if (.not. allocated(solar_quietSW)) & + allocate(solar_quietSW(ngptsSW)) + if (.not. allocated(solar_facularSW)) & + allocate(solar_facularSW(ngptsSW)) + if (.not. allocated(solar_sunspotSW)) & + allocate(solar_sunspotSW(ngptsSW)) + if (.not. allocated(temp1)) & + allocate(temp1(nminor_absorber_intervals_lowerSW)) + if (.not. allocated(temp2)) & + allocate(temp2(nminor_absorber_intervals_upperSW)) + if (.not. allocated(temp3)) & + allocate(temp3(nminor_absorber_intervals_lowerSW)) + if (.not. allocated(temp4)) & + allocate(temp4(nminor_absorber_intervals_upperSW)) + + ! ####################################################################################### + ! + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + call mpi_barrier(mpicomm, mpierr) + if (mpirank .eq. mpiroot) then +#endif + write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_namesSW) status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) @@ -306,102 +356,105 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, status = nf90_close(ncid) if (mpirank==mpiroot) write (*,*) ' complete' - ! Broadcast data to other processors... #ifdef MPI - if (mpirank==mpiroot) write (*,*) 'MPI Broadcasting RRTMGP shortwave k-distribution data ... ' - - ! Real scalars - call mpi_bcast(press_ref_tropSW, & - 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(temp_ref_pSW, & - 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(temp_ref_tSW, & - 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(tsi_defaultSW, & - 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(mg_defaultSW, & - 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(sb_defaultSW, & - 1, MPI_REAL, mpiroot, mpicomm, mpierr) - - ! Integer arrays - call mpi_bcast(kminor_start_lowerSW, & - size(kminor_start_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(kminor_start_upperSW, & - size(kminor_start_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(band2gptSW, & - size(band2gptSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(minor_limits_gpt_lowerSW, & - size(minor_limits_gpt_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(minor_limits_gpt_upperSW, & - size(minor_limits_gpt_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call mpi_bcast(key_speciesSW, & - size(key_speciesSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) - - ! Real arrays - call mpi_bcast(press_refSW, & - size(press_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(temp_refSW, & - size(temp_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(solar_quietSW, & - size(solar_quietSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(solar_facularSW, & - size(solar_facularSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(solar_sunspotSW, & - size(solar_sunspotSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(band_limsSW, & - size(band_limsSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(vmr_refSW, & - size(vmr_refSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(kminor_lowerSW, & - size(kminor_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(kminor_upperSW, & - size(kminor_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(rayl_lowerSW, & - size(rayl_lowerSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(rayl_upperSW, & - size(rayl_upperSW), MPI_REAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(kmajorSW, & - size(kmajorSW), MPI_REAL, mpiroot, mpicomm, mpierr) - - ! Characters - call mpi_bcast(gas_namesSW, & - size(gas_namesSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(gas_minorSW, & - size(gas_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(identifier_minorSW, & - size(identifier_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(minor_gases_lowerSW, & - size(minor_gases_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(minor_gases_upperSW, & - size(minor_gases_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(scaling_gas_lowerSW, & - size(scaling_gas_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(scaling_gas_upperSW, & - size(scaling_gas_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - - ! Logicals - call mpi_bcast(minor_scales_with_density_lowerSW, & - size(minor_scales_with_density_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(minor_scales_with_density_upperSW, & - size(minor_scales_with_density_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(scale_by_complement_lowerSW, & - size(scale_by_complement_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call mpi_bcast(scale_by_complement_upperSW, & - size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - - ! - if (mpirank==mpiroot) write (*,*) ' complete' - endif - ! All other processors wait for master to finish the broadcast... + endif ! Master process + + ! Other processors waiting... write (*,*) ' process waiting... ',mpirank call mpi_barrier(mpicomm, mpierr) - write (*,*) ' master process complete ',mpirank + + ! ####################################################################################### + ! + ! Broadcast data... + ! (ALL processors) + ! + ! ####################################################################################### + write (*,*) 'MPI Broadcasting RRTMGP shortwave k-distribution data ... ' + + ! Real scalars + call mpi_bcast(press_ref_tropSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_pSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_tSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(tsi_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(mg_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(sb_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + + ! Integer arrays + call mpi_bcast(kminor_start_lowerSW, & + size(kminor_start_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_start_upperSW, & + size(kminor_start_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(band2gptSW, & + size(band2gptSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_limits_gpt_lowerSW, & + size(minor_limits_gpt_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_limits_gpt_upperSW, & + size(minor_limits_gpt_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(key_speciesSW, & + size(key_speciesSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + + ! Real arrays + call mpi_bcast(press_refSW, & + size(press_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_refSW, & + size(temp_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(solar_quietSW, & + size(solar_quietSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(solar_facularSW, & + size(solar_facularSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(solar_sunspotSW, & + size(solar_sunspotSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(band_limsSW, & + size(band_limsSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(vmr_refSW, & + size(vmr_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_lowerSW, & + size(kminor_lowerSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_upperSW, & + size(kminor_upperSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(rayl_lowerSW, & + size(rayl_lowerSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(rayl_upperSW, & + size(rayl_upperSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(kmajorSW, & + size(kmajorSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + + ! Characters + call mpi_bcast(gas_namesSW, & + size(gas_namesSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(gas_minorSW, & + size(gas_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(identifier_minorSW, & + size(identifier_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_gases_lowerSW, & + size(minor_gases_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_gases_upperSW, & + size(minor_gases_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(scaling_gas_lowerSW, & + size(scaling_gas_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(scaling_gas_upperSW, & + size(scaling_gas_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + + ! Logicals + call mpi_bcast(minor_scales_with_density_lowerSW, & + size(minor_scales_with_density_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_scales_with_density_upperSW, & + size(minor_scales_with_density_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(scale_by_complement_lowerSW, & + size(scale_by_complement_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(scale_by_complement_upperSW, & + size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + + write (*,*) ' broadcasting complete' + call mpi_barrier(mpicomm, mpierr) #endif + ! ####################################################################################### ! ! Initialize RRTMGP DDT's... ! + ! ####################################################################################### + print*,'gas_minorSW: ',gas_minorSW !$omp critical (load_sw_gas_optics) gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, & From 18062bff0459787c360343930db8e34e4e051062 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 17 Feb 2021 16:11:59 -0700 Subject: [PATCH 212/274] Move Noah MP initialization to GFS_phys_time_vary_init --- physics/GFS_phys_time_vary.fv3.F90 | 364 ++++++++++++++++++++++- physics/GFS_phys_time_vary.fv3.meta | 444 +++++++++++++++++++++++++++- 2 files changed, 790 insertions(+), 18 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index e33585ace..ca204ca05 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -36,6 +36,13 @@ module GFS_phys_time_vary use namelist_soilveg, only: salp_data, snupx use set_soilveg_mod, only: set_soilveg + ! --- needed for Noah MP init + use noahmp_tables, only: laim_table,saim_table,sla_table, & + bexp_table,smcmax_table,smcwlt_table, & + dwsat_table,dksat_table,psisat_table, & + isurban_table,isbarren_table, & + isice_table,iswater_table + implicit none private @@ -44,12 +51,13 @@ module GFS_phys_time_vary logical :: is_initialized = .false. - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - real(kind=kind_phys), parameter :: drythresh = 1.e-4_kind_phys - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys - real(kind=kind_phys), parameter :: one = 1.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + real(kind=kind_phys), parameter :: missing_value = 9.99e20_kind_phys + real(kind=kind_phys), parameter :: drythresh = 1.e-4_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys contains @@ -64,8 +72,13 @@ subroutine GFS_phys_time_vary_init ( jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & - isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_ruc, min_seaice, fice, landfrac, & - vtype, weasd, nthrds, errmsg, errflg) + isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & + fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & + tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& + qsnowxy, wslakexy, taussxy, waxy, wtxy, zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, & + rtmassxy, woodxy, stblcpxy, fastcpxy, smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, & + snliqxy, tsnoxy , smoiseq, zsnsoxy, slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, & + nthrds, errmsg, errflg) implicit none @@ -90,9 +103,57 @@ subroutine GFS_phys_time_vary_init ( integer, intent(in) :: isot, ivegsrc, nlunit real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) - integer, intent(in) :: lsm, lsm_ruc + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc real(kind_phys), intent(in) :: min_seaice, fice(:) - real(kind_phys), intent(in) :: landfrac(:), vtype(:), weasd(:) + real(kind_phys), intent(in) :: landfrac(:), vtype(:) + real(kind_phys), intent(inout) :: weasd(:) + + ! NoahMP - only allocated when NoahMP is used + integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound + real(kind_phys), intent(in) :: zs(:) + real(kind_phys), intent(in) :: dzs(:) + real(kind_phys), intent(inout) :: tvxy(:) + real(kind_phys), intent(inout) :: tgxy(:) + real(kind_phys), intent(inout) :: tahxy(:) + real(kind_phys), intent(inout) :: canicexy(:) + real(kind_phys), intent(inout) :: canliqxy(:) + real(kind_phys), intent(inout) :: eahxy(:) + real(kind_phys), intent(inout) :: cmxy(:) + real(kind_phys), intent(inout) :: chxy(:) + real(kind_phys), intent(inout) :: fwetxy(:) + real(kind_phys), intent(inout) :: sneqvoxy(:) + real(kind_phys), intent(inout) :: alboldxy(:) + real(kind_phys), intent(inout) :: qsnowxy(:) + real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout) :: taussxy(:) + real(kind_phys), intent(inout) :: waxy(:) + real(kind_phys), intent(inout) :: wtxy(:) + real(kind_phys), intent(inout) :: zwtxy(:) + real(kind_phys), intent(inout) :: xlaixy(:) + real(kind_phys), intent(inout) :: xsaixy(:) + real(kind_phys), intent(inout) :: lfmassxy(:) + real(kind_phys), intent(inout) :: stmassxy(:) + real(kind_phys), intent(inout) :: rtmassxy(:) + real(kind_phys), intent(inout) :: woodxy(:) + real(kind_phys), intent(inout) :: stblcpxy(:) + real(kind_phys), intent(inout) :: fastcpxy(:) + real(kind_phys), intent(inout) :: smcwtdxy(:) + real(kind_phys), intent(inout) :: deeprechxy(:) + real(kind_phys), intent(inout) :: rechxy(:) + real(kind_phys), intent(inout) :: snowxy(:) + real(kind_phys), intent(inout) :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: smoiseq(:,:) + real(kind_phys), intent(inout) :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: slc(:,:) + real(kind_phys), intent(inout) :: smc(:,:) + real(kind_phys), intent(inout) :: stc(:,:) + real(kind_phys), intent(in) :: tsfcl(:) + real(kind_phys), intent(in) :: snowd(:) + real(kind_phys), intent(in) :: canopy(:) + real(kind_phys), intent(in) :: tg3(:) + real(kind_phys), intent(in) :: stype(:) integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg @@ -102,6 +163,14 @@ subroutine GFS_phys_time_vary_init ( integer :: i, j, ix, vegtyp real(kind_phys) :: rsnow + !--- Noah MP + integer :: soiltyp, isnow, is, imn + real(kind=kind_phys) :: masslai, masssai, snd + real(kind=kind_phys) :: bexp, ddz, smcmax, smcwlt, dwsat, dksat, psisat + + real(kind=kind_phys), dimension(:), allocatable :: dzsno + real(kind=kind_phys), dimension(:), allocatable :: dzsnso + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -293,8 +362,283 @@ subroutine GFS_phys_time_vary_init ( !$OMP end parallel + + + if (lsm == lsm_noahmp) then + if (all(tvxy < zero)) then + + allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) + allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) + dzsno(:) = missing_value + dzsnso(:) = missing_value + + tvxy(:) = missing_value + tgxy(:) = missing_value + tahxy(:) = missing_value + canicexy(:) = missing_value + canliqxy(:) = missing_value + eahxy(:) = missing_value + cmxy(:) = missing_value + chxy(:) = missing_value + fwetxy(:) = missing_value + sneqvoxy(:) = missing_value + alboldxy(:) = missing_value + qsnowxy(:) = missing_value + wslakexy(:) = missing_value + taussxy(:) = missing_value + waxy(:) = missing_value + wtxy(:) = missing_value + zwtxy(:) = missing_value + xlaixy(:) = missing_value + xsaixy(:) = missing_value + + lfmassxy(:) = missing_value + stmassxy(:) = missing_value + rtmassxy(:) = missing_value + woodxy(:) = missing_value + stblcpxy(:) = missing_value + fastcpxy(:) = missing_value + smcwtdxy(:) = missing_value + deeprechxy(:) = missing_value + rechxy(:) = missing_value + + snowxy (:) = missing_value + snicexy(:,:) = missing_value + snliqxy(:,:) = missing_value + tsnoxy (:,:) = missing_value + smoiseq(:,:) = missing_value + zsnsoxy(:,:) = missing_value + + do ix=1,im + if (landfrac(ix) >= drythresh) then ! Sfcprop(nb)% + tvxy(ix) = tsfcl(ix) ! Sfcprop(nb)% + tgxy(ix) = tsfcl(ix) ! Sfcprop(nb)% + tahxy(ix) = tsfcl(ix) ! Sfcprop(nb)% + + if (snowd(ix) > 0.01 .and. tsfcl(ix) > 273.15 ) tvxy(ix) = 273.15 ! all Sfcprop(nb)%, replace hardcoded value with parameter/constant THIS IS A BUGFIX, (ix) was missing! + if (snowd(ix) > 0.01 .and. tsfcl(ix) > 273.15 ) tgxy(ix) = 273.15 ! all Sfcprop(nb)%, replace hardcoded value with parameter/constant THIS IS A BUGFIX, (ix) was missing! + if (snowd(ix) > 0.01 .and. tsfcl(ix) > 273.15 ) tahxy(ix) = 273.15 ! all Sfcprop(nb)%, replace hardcoded value with parameter/constant THIS IS A BUGFIX, (ix) was missing! + + canicexy(ix) = 0.0 + canliqxy(ix) = canopy(ix) + + eahxy(ix) = 2000.0 + +! eahxy = psfc*qv/(0.622+qv); qv is mixing ratio, converted from sepcific +! humidity specific humidity /(1.0 - specific humidity) + + cmxy(ix) = 0.0 + chxy(ix) = 0.0 + fwetxy(ix) = 0.0 + sneqvoxy(ix) = weasd(ix) ! mm + alboldxy(ix) = 0.65 ! DH* REPLACE WITH CONSTANT ? + qsnowxy(ix) = 0.0 + +! if (srflag(ix) > 0.001) qsnowxy(ix) = tprcp(ix)/dtp + ! already set to 0.0 + wslakexy(ix) = 0.0 + taussxy(ix) = 0.0 + + + waxy(ix) = 4900.0 + wtxy(ix) = waxy(ix) + zwtxy(ix) = (25.0 + 2.0) - waxy(ix) / 1000.0 /0.2 + + vegtyp = vtype(ix) + if (vegtyp == 0) vegtyp = 7 + imn = idate(2) ! DH* MODEL% + + if ((vegtyp == isbarren_table) .or. (vegtyp == isice_table) .or. (vegtyp == isurban_table) .or. (vegtyp == iswater_table)) then + + xlaixy(ix) = 0.0 + xsaixy(ix) = 0.0 + + lfmassxy(ix) = 0.0 + stmassxy(ix) = 0.0 + rtmassxy(ix) = 0.0 + + woodxy (ix) = 0.0 + stblcpxy (ix) = 0.0 + fastcpxy (ix) = 0.0 + + else + + xlaixy(ix) = max(laim_table(vegtyp, imn),0.05) +! xsaixy(ix) = max(saim_table(vegtyp, imn),0.05) + xsaixy(ix) = max(xlaixy(ix)*0.1,0.05) + + masslai = 1000.0 / max(sla_table(vegtyp),1.0) + lfmassxy(ix) = xlaixy(ix)*masslai + masssai = 1000.0 / 3.0 + stmassxy(ix) = xsaixy(ix)* masssai + + rtmassxy(ix) = 500.0 + + woodxy(ix) = 500.0 + stblcpxy(ix) = 1000.0 + fastcpxy(ix) = 1000.0 + + endif ! non urban ... + + if (vegtyp == isice_table) then + do is = 1,lsoil + stc(ix,is) = min(stc(ix,is),min(tg3(ix),263.15)) + smc(ix,is) = 1 + slc(ix,is) = 0 + enddo + endif + + snd = snowd(ix)/1000.0 ! go to m from snwdph + + if (weasd(ix) /= 0.0 .and. snd == 0.0 ) then + snd = weasd(ix)/1000.0 + endif + + if (vegtyp == 15) then ! land ice in MODIS/IGBP + if (weasd(ix) < 0.1) then + weasd(ix) = 0.1 + snd = 0.01 + endif + endif + + if (snd < 0.025 ) then + snowxy(ix) = 0.0 + dzsno(-2:0) = 0.0 + elseif (snd >= 0.025 .and. snd <= 0.05 ) then + snowxy(ix) = -1.0 + dzsno(0) = snd + elseif (snd > 0.05 .and. snd <= 0.10 ) then + snowxy(ix) = -2.0 + dzsno(-1) = 0.5*snd + dzsno(0) = 0.5*snd + elseif (snd > 0.10 .and. snd <= 0.25 ) then + snowxy(ix) = -2.0 + dzsno(-1) = 0.05 + dzsno(0) = snd - 0.05 + elseif (snd > 0.25 .and. snd <= 0.45 ) then + snowxy(ix) = -3.0 + dzsno(-2) = 0.05 + dzsno(-1) = 0.5*(snd-0.05) + dzsno(0) = 0.5*(snd-0.05) + elseif (snd > 0.45) then + snowxy(ix) = -3.0 + dzsno(-2) = 0.05 + dzsno(-1) = 0.20 + dzsno(0) = snd - 0.05 - 0.20 + else + errmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization' + errflg = 1 + return + endif + +! Now we have the snowxy field +! snice + snliq + tsno allocation and compute them from what we have + + tsnoxy(ix,:) = 0.0 + snicexy(ix,:) = 0.0 + snliqxy(ix,:) = 0.0 + zsnsoxy(ix,:) = 0.0 + + isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 + + do is = isnow,0 + tsnoxy(ix,is) = tgxy(ix) + snliqxy(ix,is) = 0.0 + snicexy(ix,is) = 1.00 * dzsno(is) * weasd(ix)/snd + enddo +! +!zsnsoxy, all negative ? +! + do is = isnow,0 + dzsnso(is) = -dzsno(is) + enddo + + do is = 1,4 + dzsnso(is) = -dzs(is) + enddo +! +! Assign to zsnsoxy +! + zsnsoxy(ix,isnow) = dzsnso(isnow) + do is = isnow+1,4 + zsnsoxy(ix,is) = zsnsoxy(ix,is-1) + dzsnso(is) + enddo +! +! smoiseq +! Init water table related quantities here +! + soiltyp = stype(ix) + if (soiltyp /= 0) then + bexp = bexp_table(soiltyp) + smcmax = smcmax_table(soiltyp) + smcwlt = smcwlt_table(soiltyp) + dwsat = dwsat_table(soiltyp) + dksat = dksat_table(soiltyp) + psisat = -psisat_table(soiltyp) + endif + + if (vegtyp == isurban_table) then + smcmax = 0.45 + smcwlt = 0.40 + endif + + if ((bexp > 0.0) .and. (smcmax > 0.0) .and. (-psisat > 0.0 )) then + do is = 1, lsoil + if ( is == 1 )then + ddz = -zs(is+1) * 0.5 + elseif ( is < lsoil ) then + ddz = ( zs(is-1) - zs(is+1) ) * 0.5 + else + ddz = zs(is-1) - zs(is) + endif + smoiseq(ix,is) = min(max(find_eq_smc(bexp, dwsat, dksat, ddz, smcmax),1.e-4),smcmax*0.99) + enddo + else ! bexp <= 0.0 + smoiseq(ix,1:4) = smcmax + endif ! end the bexp condition + + smcwtdxy(ix) = smcmax + deeprechxy(ix) = 0.0 + rechxy(ix) = 0.0 + + endif + + enddo ! ix + + deallocate(dzsno) + deallocate(dzsnso) + + endif + endif !if Noah MP cold start ends + is_initialized = .true. + contains + +! +! Use newton-raphson method to find eq soil moisture +! + function find_eq_smc(bexp, dwsat, dksat, ddz, smcmax) result(smc) + implicit none + real(kind=kind_phys), intent(in) :: bexp, dwsat, dksat, ddz, smcmax + real(kind=kind_phys) :: smc + real(kind=kind_phys) :: expon, aa, bb, func, dfunc, dx + integer :: iter + ! + expon = bexp + 1. + aa = dwsat / ddz + bb = dksat / smcmax ** expon + smc = 0.5 * smcmax + ! + do iter = 1,100 + func = (smc - smcmax) * aa + bb * smc ** expon + dfunc = aa + bb * expon * smc ** bexp + dx = func / dfunc + smc = smc - dx + if ( abs (dx) < 1.e-6_kind_phys) return + enddo + end function find_eq_smc + end subroutine GFS_phys_time_vary_init !! @} diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 393874cae..09407c00f 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -2,7 +2,7 @@ name = GFS_phys_time_vary type = scheme dependencies = aerclm_def.F,aerinterp.F90,gcycle.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f - dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90 + dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,sfcsub.F,cires_tauamf_data.F90,noahmp_tables.f90 ######################################################################## [ccpp-arg-table] @@ -400,18 +400,18 @@ type = integer intent = in optional = F -[lsm_ruc] - standard_name = flag_for_ruc_land_surface_scheme - long_name = flag for RUC land surface model +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model units = flag dimensions = () type = integer intent = in optional = F -[nthrds] - standard_name = omp_threads - long_name = number of OpenMP threads available for physics schemes - units = count +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag dimensions = () type = integer intent = in @@ -459,6 +459,434 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys + intent = inout + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[zs] + standard_name = depth_of_soil_levels_for_land_surface_model + long_name = depth of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = in + optional = F +[dzs] + standard_name = thickness_of_soil_levels_for_land_surface_model + long_name = thickness of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = in + optional = F +[lsnow_lsm_lbound] + standard_name = lower_bound_of_snow_vertical_dimension_for_land_surface_model + long_name = lower bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsnow_lsm_ubound] + standard_name = upper_bound_of_snow_vertical_dimension_for_land_surface_model + long_name = upper bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[tvxy] + standard_name = vegetation_temperature + long_name = vegetation temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tgxy] + standard_name = ground_temperature_for_noahmp + long_name = ground temperature for noahmp + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[tahxy] + standard_name = canopy_air_temperature + long_name = canopy air temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[canicexy] + standard_name = canopy_intercepted_ice_mass + long_name = canopy intercepted ice mass + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[canliqxy] + standard_name = canopy_intercepted_liquid_water + long_name = canopy intercepted liquid water + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[eahxy] + standard_name = canopy_air_vapor_pressure + long_name = canopy air vapor pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[cmxy] + standard_name = surface_drag_coefficient_for_momentum_for_noahmp + long_name = surface drag coefficient for momentum for noahmp + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[chxy] + standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp + long_name = surface exchange coeff heat & moisture for noahmp + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fwetxy] + standard_name = area_fraction_of_wet_canopy + long_name = area fraction of canopy that is wetted/snowed + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sneqvoxy] + standard_name = snow_mass_at_previous_time_step + long_name = snow mass at previous time step + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[alboldxy] + standard_name = snow_albedo_at_previous_time_step + long_name = snow albedo at previous time step + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[qsnowxy] + standard_name = snow_precipitation_rate_at_surface + long_name = snow precipitation rate at surface + units = mm s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[wslakexy] + standard_name = lake_water_storage + long_name = lake water storage + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[taussxy] + standard_name = nondimensional_snow_age + long_name = non-dimensional snow age + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[waxy] + standard_name = water_storage_in_aquifer + long_name = water storage in aquifer + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[wtxy] + standard_name = water_storage_in_aquifer_and_saturated_soil + long_name = water storage in aquifer and saturated soil + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[zwtxy] + standard_name = water_table_depth + long_name = water table depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[xlaixy] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[xsaixy] + standard_name = stem_area_index + long_name = stem area index + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[lfmassxy] + standard_name = leaf_mass + long_name = leaf mass + units = g m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stmassxy] + standard_name = stem_mass + long_name = stem mass + units = g m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[rtmassxy] + standard_name = fine_root_mass + long_name = fine root mass + units = g m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[woodxy] + standard_name = wood_mass + long_name = wood mass including woody roots + units = g m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[stblcpxy] + standard_name = slow_soil_pool_mass_content_of_carbon + long_name = stable carbon in deep soil + units = g m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[fastcpxy] + standard_name = fast_soil_pool_mass_content_of_carbon + long_name = short-lived carbon in shallow soil + units = g m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwtdxy] + standard_name = soil_water_content_between_soil_bottom_and_water_table + long_name = soil water content between the bottom of the soil and the water table + units = m3 m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[deeprechxy] + standard_name = water_table_recharge_when_deep + long_name = recharge to or from the water table when deep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[rechxy] + standard_name = water_table_recharge_when_shallow + long_name = recharge to or from the water table when shallow + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snowxy] + standard_name = number_of_snow_layers + long_name = number of snow layers + units = count + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[snicexy] + standard_name = snow_layer_ice + long_name = snow layer ice + units = mm + dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + type = real + kind = kind_phys + intent = inout + optional = F +[snliqxy] + standard_name = snow_layer_liquid_water + long_name = snow layer liquid water + units = mm + dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + type = real + kind = kind_phys + intent = inout + optional = F +[tsnoxy] + standard_name = snow_temperature + long_name = snow_temperature + units = K + dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + type = real + kind = kind_phys + intent = inout + optional = F +[smoiseq] + standard_name = equilibrium_soil_water_content + long_name = equilibrium soil water content + units = m3 m-3 + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[zsnsoxy] + standard_name = layer_bottom_depth_from_snow_surface + long_name = depth from the top of the snow surface at the bottom of the layer + units = m + dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = total soil moisture + units = frac + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_loop_extent,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[stype] + standard_name = soil_type_classification_real + long_name = soil type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[nthrds] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer intent = in optional = F [errmsg] From 382d09083435dacf9735e50c8a44c726af631636 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 17 Feb 2021 16:12:36 -0700 Subject: [PATCH 213/274] Update standard name for soil layer thickness in sfc_noah_wrfv4 and sfc_noah_wrfv4_interstitial --- physics/sfc_noah_wrfv4.meta | 2 +- physics/sfc_noah_wrfv4_interstitial.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_noah_wrfv4.meta b/physics/sfc_noah_wrfv4.meta index 1895c56bf..5cb925808 100644 --- a/physics/sfc_noah_wrfv4.meta +++ b/physics/sfc_noah_wrfv4.meta @@ -216,7 +216,7 @@ intent = in optional = F [sthick] - standard_name = soil_layer_thickness + standard_name = thickness_of_soil_levels_for_land_surface_model long_name = soil layer thickness units = m dimensions = (soil_vertical_dimension) diff --git a/physics/sfc_noah_wrfv4_interstitial.meta b/physics/sfc_noah_wrfv4_interstitial.meta index b6ebcfe39..4364897a9 100644 --- a/physics/sfc_noah_wrfv4_interstitial.meta +++ b/physics/sfc_noah_wrfv4_interstitial.meta @@ -664,7 +664,7 @@ intent = inout optional = F [sthick] - standard_name = soil_layer_thickness + standard_name = thickness_of_soil_levels_for_land_surface_model long_name = soil layer thickness units = m dimensions = (soil_vertical_dimension) From 994166afc28b49808bf5e4602651cca03a0b4943 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 17 Feb 2021 23:33:28 +0000 Subject: [PATCH 214/274] MPI Broadcast working in SW gas-optics. --- physics/rrtmgp_sw_gas_optics.F90 | 102 +++++++++++++++---------------- 1 file changed, 51 insertions(+), 51 deletions(-) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 6bc0f1e16..2d8afdc14 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -102,7 +102,7 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, errflg ! CCPP error code ! Local variables - integer :: status, ncid, dimid, varID, iGas, mpierr + integer :: status, ncid, dimid, varID, iGas, mpierr, iChar integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 character(len=264) :: sw_gas_props_file @@ -161,7 +161,6 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, endif ! On master processor ! Other processors waiting... - write (*,*) ' process waiting... ',mpirank call mpi_barrier(mpicomm, mpierr) ! ####################################################################################### @@ -192,7 +191,6 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! (ALL processors) ! ! ####################################################################################### - write (*,*) 'Allocating RRTMGP shortwave k-distribution data ... ' if (.not. allocated(gas_namesSW)) & allocate(gas_namesSW(nabsorbersSW)) if (.not. allocated(scaling_gas_lowerSW)) & @@ -354,13 +352,10 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! Close status = nf90_close(ncid) - if (mpirank==mpiroot) write (*,*) ' complete' - #ifdef MPI endif ! Master process ! Other processors waiting... - write (*,*) ' process waiting... ',mpirank call mpi_barrier(mpicomm, mpierr) ! ####################################################################################### @@ -369,83 +364,89 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! (ALL processors) ! ! ####################################################################################### - write (*,*) 'MPI Broadcasting RRTMGP shortwave k-distribution data ... ' ! Real scalars - call mpi_bcast(press_ref_tropSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(temp_ref_pSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(temp_ref_tSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(tsi_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(mg_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(sb_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(press_ref_tropSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_pSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_tSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(tsi_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(mg_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(sb_defaultSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) ! Integer arrays call mpi_bcast(kminor_start_lowerSW, & - size(kminor_start_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + size(kminor_start_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(kminor_start_upperSW, & - size(kminor_start_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + size(kminor_start_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(band2gptSW, & - size(band2gptSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + size(band2gptSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(minor_limits_gpt_lowerSW, & - size(minor_limits_gpt_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + size(minor_limits_gpt_lowerSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(minor_limits_gpt_upperSW, & - size(minor_limits_gpt_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + size(minor_limits_gpt_upperSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) call mpi_bcast(key_speciesSW, & - size(key_speciesSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + size(key_speciesSW), MPI_INTEGER, mpiroot, mpicomm, mpierr) ! Real arrays call mpi_bcast(press_refSW, & - size(press_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(press_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(temp_refSW, & - size(temp_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(temp_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(solar_quietSW, & - size(solar_quietSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(solar_quietSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(solar_facularSW, & - size(solar_facularSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(solar_facularSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(solar_sunspotSW, & - size(solar_sunspotSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(solar_sunspotSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(band_limsSW, & - size(band_limsSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(band_limsSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(vmr_refSW, & - size(vmr_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(vmr_refSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(kminor_lowerSW, & - size(kminor_lowerSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(kminor_lowerSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(kminor_upperSW, & - size(kminor_upperSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(kminor_upperSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(rayl_lowerSW, & - size(rayl_lowerSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(rayl_lowerSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(rayl_upperSW, & - size(rayl_upperSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(rayl_upperSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(kmajorSW, & - size(kmajorSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + size(kmajorSW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) ! Characters - call mpi_bcast(gas_namesSW, & - size(gas_namesSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(gas_minorSW, & - size(gas_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(identifier_minorSW, & - size(identifier_minorSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(minor_gases_lowerSW, & - size(minor_gases_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(minor_gases_upperSW, & - size(minor_gases_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(scaling_gas_lowerSW, & - size(scaling_gas_lowerSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call mpi_bcast(scaling_gas_upperSW, & - size(scaling_gas_upperSW), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + do iChar=1,nabsorbersSW + call mpi_bcast(gas_namesSW(iChar), & + len(gas_namesSW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo + do iChar=1,nminorabsorbersSW + call mpi_bcast(gas_minorSW(iChar), & + len(gas_minorSW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(identifier_minorSW(iChar), & + len(identifier_minorSW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo + do iChar=1,nminor_absorber_intervals_lowerSW + call mpi_bcast(minor_gases_lowerSW(iChar), & + len(minor_gases_lowerSW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(scaling_gas_lowerSW(iChar), & + len(scaling_gas_lowerSW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo + do iChar=1,nminor_absorber_intervals_upperSW + call mpi_bcast(minor_gases_upperSW(iChar), & + len(minor_gases_upperSW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(scaling_gas_upperSW(iChar), & + len(scaling_gas_upperSW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo ! Logicals call mpi_bcast(minor_scales_with_density_lowerSW, & - size(minor_scales_with_density_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + size(minor_scales_with_density_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) call mpi_bcast(minor_scales_with_density_upperSW, & - size(minor_scales_with_density_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + size(minor_scales_with_density_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) call mpi_bcast(scale_by_complement_lowerSW, & - size(scale_by_complement_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + size(scale_by_complement_lowerSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) call mpi_bcast(scale_by_complement_upperSW, & - size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + size(scale_by_complement_upperSW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) - write (*,*) ' broadcasting complete' call mpi_barrier(mpicomm, mpierr) #endif @@ -454,7 +455,6 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! Initialize RRTMGP DDT's... ! ! ####################################################################################### - print*,'gas_minorSW: ',gas_minorSW !$omp critical (load_sw_gas_optics) gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, & From 88c321c6e165c8ae4bab140f2d2f5c0d968b81cf Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 17 Feb 2021 20:42:34 -0700 Subject: [PATCH 215/274] Cleanup in physics/GFS_phys_time_vary.fv3.{meta,F90} --- physics/GFS_phys_time_vary.fv3.F90 | 23 +++++++++++------------ physics/GFS_phys_time_vary.fv3.meta | 9 +++++++++ 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index ca204ca05..28fdff772 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -78,7 +78,7 @@ subroutine GFS_phys_time_vary_init ( qsnowxy, wslakexy, taussxy, waxy, wtxy, zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, & rtmassxy, woodxy, stblcpxy, fastcpxy, smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, & snliqxy, tsnoxy , smoiseq, zsnsoxy, slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, & - nthrds, errmsg, errflg) + con_t0c, nthrds, errmsg, errflg) implicit none @@ -154,6 +154,7 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: canopy(:) real(kind_phys), intent(in) :: tg3(:) real(kind_phys), intent(in) :: stype(:) + real(kind_phys), intent(in) :: con_t0c integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg @@ -362,8 +363,6 @@ subroutine GFS_phys_time_vary_init ( !$OMP end parallel - - if (lsm == lsm_noahmp) then if (all(tvxy < zero)) then @@ -410,14 +409,14 @@ subroutine GFS_phys_time_vary_init ( zsnsoxy(:,:) = missing_value do ix=1,im - if (landfrac(ix) >= drythresh) then ! Sfcprop(nb)% - tvxy(ix) = tsfcl(ix) ! Sfcprop(nb)% - tgxy(ix) = tsfcl(ix) ! Sfcprop(nb)% - tahxy(ix) = tsfcl(ix) ! Sfcprop(nb)% + if (landfrac(ix) >= drythresh) then + tvxy(ix) = tsfcl(ix) + tgxy(ix) = tsfcl(ix) + tahxy(ix) = tsfcl(ix) - if (snowd(ix) > 0.01 .and. tsfcl(ix) > 273.15 ) tvxy(ix) = 273.15 ! all Sfcprop(nb)%, replace hardcoded value with parameter/constant THIS IS A BUGFIX, (ix) was missing! - if (snowd(ix) > 0.01 .and. tsfcl(ix) > 273.15 ) tgxy(ix) = 273.15 ! all Sfcprop(nb)%, replace hardcoded value with parameter/constant THIS IS A BUGFIX, (ix) was missing! - if (snowd(ix) > 0.01 .and. tsfcl(ix) > 273.15 ) tahxy(ix) = 273.15 ! all Sfcprop(nb)%, replace hardcoded value with parameter/constant THIS IS A BUGFIX, (ix) was missing! + if (snowd(ix) > 0.01 .and. tsfcl(ix) > con_t0c ) tvxy(ix) = con_t0c + if (snowd(ix) > 0.01 .and. tsfcl(ix) > con_t0c ) tgxy(ix) = con_t0c + if (snowd(ix) > 0.01 .and. tsfcl(ix) > con_t0c ) tahxy(ix) = con_t0c canicexy(ix) = 0.0 canliqxy(ix) = canopy(ix) @@ -431,7 +430,7 @@ subroutine GFS_phys_time_vary_init ( chxy(ix) = 0.0 fwetxy(ix) = 0.0 sneqvoxy(ix) = weasd(ix) ! mm - alboldxy(ix) = 0.65 ! DH* REPLACE WITH CONSTANT ? + alboldxy(ix) = 0.65 qsnowxy(ix) = 0.0 ! if (srflag(ix) > 0.001) qsnowxy(ix) = tprcp(ix)/dtp @@ -446,7 +445,7 @@ subroutine GFS_phys_time_vary_init ( vegtyp = vtype(ix) if (vegtyp == 0) vegtyp = 7 - imn = idate(2) ! DH* MODEL% + imn = idate(2) if ((vegtyp == isbarren_table) .or. (vegtyp == isice_table) .or. (vegtyp == isurban_table) .or. (vegtyp == iswater_table)) then diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 09407c00f..d32c91ba6 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -881,6 +881,15 @@ kind = kind_phys intent = in optional = F +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [nthrds] standard_name = omp_threads long_name = number of OpenMP threads available for physics schemes From 0586868ced9de18f2f8ba7df9a4a35c03e06ce5b Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 18 Feb 2021 16:41:12 +0000 Subject: [PATCH 216/274] MPI broadcast working in LW gas-optics initialization. --- physics/rrtmgp_lw_gas_optics.F90 | 320 +++++++++++++++++++++++------- physics/rrtmgp_lw_gas_optics.meta | 16 -- 2 files changed, 247 insertions(+), 89 deletions(-) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index e2a24cea1..536adaaef 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -9,9 +9,18 @@ module rrtmgp_lw_gas_optics use rrtmgp_aux, only: check_error_msg use GFS_rrtmgp_pre, only: active_gases_array use netcdf +#ifdef MPI + use mpi +#endif + implicit none type(ty_gas_optics_rrtmgp) :: lw_gas_props + integer :: & + ntempsLW, npressLW, ngptsLW, nabsorbersLW, nextrabsorbersLW, nminorabsorbersLW,& + nmixingfracsLW, nlayersLW, nbndsLW, npairsLW, ninternalSourcetempsLW, & + nminor_absorber_intervals_lowerLW, nminor_absorber_intervals_upperLW, & + ncontributors_lowerLW, ncontributors_upperLW, nfit_coeffsLW integer, dimension(:), allocatable :: & kminor_start_lowerLW, & ! Starting index in the [1, nContributors] vector for a contributor ! given by \"minor_gases_lower\" (lower atmosphere) @@ -67,8 +76,8 @@ module rrtmgp_lw_gas_optics !! \section arg_table_rrtmgp_lw_gas_optics_init !! \htmlinclude rrtmgp_lw_gas_optics_init.html !! - subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_concentrations,& - nCol, nLev, mpicomm, mpirank, mpiroot, minGPpres, minGPtemp, errmsg, errflg) + subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, & + gas_concentrations, mpicomm, mpirank, mpiroot, minGPpres, minGPtemp, errmsg, errflg) ! Inputs type(ty_gas_concs), intent(inout) :: & @@ -77,29 +86,21 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_co rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties integer,intent(in) :: & - nCol, & ! Number of horizontal points - nLev, & ! Number of vertical levels mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank ! Outputs character(len=*), intent(out) :: & - errmsg ! CCPP error message + errmsg ! CCPP error message integer, intent(out) :: & - errflg ! CCPP error code + errflg ! CCPP error code real(kind_phys), intent(out) :: & - minGPtemp, & ! Minimum temperature allowed by RRTMGP. - minGPpres ! Minimum pressure allowed by RRTMGP. - ! Dimensions - integer :: & - ntemps, npress, ngpts, nabsorbers, nextrabsorbers, nminorabsorbers,& - nmixingfracs, nlayers, nbnds, npairs, ninternalSourcetemps, & - nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & - ncontributors_lower, ncontributors_upper,nfit_coeffs + minGPtemp, & ! Minimum temperature allowed by RRTMGP. + minGPpres ! Minimum pressure allowed by RRTMGP. ! Local variables - integer :: ncid, dimID, varID, status, iGas, ierr, ii + integer :: ncid, dimID, varID, status, iGas, ierr, ii, mpierr, iChar integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4, & temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4 character(len=264) :: lw_gas_props_file @@ -111,80 +112,158 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_co ! Filenames are set in the physics_nml lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) - ! On master processor only... -! if (mpirank .eq. mpiroot) then + ! ####################################################################################### + ! + ! Read dimensions for k-distribution fields... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + write (*,*) 'Reading RRTMGP longwave k-distribution metadata ... ' + ! Open file status = nf90_open(trim(lw_gas_props_file), NF90_NOWRITE, ncid) ! Read dimensions for k-distribution fields status = nf90_inq_dimid(ncid, 'temperature', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = ntemps) + status = nf90_inquire_dimension(ncid, dimid, len = ntempsLW) status = nf90_inq_dimid(ncid, 'pressure', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = npress) + status = nf90_inquire_dimension(ncid, dimid, len = npressLW) status = nf90_inq_dimid(ncid, 'absorber', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nabsorbers) + status = nf90_inquire_dimension(ncid, dimid, len = nabsorbersLW) status = nf90_inq_dimid(ncid, 'minor_absorber', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nminorabsorbers) + status = nf90_inquire_dimension(ncid, dimid, len = nminorabsorbersLW) status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nextrabsorbers) + status = nf90_inquire_dimension(ncid, dimid, len = nextrabsorbersLW) status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nmixingfracs) + status = nf90_inquire_dimension(ncid, dimid, len = nmixingfracsLW) status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nlayers) + status = nf90_inquire_dimension(ncid, dimid, len = nlayersLW) status = nf90_inq_dimid(ncid, 'bnd', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nbnds) + status = nf90_inquire_dimension(ncid, dimid, len = nbndsLW) status = nf90_inq_dimid(ncid, 'gpt', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = ngpts) + status = nf90_inquire_dimension(ncid, dimid, len = ngptsLW) status = nf90_inq_dimid(ncid, 'pair', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = npairs) + status = nf90_inquire_dimension(ncid, dimid, len = npairsLW) status = nf90_inq_dimid(ncid, 'contributors_lower', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lower) + status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lowerLW) status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upper) + status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upperLW) status = nf90_inq_dimid(ncid, 'fit_coeffs', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nfit_coeffs) + status = nf90_inquire_dimension(ncid, dimid, len = nfit_coeffsLW) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lower) + status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lowerLW) status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upper) + status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upperLW) status = nf90_inq_dimid(ncid, 'temperature_Planck', dimid) - status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetemps) - - ! Allocate space for arrays - allocate(gas_namesLW(nabsorbers)) - allocate(scaling_gas_lowerLW(nminor_absorber_intervals_lower)) - allocate(scaling_gas_upperLW(nminor_absorber_intervals_upper)) - allocate(gas_minorLW(nminorabsorbers)) - allocate(identifier_minorLW(nminorabsorbers)) - allocate(minor_gases_lowerLW(nminor_absorber_intervals_lower)) - allocate(minor_gases_upperLW(nminor_absorber_intervals_upper)) - allocate(minor_limits_gpt_lowerLW(npairs,nminor_absorber_intervals_lower)) - allocate(minor_limits_gpt_upperLW(npairs,nminor_absorber_intervals_upper)) - allocate(band2gptLW(2,nbnds)) - allocate(key_speciesLW(2,nlayers,nbnds)) - allocate(band_limsLW(2,nbnds)) - allocate(press_refLW(npress)) - allocate(temp_refLW(ntemps)) - allocate(vmr_refLW(nlayers, nextrabsorbers, ntemps)) - allocate(kminor_lowerLW(ncontributors_lower, nmixingfracs, ntemps)) - allocate(kmajorLW(ngpts, nmixingfracs, npress+1, ntemps)) - allocate(kminor_start_lowerLW(nminor_absorber_intervals_lower)) - allocate(kminor_upperLW(ncontributors_upper, nmixingfracs, ntemps)) - allocate(kminor_start_upperLW(nminor_absorber_intervals_upper)) - allocate(optimal_angle_fitLW(nfit_coeffs,nbnds)) - allocate(minor_scales_with_density_lowerLW(nminor_absorber_intervals_lower)) - allocate(minor_scales_with_density_upperLW(nminor_absorber_intervals_upper)) - allocate(scale_by_complement_lowerLW(nminor_absorber_intervals_lower)) - allocate(scale_by_complement_upperLW(nminor_absorber_intervals_upper)) - allocate(temp1(nminor_absorber_intervals_lower)) - allocate(temp2(nminor_absorber_intervals_upper)) - allocate(temp3(nminor_absorber_intervals_lower)) - allocate(temp4(nminor_absorber_intervals_upper)) - allocate(totplnkLW(ninternalSourcetemps, nbnds)) - allocate(planck_fracLW(ngpts, nmixingfracs, npress+1, ntemps)) - - ! Read in fields from file - if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' + status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetempsLW) +#ifdef MPI + endif ! On master processor + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### + ! + ! Broadcast dimensions... + ! (ALL processors) + ! + ! ####################################################################################### + call mpi_bcast(ntempsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(npressLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ngptsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nabsorbersLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nextrabsorbersLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nminorabsorbersLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nmixingfracsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nlayersLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nbndsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(npairsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ninternalSourcetempsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nminor_absorber_intervals_lowerLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nminor_absorber_intervals_upperLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ncontributors_lowerLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(ncontributors_upperLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nfit_coeffsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) +#endif + + ! Allocate space for arrays + if (.not. allocated(gas_namesLW)) & + allocate(gas_namesLW(nabsorbersLW)) + if (.not. allocated(scaling_gas_lowerLW)) & + allocate(scaling_gas_lowerLW(nminor_absorber_intervals_lowerLW)) + if (.not. allocated(scaling_gas_upperLW)) & + allocate(scaling_gas_upperLW(nminor_absorber_intervals_upperLW)) + if (.not. allocated(gas_minorLW)) & + allocate(gas_minorLW(nminorabsorbersLW)) + if (.not. allocated(identifier_minorLW)) & + allocate(identifier_minorLW(nminorabsorbersLW)) + if (.not. allocated(minor_gases_lowerLW)) & + allocate(minor_gases_lowerLW(nminor_absorber_intervals_lowerLW)) + if (.not. allocated(minor_gases_upperLW)) & + allocate(minor_gases_upperLW(nminor_absorber_intervals_upperLW)) + if (.not. allocated(minor_limits_gpt_lowerLW)) & + allocate(minor_limits_gpt_lowerLW(npairsLW, nminor_absorber_intervals_lowerLW)) + if (.not. allocated(minor_limits_gpt_upperLW)) & + allocate(minor_limits_gpt_upperLW(npairsLW, nminor_absorber_intervals_upperLW)) + if (.not. allocated(band2gptLW)) & + allocate(band2gptLW(2, nbndsLW)) + if (.not. allocated(key_speciesLW)) & + allocate(key_speciesLW(2, nlayersLW, nbndsLW)) + if (.not. allocated(band_limsLW)) & + allocate(band_limsLW(2, nbndsLW)) + if (.not. allocated(press_refLW)) & + allocate(press_refLW(npressLW)) + if (.not. allocated(temp_refLW)) & + allocate(temp_refLW(ntempsLW)) + if (.not. allocated(vmr_refLW)) & + allocate(vmr_refLW(nlayersLW, nextrabsorbersLW, ntempsLW)) + if (.not. allocated(kminor_lowerLW)) & + allocate(kminor_lowerLW(ncontributors_lowerLW, nmixingfracsLW, ntempsLW)) + if (.not. allocated(kmajorLW)) & + allocate(kmajorLW(ngptsLW, nmixingfracsLW, npressLW+1, ntempsLW)) + if (.not. allocated(kminor_start_lowerLW)) & + allocate(kminor_start_lowerLW(nminor_absorber_intervals_lowerLW)) + if (.not. allocated(kminor_upperLW)) & + allocate(kminor_upperLW(ncontributors_upperLW, nmixingfracsLW, ntempsLW)) + if (.not. allocated(kminor_start_upperLW)) & + allocate(kminor_start_upperLW(nminor_absorber_intervals_upperLW)) + if (.not. allocated(optimal_angle_fitLW)) & + allocate(optimal_angle_fitLW(nfit_coeffsLW, nbndsLW)) + if (.not. allocated(minor_scales_with_density_lowerLW)) & + allocate(minor_scales_with_density_lowerLW(nminor_absorber_intervals_lowerLW)) + if (.not. allocated(minor_scales_with_density_upperLW)) & + allocate(minor_scales_with_density_upperLW(nminor_absorber_intervals_upperLW)) + if (.not. allocated(scale_by_complement_lowerLW)) & + allocate(scale_by_complement_lowerLW(nminor_absorber_intervals_lowerLW)) + if (.not. allocated(scale_by_complement_upperLW)) & + allocate(scale_by_complement_upperLW(nminor_absorber_intervals_upperLW)) + if (.not. allocated(temp1)) & + allocate(temp1(nminor_absorber_intervals_lowerLW)) + if (.not. allocated(temp2)) & + allocate(temp2(nminor_absorber_intervals_upperLW)) + if (.not. allocated(temp3)) & + allocate(temp3(nminor_absorber_intervals_lowerLW)) + if (.not. allocated(temp4)) & + allocate(temp4(nminor_absorber_intervals_upperLW)) + if (.not. allocated(totplnkLW)) & + allocate(totplnkLW(ninternalSourcetempsLW, nbndsLW)) + if (.not. allocated(planck_fracLW)) & + allocate(planck_fracLW(ngptsLW, nmixingfracsLW, npressLW+1, ntempsLW)) + + ! ####################################################################################### + ! + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + call mpi_barrier(mpicomm, mpierr) + if (mpirank .eq. mpiroot) then +#endif + write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' status = nf90_inq_varid(ncid, 'gas_names', varID) status = nf90_get_var( ncid, varID, gas_namesLW) status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) @@ -249,25 +328,120 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, gas_co status = nf90_get_var( ncid, varID,temp4) status = nf90_close(ncid) - do ii=1,nminor_absorber_intervals_lower + do ii=1,nminor_absorber_intervals_lowerLW if (temp1(ii) .eq. 0) minor_scales_with_density_lowerLW(ii) = .false. if (temp1(ii) .eq. 1) minor_scales_with_density_lowerLW(ii) = .true. if (temp3(ii) .eq. 0) scale_by_complement_lowerLW(ii) = .false. if (temp3(ii) .eq. 1) scale_by_complement_lowerLW(ii) = .true. enddo - do ii=1,nminor_absorber_intervals_upper + do ii=1,nminor_absorber_intervals_upperLW if (temp2(ii) .eq. 0) minor_scales_with_density_upperLW(ii) = .false. if (temp2(ii) .eq. 1) minor_scales_with_density_upperLW(ii) = .true. if (temp4(ii) .eq. 0) scale_by_complement_upperLW(ii) = .false. if (temp4(ii) .eq. 1) scale_by_complement_upperLW(ii) = .true. enddo -! endif +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + ! ####################################################################################### ! + ! Broadcast data... + ! (ALL processors) + ! + ! ####################################################################################### + + ! Real scalars + call mpi_bcast(press_ref_tropLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_pLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_ref_tLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + + ! Integer arrays + call mpi_bcast(kminor_start_lowerLW, & + size(kminor_start_lowerLW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_start_upperLW, & + size(kminor_start_upperLW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(band2gptLW, & + size(band2gptLW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_limits_gpt_lowerLW, & + size(minor_limits_gpt_lowerLW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_limits_gpt_upperLW, & + size(minor_limits_gpt_upperLW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(key_speciesLW, & + size(key_speciesLW), MPI_INTEGER, mpiroot, mpicomm, mpierr) + + ! Real arrays + call mpi_bcast(press_refLW, & + size(press_refLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(temp_refLW, & + size(temp_refLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(band_limsLW, & + size(band_limsLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(totplnkLW, & + size(totplnkLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(optimal_angle_fitLW, & + size(optimal_angle_fitLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(vmr_refLW, & + size(vmr_refLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_lowerLW, & + size(kminor_lowerLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(kminor_upperLW, & + size(kminor_upperLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(rayl_lowerLW, & + size(rayl_lowerLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(rayl_upperLW, & + size(rayl_upperLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(kmajorLW, & + size(kmajorLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(planck_fracLW, & + size(planck_fracLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + + + ! Characters + do iChar=1,nabsorbersLW + call mpi_bcast(gas_namesLW(iChar), & + len(gas_namesLW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo + do iChar=1,nminorabsorbersLW + call mpi_bcast(gas_minorLW(iChar), & + len(gas_minorLW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(identifier_minorLW(iChar), & + len(identifier_minorLW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo + do iChar=1,nminor_absorber_intervals_lowerLW + call mpi_bcast(minor_gases_lowerLW(iChar), & + len(minor_gases_lowerLW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(scaling_gas_lowerLW(iChar), & + len(scaling_gas_lowerLW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo + do iChar=1,nminor_absorber_intervals_upperLW + call mpi_bcast(minor_gases_upperLW(iChar), & + len(minor_gases_upperLW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call mpi_bcast(scaling_gas_upperLW(iChar), & + len(scaling_gas_upperLW(iChar)), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + enddo + + ! Logicals + call mpi_bcast(minor_scales_with_density_lowerLW, & + size(minor_scales_with_density_lowerLW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(minor_scales_with_density_upperLW, & + size(minor_scales_with_density_upperLW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(scale_by_complement_lowerLW, & + size(scale_by_complement_lowerLW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call mpi_bcast(scale_by_complement_upperLW, & + size(scale_by_complement_upperLW), MPI_LOGICAL, mpiroot, mpicomm, mpierr) + + call mpi_barrier(mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! ! Initialize RRTMGP DDT's... ! + ! ####################################################################################### !$omp critical (load_lw_gas_optics) - ! Longwave k-distribution data. gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('rrtmgp_lw_gas_optics_init',lw_gas_props%load(gas_concentrations, & gas_namesLW, key_speciesLW, band2gptLW, band_limsLW, press_refLW, press_ref_tropLW,& diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index c6eb3d145..92e35e06f 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -34,22 +34,6 @@ type = ty_gas_concs intent = inout optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[nLev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F [mpirank] standard_name = mpi_rank long_name = current MPI rank From f3393f40b2858424f6db6b650acab9339e9e9363 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 18 Feb 2021 18:23:45 +0000 Subject: [PATCH 217/274] MPI broadcast working in SW/LW cloud-optics initialization. --- physics/rrtmgp_lw_cloud_optics.F90 | 249 +++++++++++++++++++-------- physics/rrtmgp_lw_cloud_optics.meta | 24 --- physics/rrtmgp_sw_cloud_optics.F90 | 256 ++++++++++++++++++++-------- physics/rrtmgp_sw_cloud_optics.meta | 32 ---- 4 files changed, 366 insertions(+), 195 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index d8aa7e9f0..42c14ee94 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -7,12 +7,16 @@ module rrtmgp_lw_cloud_optics use rrtmgp_lw_gas_optics, only: lw_gas_props use rrtmgp_aux, only: check_error_msg use netcdf +#ifdef MPI + use mpi +#endif implicit none - public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize - type(ty_cloud_optics) :: lw_cloud_props + integer :: & + nrghice_fromfileLW, nBandLW, nSize_liqLW, nSize_iceLW, nSizeRegLW, & + nCoeff_extLW, nCoeff_ssa_gLW, nBoundLW, npairsLW real(kind_phys) :: & radliq_facLW, & ! Factor for calculating LUT interpolation indices for liquid radice_facLW ! Factor for calculating LUT interpolation indices for ice @@ -66,7 +70,7 @@ module rrtmgp_lw_cloud_optics !! \section arg_table_rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_init(nCol, nLev, nbndsGPlw, doG_cldoptics, & + subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, & doGP_cldoptics_PADE, doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, & rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, errmsg, errflg) @@ -78,9 +82,6 @@ subroutine rrtmgp_lw_cloud_optics_init(nCol, nLev, nbndsGPlw, doG_cldoptics, integer, intent(inout) :: & nrghice ! Number of ice-roughness categories integer, intent(in) :: & - nbndsGPlw, & ! Number of longwave bands - nCol, & ! Number of horizontal gridpoints - nLev, & ! Number of vertical levels mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank @@ -94,13 +95,8 @@ subroutine rrtmgp_lw_cloud_optics_init(nCol, nLev, nbndsGPlw, doG_cldoptics, integer, intent(out) :: & errflg ! Error code - ! Dimensions - integer :: & - nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizeReg,& - nCoeff_ext, nCoeff_ssa_g, nBound, npairs - ! Local variables - integer :: dimID,varID,status,ncid + integer :: dimID,varID,status,ncid,mpierr character(len=264) :: lw_cloud_props_file integer,parameter :: max_strlen=256, nrghice_default=2 @@ -110,68 +106,113 @@ subroutine rrtmgp_lw_cloud_optics_init(nCol, nLev, nbndsGPlw, doG_cldoptics, ! If not using RRTMGP cloud optics, return. if (doG_cldoptics) return - - ! - ! Otherwise, using RRTMGP cloud-optics, continue with initialization... - ! ! Filenames are set in the physics_nml lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) - ! On master processor only... -! if (mpirank .eq. mpiroot) then + ! ####################################################################################### + ! + ! Read dimensions for longwave cloud-optics fields... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + write (*,*) 'Reading RRTMGP longwave cloud-optics metadata ... ' + ! Open file status = nf90_open(trim(lw_cloud_props_file), NF90_NOWRITE, ncid) - + ! Read dimensions status = nf90_inq_dimid(ncid, 'nband', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inquire_dimension(ncid, dimid, len=nBandLW) status = nf90_inq_dimid(ncid, 'nrghice', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfileLW) status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liqLW) status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_iceLW) status = nf90_inq_dimid(ncid, 'nsizereg', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nSizeReg) + status = nf90_inquire_dimension(ncid, dimid, len=nSizeRegLW) status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_extLW) status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_gLW) status = nf90_inq_dimid(ncid, 'nbound', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inquire_dimension(ncid, dimid, len=nBoundLW) status = nf90_inq_dimid(ncid, 'pair', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_inquire_dimension(ncid, dimid, len=npairsLW) - ! Has the number of ice-roughnesses to use been provided from the namelist? - ! If not, use nrghice from cloud-optics data file. - if (nrghice .eq. 0) nrghice = nrghice_fromfile +#ifdef MPI + endif ! On master processor - ! Allocate space for arrays - if (doGP_cldoptics_LUT) then - allocate(lut_extliqLW(nSize_liq, nBand)) - allocate(lut_ssaliqLW(nSize_liq, nBand)) - allocate(lut_asyliqLW(nSize_liq, nBand)) - allocate(lut_exticeLW(nSize_ice, nBand, nrghice)) - allocate(lut_ssaiceLW(nSize_ice, nBand, nrghice)) - allocate(lut_asyiceLW(nSize_ice, nBand, nrghice)) - endif - if (doGP_cldoptics_PADE) then - allocate(pade_extliqLW(nBand, nSizeReg, nCoeff_ext )) - allocate(pade_ssaliqLW(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_asyliqLW(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_exticeLW(nBand, nSizeReg, nCoeff_ext, nrghice)) - allocate(pade_ssaiceLW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) - allocate(pade_asyiceLW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) - allocate(pade_sizereg_extliqLW(nBound)) - allocate(pade_sizereg_ssaliqLW(nBound)) - allocate(pade_sizereg_asyliqLW(nBound)) - allocate(pade_sizereg_exticeLW(nBound)) - allocate(pade_sizereg_ssaiceLW(nBound)) - allocate(pade_sizereg_asyiceLW(nBound)) - endif - allocate(band_limsCLDLW(2,nBand)) + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### + ! + ! Broadcast dimensions... + ! (ALL processors) + ! + ! ####################################################################################### + call mpi_bcast(nBandLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nSize_liqLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nSize_iceLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nSizeregLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nCoeff_extLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nCoeff_ssa_gLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nBoundLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nPairsLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) +#endif + + ! Has the number of ice-roughnesses to use been provided from the namelist? + ! If so, override nrghice from cloud-optics file + if (nrghice .ne. 0) nrghice_fromfileLW = nrghice +#ifdef MPI + call mpi_bcast(nrghice_fromfileLW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! + ! Allocate space for arrays... + ! (ALL processors) + ! + ! ####################################################################################### + if (doGP_cldoptics_LUT) then + allocate(lut_extliqLW(nSize_liqLW, nBandLW)) + allocate(lut_ssaliqLW(nSize_liqLW, nBandLW)) + allocate(lut_asyliqLW(nSize_liqLW, nBandLW)) + allocate(lut_exticeLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) + allocate(lut_ssaiceLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) + allocate(lut_asyiceLW(nSize_iceLW, nBandLW, nrghice_fromfileLW)) + endif + if (doGP_cldoptics_PADE) then + allocate(pade_extliqLW(nBandLW, nSizeRegLW, nCoeff_extLW )) + allocate(pade_ssaliqLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW)) + allocate(pade_asyliqLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW)) + allocate(pade_exticeLW(nBandLW, nSizeRegLW, nCoeff_extLW, nrghice_fromfileLW)) + allocate(pade_ssaiceLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW, nrghice_fromfileLW)) + allocate(pade_asyiceLW(nBandLW, nSizeRegLW, nCoeff_ssa_gLW, nrghice_fromfileLW)) + allocate(pade_sizereg_extliqLW(nBoundLW)) + allocate(pade_sizereg_ssaliqLW(nBoundLW)) + allocate(pade_sizereg_asyliqLW(nBoundLW)) + allocate(pade_sizereg_exticeLW(nBoundLW)) + allocate(pade_sizereg_ssaiceLW(nBoundLW)) + allocate(pade_sizereg_asyiceLW(nBoundLW)) + endif + allocate(band_limsCLDLW(2,nBandLW)) + ! ####################################################################################### + ! + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + call mpi_barrier(mpicomm, mpierr) + if (mpirank .eq. mpiroot) then +#endif ! Read in fields from file if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' @@ -246,24 +287,96 @@ subroutine rrtmgp_lw_cloud_optics_init(nCol, nLev, nbndsGPlw, doG_cldoptics, ! Close file status = nf90_close(ncid) -! endif - - ! Load tables data for RRTMGP cloud-optics +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### + ! + ! Broadcast data... + ! (ALL processors) + ! + ! ####################################################################################### + + ! Real scalars + call mpi_bcast(radliq_facLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_facLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radliq_lwrLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radliq_uprLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_lwrLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_uprLW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + + ! Real arrays + call mpi_bcast(band_limsCLDLW, size(band_limsCLDLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + if (doGP_cldoptics_LUT) then + call mpi_bcast(lut_extliqLW, size(lut_extliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaliqLW, size(lut_ssaliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyliqLW, size(lut_asyliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_exticeLW, size(lut_exticeLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaiceLW, size(lut_ssaiceLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyiceLW, size(lut_asyiceLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (doGP_cldoptics_PADE) then + call mpi_bcast(pade_extliqLW, size(pade_extliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_ssaliqLW, size(pade_ssaliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_asyliqLW, size(pade_asyliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_exticeLW, size(pade_exticeLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_ssaiceLW, size(pade_ssaiceLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_asyiceLW, size(pade_asyiceLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_extliqLW, size(pade_sizereg_extliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_ssaliqLW, size(pade_sizereg_ssaliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_asyliqLW, size(pade_sizereg_asyliqLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_exticeLW, size(pade_sizereg_exticeLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_ssaiceLW, size(pade_sizereg_ssaiceLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_asyiceLW, size(pade_sizereg_asyiceLW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif +#endif + + ! ####################################################################################### + ! + ! Initialize RRTMGP DDT's... + ! + ! ####################################################################################### if (doGP_cldoptics_LUT) then !$omp critical (load_lw_cloud_props_LUTs) - call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_limsCLDLW, & - radliq_lwrLW, radliq_uprLW, radliq_facLW, radice_lwrLW, radice_uprLW, radice_facLW, & - lut_extliqLW, lut_ssaliqLW, lut_asyliqLW, lut_exticeLW, lut_ssaiceLW, lut_asyiceLW)) + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_limsCLDLW, & + radliq_lwrLW, radliq_uprLW, radliq_facLW, radice_lwrLW, radice_uprLW, & + radice_facLW, lut_extliqLW, lut_ssaliqLW, lut_asyliqLW, lut_exticeLW, & + lut_ssaiceLW, lut_asyiceLW)) !$omp end critical (load_lw_cloud_props_LUTs) endif + if (doGP_cldoptics_PADE) then !$omp critical (load_lw_cloud_props_PADE_approx) - call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_limsCLDLW, & - pade_extliqLW, pade_ssaliqLW, pade_asyliqLW, pade_exticeLW, pade_ssaiceLW, pade_asyiceLW,& - pade_sizereg_extliqLW, pade_sizereg_ssaliqLW, pade_sizereg_asyliqLW, & - pade_sizereg_exticeLW, pade_sizereg_ssaiceLW, pade_sizereg_asyiceLW)) + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_limsCLDLW, & + pade_extliqLW, pade_ssaliqLW, pade_asyliqLW, pade_exticeLW, pade_ssaiceLW, & + pade_asyiceLW, pade_sizereg_extliqLW, pade_sizereg_ssaliqLW, & + pade_sizereg_asyliqLW, pade_sizereg_exticeLW, pade_sizereg_ssaiceLW, & + pade_sizereg_asyiceLW)) !$omp endcritical (load_lw_cloud_props_PADE_approx) endif + !$omp critical (load_lw_cloud_props_nrghice) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) !$omp end critical (load_lw_cloud_props_nrghice) @@ -277,9 +390,9 @@ end subroutine rrtmgp_lw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! subroutine rrtmgp_lw_cloud_optics_run(doLWrad, doG_cldoptics, icliq_lw, icice_lw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, nCol, nLev, nbndsGPlw, p_lay, & - cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & - cld_rerain, precip_frac, lon, lat, cldtaulw, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, doGP_lwscat, nCol, nLev, nbndsGPlw, & + p_lay, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, & + cld_rwp, cld_rerain, precip_frac, lon, lat, cldtaulw, & lw_optical_props_cloudsByBand, lw_optical_props_precipByBand, errmsg, errflg) ! Inputs diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta index 80cf60bf5..14852f3a0 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -7,30 +7,6 @@ [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_init type = scheme -[nbndsGPlw] - standard_name = number_of_lw_bands_rrtmgp - long_name = number of lw bands used in RRTMGP - units = count - dimensions = () - type = integer - intent = in - optional = F -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[nLev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F [doG_cldoptics] standard_name = flag_to_calc_lw_cld_optics_using_RRTMG long_name = logical flag to control cloud optics scheme. diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 611cb44c2..1b0500650 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -7,12 +7,16 @@ module rrtmgp_sw_cloud_optics use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_aux, only: check_error_msg use netcdf +#ifdef MPI + use mpi +#endif implicit none - - public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize type(ty_cloud_optics) :: sw_cloud_props + integer :: & + nrghice_fromfileSW, nBandSW, nSize_liqSW, nSize_iceSW, nSizeregSW, & + nCoeff_extSW, nCoeff_ssa_gSW, nBoundSW, nPairsSW real(kind_phys) :: & radliq_facSW, & ! Factor for calculating LUT interpolation indices for liquid radice_facSW ! Factor for calculating LUT interpolation indices for ice @@ -66,7 +70,7 @@ module rrtmgp_sw_cloud_optics !! \section arg_table_rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_sw_cloud_optics_init(nCol, nLev, nbndsGPsw, doG_cldoptics, doGP_cldoptics_PADE, & + subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, & doGP_cldoptics_LUT, nrghice, rrtmgp_root_dir, rrtmgp_sw_file_clouds, mpicomm, & mpirank, mpiroot, errmsg, errflg) @@ -78,12 +82,9 @@ subroutine rrtmgp_sw_cloud_optics_init(nCol, nLev, nbndsGPsw, doG_cldoptics, doG integer, intent(inout) :: & nrghice ! Number of ice-roughness categories integer, intent(in) :: & - nbndsGPsw, & ! Number of bands used in shortwave. mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank - mpiroot, & ! Master MPI rank - nCol, & ! Number of horizontal gridpoints - nLev ! Number of vertical levels + mpiroot ! Master MPI rank character(len=128),intent(in) :: & rrtmgp_root_dir, & ! RTE-RRTMGP root directory rrtmgp_sw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties @@ -94,15 +95,9 @@ subroutine rrtmgp_sw_cloud_optics_init(nCol, nLev, nbndsGPsw, doG_cldoptics, doG integer, intent(out) :: & errflg ! CCPP error code - ! Dimensions - integer :: & - nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizereg,& - nCoeff_ext, nCoeff_ssa_g, nBound, nPairs - ! Local variables - integer :: status,ncid,dimid,varID + integer :: status,ncid,dimid,varID,mpierr character(len=264) :: sw_cloud_props_file - integer,parameter :: nrghice_default=2 ! Initialize errmsg = '' @@ -113,61 +108,108 @@ subroutine rrtmgp_sw_cloud_optics_init(nCol, nLev, nbndsGPsw, doG_cldoptics, doG ! Filenames are set in the physics_nml sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) - ! On master processor only... -! if (mpirank .eq. mpiroot) then + ! ####################################################################################### + ! + ! Read dimensions for shortwave cloud-optics fields... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + if (mpirank .eq. mpiroot) then +#endif + write (*,*) 'Reading RRTMGP shortwave cloud-optics metadata ... ' + ! Open file status = nf90_open(trim(sw_cloud_props_file), NF90_NOWRITE, ncid) ! Read dimensions status = nf90_inq_dimid(ncid, 'nband', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inquire_dimension(ncid, dimid, len=nBandSW) status = nf90_inq_dimid(ncid, 'nrghice', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfileSW) status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liqSW) status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_iceSW) status = nf90_inq_dimid(ncid, 'nsizereg', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nSizereg) + status = nf90_inquire_dimension(ncid, dimid, len=nSizeregSW) status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_extSW) status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_gSW) status = nf90_inq_dimid(ncid, 'nbound', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inquire_dimension(ncid, dimid, len=nBoundSW) status = nf90_inq_dimid(ncid, 'pair', dimid) - status = nf90_inquire_dimension(ncid, dimid, len=nPairs) - - ! Has the number of ice-roughnesses provided from the namelist? - ! If not, use nrghice from cloud-optics file - if (nrghice .eq. 0) nrghice = nrghice_fromfile + status = nf90_inquire_dimension(ncid, dimid, len=nPairsSW) +#ifdef MPI + endif ! On master processor - ! Allocate space for arrays - if (doGP_cldoptics_LUT) then - allocate(lut_extliqSW(nSize_liq, nBand)) - allocate(lut_ssaliqSW(nSize_liq, nBand)) - allocate(lut_asyliqSW(nSize_liq, nBand)) - allocate(lut_exticeSW(nSize_ice, nBand, nrghice)) - allocate(lut_ssaiceSW(nSize_ice, nBand, nrghice)) - allocate(lut_asyiceSW(nSize_ice, nBand, nrghice)) - endif - if (doGP_cldoptics_PADE) then - allocate(pade_extliqSW(nBand, nSizeReg, nCoeff_ext )) - allocate(pade_ssaliqSW(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_asyliqSW(nBand, nSizeReg, nCoeff_ssa_g)) - allocate(pade_exticeSW(nBand, nSizeReg, nCoeff_ext, nrghice)) - allocate(pade_ssaiceSW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) - allocate(pade_asyiceSW(nBand, nSizeReg, nCoeff_ssa_g, nrghice)) - allocate(pade_sizereg_extliqSW(nBound)) - allocate(pade_sizereg_ssaliqSW(nBound)) - allocate(pade_sizereg_asyliqSW(nBound)) - allocate(pade_sizereg_exticeSW(nBound)) - allocate(pade_sizereg_ssaiceSW(nBound)) - allocate(pade_sizereg_asyiceSW(nBound)) - endif - allocate(band_limsCLDSW(2,nBand)) + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### + ! + ! Broadcast dimensions... + ! (ALL processors) + ! + ! ####################################################################################### + call mpi_bcast(nBandSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nSize_liqSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nSize_iceSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nSizeregSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nCoeff_extSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nCoeff_ssa_gSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nBoundSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call mpi_bcast(nPairsSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) +#endif + + ! Has the number of ice-roughnesses provided from the namelist? + ! If so, override nrghice from cloud-optics file + if (nrghice .ne. 0) nrghice_fromfileSW = nrghice +#ifdef MPI + call mpi_bcast(nrghice_fromfileSW, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) +#endif + + ! ####################################################################################### + ! + ! Allocate space for arrays... + ! (ALL processors) + ! + ! ####################################################################################### + if (doGP_cldoptics_LUT) then + allocate(lut_extliqSW(nSize_liqSW, nBandSW)) + allocate(lut_ssaliqSW(nSize_liqSW, nBandSW)) + allocate(lut_asyliqSW(nSize_liqSW, nBandSW)) + allocate(lut_exticeSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) + allocate(lut_ssaiceSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) + allocate(lut_asyiceSW(nSize_iceSW, nBandSW, nrghice_fromfileSW)) + endif + if (doGP_cldoptics_PADE) then + allocate(pade_extliqSW(nBandSW, nSizeRegSW, nCoeff_extSW )) + allocate(pade_ssaliqSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW)) + allocate(pade_asyliqSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW)) + allocate(pade_exticeSW(nBandSW, nSizeRegSW, nCoeff_extSW, nrghice_fromfileSW)) + allocate(pade_ssaiceSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW, nrghice_fromfileSW)) + allocate(pade_asyiceSW(nBandSW, nSizeRegSW, nCoeff_ssa_gSW, nrghice_fromfileSW)) + allocate(pade_sizereg_extliqSW(nBoundSW)) + allocate(pade_sizereg_ssaliqSW(nBoundSW)) + allocate(pade_sizereg_asyliqSW(nBoundSW)) + allocate(pade_sizereg_exticeSW(nBoundSW)) + allocate(pade_sizereg_ssaiceSW(nBoundSW)) + allocate(pade_sizereg_asyiceSW(nBoundSW)) + endif + allocate(band_limsCLDSW(2,nBandSW)) - ! Read in fields from file + ! ####################################################################################### + ! + ! Read in data ... + ! (ONLY master processor(0), if MPI enabled) + ! + ! ####################################################################################### +#ifdef MPI + call mpi_barrier(mpicomm, mpierr) + if (mpirank .eq. mpiroot) then +#endif if (doGP_cldoptics_LUT) then write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' status = nf90_inq_varid(ncid,'radliq_lwr',varID) @@ -241,26 +283,99 @@ subroutine rrtmgp_sw_cloud_optics_init(nCol, nLev, nbndsGPsw, doG_cldoptics, doG ! Close file status = nf90_close(ncid) -! endif - ! Load tables data for RRTMGP cloud-optics +#ifdef MPI + endif ! Master process + + ! Other processors waiting... + call mpi_barrier(mpicomm, mpierr) + + ! ####################################################################################### + ! + ! Broadcast data... + ! (ALL processors) + ! + ! ####################################################################################### + + ! Real scalars + call mpi_bcast(radliq_facSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_facSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radliq_lwrSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radliq_uprSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_lwrSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(radice_uprSW, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + + ! Real arrays + call mpi_bcast(band_limsCLDSW, size(band_limsCLDSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + if (doGP_cldoptics_LUT) then + call mpi_bcast(lut_extliqSW, size(lut_extliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaliqSW, size(lut_ssaliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyliqSW, size(lut_asyliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_exticeSW, size(lut_exticeSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_ssaiceSW, size(lut_ssaiceSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(lut_asyiceSW, size(lut_asyiceSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif + if (doGP_cldoptics_PADE) then + call mpi_bcast(pade_extliqSW, size(pade_extliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_ssaliqSW, size(pade_ssaliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_asyliqSW, size(pade_asyliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_exticeSW, size(pade_exticeSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_ssaiceSW, size(pade_ssaiceSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_asyiceSW, size(pade_asyiceSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_extliqSW, size(pade_sizereg_extliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_ssaliqSW, size(pade_sizereg_ssaliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_asyliqSW, size(pade_sizereg_asyliqSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_exticeSW, size(pade_sizereg_exticeSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_ssaiceSW, size(pade_sizereg_ssaiceSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + call mpi_bcast(pade_sizereg_asyiceSW, size(pade_sizereg_asyiceSW), & + MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) + endif +#endif + + ! ####################################################################################### + ! + ! Initialize RRTMGP DDT's... + ! + ! ####################################################################################### if (doGP_cldoptics_LUT) then !$omp critical (load_sw_cloud_props_LUTs) - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_limsCLDSW, & - radliq_lwrSW, radliq_uprSW, radliq_facSW, radice_lwrSW, radice_uprSW, radice_facSW, & - lut_extliqSW, lut_ssaliqSW, lut_asyliqSW, lut_exticeSW, lut_ssaiceSW, lut_asyiceSW)) + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_limsCLDSW, & + radliq_lwrSW, radliq_uprSW, radliq_facSW, radice_lwrSW, radice_uprSW, & + radice_facSW, lut_extliqSW, lut_ssaliqSW, lut_asyliqSW, lut_exticeSW, & + lut_ssaiceSW, lut_asyiceSW)) !$omp end critical (load_sw_cloud_props_LUTs) endif + if (doGP_cldoptics_PADE) then !$omp critical (load_sw_cloud_props_PADE_approx) - call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_limsCLDSW, & - pade_extliqSW, pade_ssaliqSW, pade_asyliqSW, pade_exticeSW, pade_ssaiceSW, pade_asyiceSW,& - pade_sizereg_extliqSW, pade_sizereg_ssaliqSW, pade_sizereg_asyliqSW, & - pade_sizereg_exticeSW, pade_sizereg_ssaiceSW, pade_sizereg_asyiceSW)) + call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_limsCLDSW, & + pade_extliqSW, pade_ssaliqSW, pade_asyliqSW, pade_exticeSW, pade_ssaiceSW, & + pade_asyiceSW, pade_sizereg_extliqSW, pade_sizereg_ssaliqSW, & + pade_sizereg_asyliqSW, pade_sizereg_exticeSW, pade_sizereg_ssaiceSW, & + pade_sizereg_asyiceSW)) !$omp end critical (load_sw_cloud_props_PADE_approx) endif + !$omp critical (load_sw_cloud_props_nrghice) - call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice_fromfileSW)) !$omp end critical (load_sw_cloud_props_nrghice) ! Initialize coefficients for rain and snow(+groupel) cloud optics @@ -289,9 +404,9 @@ end subroutine rrtmgp_sw_cloud_optics_init !! \htmlinclude rrtmgp_sw_cloud_optics.html !! subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw, & - doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nDay, nbndsGPsw, idxday, nrghice, cld_frac,& - cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & - precip_frac, sw_optical_props_cloudsByBand, & + doGP_cldoptics_PADE, doGP_cldoptics_LUT, nCol, nLev, nDay, nbndsGPsw, idxday, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, precip_frac, sw_optical_props_cloudsByBand, & sw_optical_props_precipByBand, cldtausw, errmsg, errflg) ! Inputs @@ -305,7 +420,6 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels nday, & ! Number of daylit points. - nrghice, & ! Number of ice-roughness categories icliq_sw, & ! Choice of treatment of liquid cloud optical properties (RRTMG legacy) icice_sw ! Choice of treatment of ice cloud optical properties (RRTMG legacy) integer,intent(in),dimension(ncol) :: & @@ -398,9 +512,9 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw ssaw = min(1._kind_phys-0.000001, ssa_prec/tau_prec) za1 = asyw * asyw za2 = ssaw * za1 - sw_optical_props_precipByBand%tau(idxday(iDay),iLay,iBand) = (1._kind_phys - za2) * tau_prec - sw_optical_props_precipByBand%ssa(idxday(iDay),iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) - sw_optical_props_precipByBand%g(idxday(iDay),iLay,iBand) = asyw/(1+asyw) + sw_optical_props_precipByBand%tau(iDay,iLay,iBand) = (1._kind_phys - za2) * tau_prec + sw_optical_props_precipByBand%ssa(iDay,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + sw_optical_props_precipByBand%g(iDay,iLay,iBand) = asyw/(1+asyw) enddo endif enddo diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index 3999f844b..e50d44bc8 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -7,30 +7,6 @@ [ccpp-arg-table] name = rrtmgp_sw_cloud_optics_init type = scheme -[ncol] - standard_name = horizontal_loop_extent - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[nLev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F -[nbndsGPsw] - standard_name = number_of_sw_bands_rrtmgp - long_name = number of sw bands used in RRTMGP - units = count - dimensions = () - type = integer - intent = in - optional = F [doG_cldoptics] standard_name = flag_to_calc_lw_cld_optics_using_RRTMG long_name = logical flag to control cloud optics scheme. @@ -190,14 +166,6 @@ type = logical intent = in optional = F -[nrghice] - standard_name = number_of_rrtmgp_ice_roughness - long_name = number of ice-roughness categories in RRTMGP calculation - units = count - dimensions = () - type = integer - intent = in - optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction From 8b0179bd98cf9f0362e20c30fcdd847afbf1490a Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Sat, 20 Feb 2021 08:42:51 -0500 Subject: [PATCH 218/274] updating noah mp --- physics/GFS_phys_time_vary.fv3.F90 | 23 +- physics/GFS_phys_time_vary.fv3.meta | 153 +- physics/GFS_rrtmgp_sw_pre.F90 | 17 +- physics/GFS_rrtmgp_sw_pre.meta | 36 + physics/module_sf_noahmp_glacier.f90 | 1512 ++++---- physics/module_sf_noahmplsm.f90 | 5007 +++++++++++++++----------- physics/noahmp_tables.f90 | 156 +- physics/radiation_surface.f | 153 +- physics/rrtmg_lw_pre.F90 | 7 +- physics/rrtmg_lw_pre.meta | 9 + physics/rrtmg_sw_pre.F90 | 10 +- physics/rrtmg_sw_pre.meta | 36 + physics/rrtmgp_lw_pre.F90 | 6 +- physics/rrtmgp_lw_pre.meta | 17 +- physics/sfc_noahmp_drv.F90 | 1529 ++++++++ physics/sfc_noahmp_drv.f | 1257 ------- physics/sfc_noahmp_drv.meta | 58 +- physics/sfcsub.F | 20 +- 18 files changed, 5786 insertions(+), 4220 deletions(-) create mode 100644 physics/sfc_noahmp_drv.F90 delete mode 100644 physics/sfc_noahmp_drv.f diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 28fdff772..052c6ef63 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -75,10 +75,10 @@ subroutine GFS_phys_time_vary_init ( isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& - qsnowxy, wslakexy, taussxy, waxy, wtxy, zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, & - rtmassxy, woodxy, stblcpxy, fastcpxy, smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, & - snliqxy, tsnoxy , smoiseq, zsnsoxy, slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, & - con_t0c, nthrds, errmsg, errflg) + qsnowxy, wslakexy, albdvis, albdnir, albivis, albinir, emiss, taussxy, waxy, wtxy, & + zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & + smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & + slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, nthrds, errmsg, errflg) implicit none @@ -125,6 +125,11 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout) :: alboldxy(:) real(kind_phys), intent(inout) :: qsnowxy(:) real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout) :: albdvis(:) + real(kind_phys), intent(inout) :: albdnir(:) + real(kind_phys), intent(inout) :: albivis(:) + real(kind_phys), intent(inout) :: albinir(:) + real(kind_phys), intent(inout) :: emiss(:) real(kind_phys), intent(inout) :: taussxy(:) real(kind_phys), intent(inout) :: waxy(:) real(kind_phys), intent(inout) :: wtxy(:) @@ -384,6 +389,11 @@ subroutine GFS_phys_time_vary_init ( alboldxy(:) = missing_value qsnowxy(:) = missing_value wslakexy(:) = missing_value + albdvis(:) = missing_value + albdnir(:) = missing_value + albivis(:) = missing_value + albinir(:) = missing_value + emiss(:) = missing_value taussxy(:) = missing_value waxy(:) = missing_value wtxy(:) = missing_value @@ -437,6 +447,11 @@ subroutine GFS_phys_time_vary_init ( ! already set to 0.0 wslakexy(ix) = 0.0 taussxy(ix) = 0.0 + albdvis(ix) = 0.2 + albdnir(ix) = 0.2 + albivis(ix) = 0.2 + albinir(ix) = 0.2 + emiss(ix) = 0.95 waxy(ix) = 4900.0 diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index d32c91ba6..62cd5e491 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -320,7 +320,7 @@ standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index1 for weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = inout optional = F @@ -328,7 +328,7 @@ standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = inout optional = F @@ -336,7 +336,7 @@ standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = inout kind = kind_phys @@ -345,7 +345,7 @@ standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = inout kind = kind_phys @@ -507,7 +507,7 @@ standard_name = vegetation_temperature long_name = vegetation temperature units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -516,7 +516,7 @@ standard_name = ground_temperature_for_noahmp long_name = ground temperature for noahmp units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -525,7 +525,7 @@ standard_name = canopy_air_temperature long_name = canopy air temperature units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -534,7 +534,7 @@ standard_name = canopy_intercepted_ice_mass long_name = canopy intercepted ice mass units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -543,7 +543,7 @@ standard_name = canopy_intercepted_liquid_water long_name = canopy intercepted liquid water units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -552,7 +552,7 @@ standard_name = canopy_air_vapor_pressure long_name = canopy air vapor pressure units = Pa - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -561,7 +561,7 @@ standard_name = surface_drag_coefficient_for_momentum_for_noahmp long_name = surface drag coefficient for momentum for noahmp units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -570,7 +570,7 @@ standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp long_name = surface exchange coeff heat & moisture for noahmp units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -579,7 +579,7 @@ standard_name = area_fraction_of_wet_canopy long_name = area fraction of canopy that is wetted/snowed units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -588,7 +588,7 @@ standard_name = snow_mass_at_previous_time_step long_name = snow mass at previous time step units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -597,7 +597,7 @@ standard_name = snow_albedo_at_previous_time_step long_name = snow albedo at previous time step units = frac - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -606,7 +606,7 @@ standard_name = snow_precipitation_rate_at_surface long_name = snow precipitation rate at surface units = mm s-1 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -615,7 +615,7 @@ standard_name = lake_water_storage long_name = lake water storage units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -624,7 +624,7 @@ standard_name = nondimensional_snow_age long_name = non-dimensional snow age units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -633,7 +633,7 @@ standard_name = water_storage_in_aquifer long_name = water storage in aquifer units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -642,7 +642,7 @@ standard_name = water_storage_in_aquifer_and_saturated_soil long_name = water storage in aquifer and saturated soil units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -651,7 +651,7 @@ standard_name = water_table_depth long_name = water table depth units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -660,7 +660,7 @@ standard_name = leaf_area_index long_name = leaf area index units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -669,7 +669,7 @@ standard_name = stem_area_index long_name = stem area index units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -678,7 +678,7 @@ standard_name = leaf_mass long_name = leaf mass units = g m-2 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -687,7 +687,7 @@ standard_name = stem_mass long_name = stem mass units = g m-2 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -696,7 +696,7 @@ standard_name = fine_root_mass long_name = fine root mass units = g m-2 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -705,7 +705,7 @@ standard_name = wood_mass long_name = wood mass including woody roots units = g m-2 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -714,7 +714,7 @@ standard_name = slow_soil_pool_mass_content_of_carbon long_name = stable carbon in deep soil units = g m-2 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -723,7 +723,7 @@ standard_name = fast_soil_pool_mass_content_of_carbon long_name = short-lived carbon in shallow soil units = g m-2 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -732,7 +732,7 @@ standard_name = soil_water_content_between_soil_bottom_and_water_table long_name = soil water content between the bottom of the soil and the water table units = m3 m-3 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -741,7 +741,7 @@ standard_name = water_table_recharge_when_deep long_name = recharge to or from the water table when deep units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -750,7 +750,52 @@ standard_name = water_table_recharge_when_shallow long_name = recharge to or from the water table when shallow units = m - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -759,7 +804,7 @@ standard_name = number_of_snow_layers long_name = number of snow layers units = count - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout @@ -768,7 +813,7 @@ standard_name = snow_layer_ice long_name = snow layer ice units = mm - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) type = real kind = kind_phys intent = inout @@ -777,7 +822,7 @@ standard_name = snow_layer_liquid_water long_name = snow layer liquid water units = mm - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) type = real kind = kind_phys intent = inout @@ -786,7 +831,7 @@ standard_name = snow_temperature long_name = snow_temperature units = K - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) type = real kind = kind_phys intent = inout @@ -795,7 +840,7 @@ standard_name = equilibrium_soil_water_content long_name = equilibrium soil water content units = m3 m-3 - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -804,7 +849,7 @@ standard_name = layer_bottom_depth_from_snow_surface long_name = depth from the top of the snow surface at the bottom of the layer units = m - dimensions = (horizontal_loop_extent, lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -813,7 +858,7 @@ standard_name = volume_fraction_of_unfrozen_soil_moisture long_name = liquid soil moisture units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension) + dimensions = (horizontal_dimension,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -822,7 +867,7 @@ standard_name = volume_fraction_of_soil_moisture long_name = total soil moisture units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension) + dimensions = (horizontal_dimension,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -831,7 +876,7 @@ standard_name = soil_temperature long_name = soil temperature units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension) + dimensions = (horizontal_dimension,soil_vertical_dimension) type = real kind = kind_phys intent = inout @@ -840,7 +885,7 @@ standard_name = surface_skin_temperature_over_land long_name = surface skin temperature over land units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -849,7 +894,7 @@ standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth units = mm - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -858,7 +903,7 @@ standard_name = canopy_water_amount long_name = canopy water amount units = kg m-2 - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -867,7 +912,7 @@ standard_name = deep_soil_temperature long_name = deep soil temperature units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -876,7 +921,7 @@ standard_name = soil_type_classification_real long_name = soil type for lsm units = index - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = in @@ -1579,7 +1624,7 @@ standard_name = volume_fraction_of_soil_moisture_for_land_surface_model long_name = volumetric fraction of soil moisture for lsm units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -1588,7 +1633,7 @@ standard_name = volume_fraction_of_unfrozen_soil_moisture_for_land_surface_model long_name = volume fraction of unfrozen soil moisture for lsm units = frac - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -1597,7 +1642,7 @@ standard_name = soil_temperature_for_land_surface_model long_name = soil temperature for land surface model units = K - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -1930,7 +1975,7 @@ standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index1 for weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = in optional = F @@ -1938,7 +1983,7 @@ standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation long_name = index2 for weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = integer intent = in optional = F @@ -1946,7 +1991,7 @@ standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight1 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = in kind = kind_phys @@ -1955,7 +2000,7 @@ standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = interpolation weight2 for tau NGWs units = none - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real intent = in kind = kind_phys @@ -1964,7 +2009,7 @@ standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux units = various - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 1268ed26f..69735a0dd 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -28,10 +28,10 @@ end subroutine GFS_rrtmgp_sw_pre_init !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & - tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, & - sfc_wts, p_lay, tv_lay, relhum, p_lev, sw_gas_props, nday, idxday, coszen, coszdg, & - sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, & - errmsg, errflg) + tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, & + albdnir, albivis, albinir,lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & + sw_gas_props, nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -68,6 +68,12 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ facwf, & ! Fractional coverage with weak cosz dependency (frac) fice, & ! Ice fraction over open water (frac) tisfc ! Sea ice surface skin temperature (K) + real(kind_phys), dimension(:), intent(in) :: & + albdvis, & ! surface albedo from lsm (direct,vis) (frac) + albdnir, & ! surface albedo from lsm (direct,nir) (frac) + albivis, & ! surface albedo from lsm (diffuse,vis) (frac) + albinir ! surface albedo from lsm (diffuse,nir) (frac) + real(kind_phys), dimension(nCol,n_var_lndp), intent(in) :: & sfc_wts ! Weights for stochastic surface physics perturbation () real(kind_phys), dimension(nCol,nLev),intent(in) :: & @@ -133,7 +139,8 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ alb1d(:) = 0. lndp_alb = -999. call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, NCOL, alb1d, lndp_alb, sfcalb) + alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, & + albinir, NCOL, alb1d, lndp_alb, sfcalb) ! Approximate mean surface albedo from vis- and nir- diffuse values. sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 202f1667a..f37f8231c 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -253,6 +253,42 @@ kind = kind_phys intent = in optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [sfc_wts] standard_name = weights_for_stochastic_surface_physics_perturbation long_name = weights for stochastic surface physics perturbation diff --git a/physics/module_sf_noahmp_glacier.f90 b/physics/module_sf_noahmp_glacier.f90 index 0b3749b5a..ebe4654bd 100644 --- a/physics/module_sf_noahmp_glacier.f90 +++ b/physics/module_sf_noahmp_glacier.f90 @@ -5,6 +5,7 @@ !>\ingroup NoahMP_LSM module noahmp_glacier_globals + use machine , only : kind_phys implicit none ! ================================================================================================== @@ -12,102 +13,57 @@ module noahmp_glacier_globals ! physical constants: ! !------------------------------------------------------------------------------------------! - real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) - real, parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) - real, parameter :: vkc = 0.40 !von karman constant - real, parameter :: tfrz = 273.16 !freezing/melting point (k) - real, parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) - real, parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) - real, parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) - real, parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) - real, parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) - real, parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) - real, parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) - real, parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) - real, parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) - real, parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) - real, parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) - real, parameter :: denh2o = 1000. !density of water (kg/m3) - real, parameter :: denice = 917. !density of ice (kg/m3) + real (kind=kind_phys), parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real (kind=kind_phys), parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) + real (kind=kind_phys), parameter :: vkc = 0.40 !von karman constant + real (kind=kind_phys), parameter :: tfrz = 273.16 !freezing/melting point (k) + real (kind=kind_phys), parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) + real (kind=kind_phys), parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) + real (kind=kind_phys), parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) + real (kind=kind_phys), parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) + real (kind=kind_phys), parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) + real (kind=kind_phys), parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) + real (kind=kind_phys), parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) + real (kind=kind_phys), parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) + real (kind=kind_phys), parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) + real (kind=kind_phys), parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) + real (kind=kind_phys), parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) + real (kind=kind_phys), parameter :: denh2o = 1000. !density of water (kg/m3) + real (kind=kind_phys), parameter :: denice = 917. !density of ice (kg/m3) ! =====================================options for different schemes================================ -! options for dynamic vegetation: -! 1 -> off (use table lai; use fveg = shdfac from input) -! 2 -> on (together with opt_crs = 1) -! 3 -> off (use table lai; calculate fveg) -! 4 -> off (use table lai; use maximum vegetation fraction) - - integer :: dveg != 2 ! - -! options for canopy stomatal resistance -! 1-> ball-berry; 2->jarvis - - integer :: opt_crs != 1 !(must 1 when dveg = 2) - -! options for soil moisture factor for stomatal resistance -! 1-> noah (soil moisture) -! 2-> clm (matric potential) -! 3-> ssib (matric potential) - - integer :: opt_btr != 1 !(suggested 1) - -! options for runoff and groundwater -! 1 -> topmodel with groundwater (niu et al. 2007 jgr) ; -! 2 -> topmodel with an equilibrium water table (niu et al. 2005 jgr) ; -! 3 -> original surface and subsurface runoff (free drainage) -! 4 -> bats surface and subsurface runoff (free drainage) - - integer :: opt_run != 1 !(suggested 1) - -! options for surface layer drag coeff (ch & cm) -! 1->m-o ; 2->original noah (chen97); 3->myj consistent; 4->ysu consistent. - - integer :: opt_sfc != 1 !(1 or 2 or 3 or 4) - -! options for supercooled liquid water (or ice fraction) -! 1-> no iteration (niu and yang, 2006 jhm); 2: koren's iteration - - integer :: opt_frz != 1 !(1 or 2) - -! options for frozen soil permeability -! 1 -> linear effects, more permeable (niu and yang, 2006, jhm) -! 2 -> nonlinear effects, less permeable (old) - - integer :: opt_inf != 1 !(suggested 1) - -! options for radiation transfer -! 1 -> modified two-stream (gap = f(solar angle, 3d structure ...)<1-fveg) -! 2 -> two-stream applied to grid-cell (gap = 0) -! 3 -> two-stream applied to vegetated fraction (gap=1-fveg) - - integer :: opt_rad != 1 !(suggested 1) ! options for ground snow surface albedo -! 1-> bats; 2 -> class +! 1-> BATS; 2 -> CLASS - integer :: opt_alb != 2 !(suggested 2) + INTEGER :: OPT_ALB != 2 !(suggested 2) ! options for partitioning precipitation into rainfall & snowfall -! 1 -> jordan (1991); 2 -> bats: when sfctmp sfctmp Jordan (1991); 2 -> BATS: when SFCTMP SFCTMP zero heat flux from bottom (zbot and tbot not used) -! 2 -> tbot at zbot (8m) read from a file (original noah) +! 1 -> zero heat flux from bottom (ZBOT and TBOT not used) +! 2 -> TBOT at ZBOT (8m) read from a file (original Noah) - integer :: opt_tbot != 2 !(suggested 2) + INTEGER :: OPT_TBOT != 2 !(suggested 2) ! options for snow/soil temperature time scheme (only layer 1) -! 1 -> semi-implicit; 2 -> full implicit (original noah) +! 1 -> semi-implicit; 2 -> full implicit (original Noah) + + INTEGER :: OPT_STC != 1 !(suggested 1) - integer :: opt_stc != 1 !(suggested 1) +! options for glacier treatment +! 1 -> include phase change of ice; 2 -> ice treatment more like original Noah + + INTEGER :: OPT_GLA != 1 !(suggested 1) ! adjustable parameters for snow processes - real, parameter :: z0sno = 0.002 !snow surface roughness length (m) (0.002) - real, parameter :: ssi = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) - real, parameter :: swemx = 1.00 !new snow mass to fully cover old snow (mm) + REAL, PARAMETER :: Z0SNO = 0.002 !snow surface roughness length (m) (0.002) + REAL, PARAMETER :: SSI = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) + REAL, PARAMETER :: SWEMX = 1.00 !new snow mass to fully cover old snow (mm) !equivalent to 10mm depth (density = 100 kg/m3) !------------------------------------------------------------------------------------------! @@ -168,9 +124,10 @@ subroutine noahmp_glacier (& trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out : qsnbot ,ponding ,ponding1,ponding2,t2m ,q2e , & ! out : #ifdef CCPP - emissi, fpice ,ch2b , esnow, errmsg, errflg) + emissi, fpice ,ch2b , esnow, albsnd, albsni , & + errmsg, errflg) #else - emissi, fpice ,ch2b , esnow) + emissi, fpice ,ch2b , esnow, albsnd, albsni) #endif @@ -183,68 +140,71 @@ subroutine noahmp_glacier (& ! input integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !no. of soil layers - real , intent(in) :: dt !time step [sec] - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: uu !wind speed in eastward dir (m/s) - real , intent(in) :: vv !wind speed in northward dir (m/s) - real , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: tbot !bottom condition for soil temp. [k] - real , intent(in) :: zlvl !reference height (m) - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. [k] + real (kind=kind_phys) , intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) ! input/output : need arbitary intial values - real , intent(inout) :: qsnow !snowfall [mm/s] - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , intent(inout) :: albold !snow albedo at last time step (class type) - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: qsnow !snowfall [mm/s] + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient ! prognostic variables integer , intent(inout) :: isnow !actual no. of snow layers [-] - real , intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] - real , intent(inout) :: snowh !snow height [m] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real , intent(inout) :: tg !ground temperature (k) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , intent(inout) :: tauss !non-dimensional snow age - real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer ! output - real , intent(out) :: fsa !total absorbed solar radiation (w/m2) - real , intent(out) :: fsr !total reflected solar radiation (w/m2) - real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(out) :: trad !surface radiative temperature (k) - real , intent(out) :: edir !soil surface evaporation rate (mm/s] - real , intent(out) :: runsrf !surface runoff [mm/s] - real , intent(out) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(out) :: sag !solar rad absorbed by ground (w/m2) - real , intent(out) :: albedo !surface albedo [-] - real , intent(out) :: qsnbot !snowmelt [mm/s] - real , intent(out) :: ponding!surface ponding [mm] - real , intent(out) :: ponding1!surface ponding [mm] - real , intent(out) :: ponding2!surface ponding [mm] - real , intent(out) :: t2m !2-m air temperature over bare ground part [k] - real , intent(out) :: q2e - real , intent(out) :: emissi - real , intent(out) :: fpice - real , intent(out) :: ch2b - real , intent(out) :: esnow + real (kind=kind_phys) , intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(out) :: trad !surface radiative temperature (k) + real (kind=kind_phys) , intent(out) :: edir !soil surface evaporation rate (mm/s] + real (kind=kind_phys) , intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(out) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(out) :: sag !solar rad absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: albedo !surface albedo [-] + real (kind=kind_phys) , intent(out) :: qsnbot !snowmelt [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding1!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding2!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: t2m !2-m air temperature over bare ground part [k] + real (kind=kind_phys) , intent(out) :: q2e + real (kind=kind_phys) , intent(out) :: emissi + real (kind=kind_phys) , intent(out) :: fpice + real (kind=kind_phys) , intent(out) :: ch2b + real (kind=kind_phys) , intent(out) :: esnow + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) + #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -254,24 +214,24 @@ subroutine noahmp_glacier (& ! local integer :: iz !do-loop index integer, dimension(-nsnow+1:nsoil) :: imelt !phase change index [1-melt; 2-freeze] - real :: rhoair !density air (kg/m3) - real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] - real :: thair !potential temperature (k) - real :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real :: eair !vapor pressure air (pa) - real, dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) - real, dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) - real, dimension( 1:nsoil) :: sice !soil ice content (m3/m3) - real, dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] - real :: qdew !ground surface dew rate [mm/s] - real :: qvap !ground surface evap. rate [mm/s] - real :: lathea !latent heat [j/kg] - real :: qmelt !internal pack melt - real :: swdown !downward solar [w/m2] - real :: beg_wb !beginning water for error check - real :: zbot = -8.0 + real (kind=kind_phys) :: rhoair !density air (kg/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys) :: thair !potential temperature (k) + real (kind=kind_phys) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) :: eair !vapor pressure air (pa) + real (kind=kind_phys), dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) + real (kind=kind_phys), dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice content (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) :: qdew !ground surface dew rate [mm/s] + real (kind=kind_phys) :: qvap !ground surface evap. rate [mm/s] + real (kind=kind_phys) :: lathea !latent heat [j/kg] + real (kind=kind_phys) :: qmelt !internal pack melt + real (kind=kind_phys) :: swdown !downward solar [w/m2] + real (kind=kind_phys) :: beg_wb !beginning water for error check + real (kind=kind_phys) :: zbot = -8.0 character*256 message @@ -308,7 +268,8 @@ subroutine noahmp_glacier (& #endif imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out - trad ,t2m ,ssoil ,lathea ,q2e ,emissi, ch2b ) !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out + ch2b ,albsnd ,albsni ) !out #ifdef CCPP if (errflg /= 0) return @@ -326,10 +287,15 @@ subroutine noahmp_glacier (& call water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in qvap ,qdew ,ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout - dzsnso ,sh2o ,sice ,ponding,zsnso , & !inout + dzsnso ,sh2o ,sice ,ponding,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out ) + if(opt_gla == 2) then + edir = qvap - qdew + fgev = edir * lathea + end if + ! if(maxval(sice) < 0.0001) then ! write(message,*) "glacier has melted at:",iloc,jloc," are you sure this should be a glacier point?" ! call wrf_debug(10,trim(message)) @@ -374,25 +340,25 @@ subroutine atm_glacier (sfcprs ,sfctmp ,q2 ,soldn ,cosz ,thair , & ! -------------------------------------------------------------------------------------------------- ! inputs - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] ! outputs - real , intent(out) :: thair !potential temperature (k) - real , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real , intent(out) :: eair !vapor pressure air (pa) - real, dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) - real, dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) - real , intent(out) :: rhoair !density air (kg/m3) - real , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(out) :: thair !potential temperature (k) + real (kind=kind_phys) , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) , intent(out) :: eair !vapor pressure air (pa) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] !locals - real :: pair !atm bottom level pressure (pa) + real (kind=kind_phys) :: pair !atm bottom level pressure (pa) ! -------------------------------------------------------------------------------------------------- pair = sfcprs ! atm bottom level pressure (pa) @@ -431,7 +397,8 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i #endif imelt ,snicev ,snliqv ,epore ,qmelt ,ponding, & !out sag ,fsa ,fsr ,fira ,fsh ,fgev , & !out - trad ,t2m ,ssoil ,lathea ,q2e ,emissi, ch2b ) !out + trad ,t2m ,ssoil ,lathea ,q2e ,emissi, & !out + ch2b ,albsnd ,albsni ) !out ! -------------------------------------------------------------------------------------------------- ! -------------------------------------------------------------------------------------------------- @@ -444,40 +411,40 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers integer , intent(in) :: isnow !actual no. of snow layers - real , intent(in) :: dt !time step [sec] - real , intent(in) :: qsnow !snowfall on the ground (mm/s) - real , intent(in) :: rhoair !density air (kg/m3) - real , intent(in) :: eair !vapor pressure air (pa) - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: qair !specific humidity (kg/kg) - real , intent(in) :: sfctmp !air temperature (k) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: uu !wind speed in e-w dir (m/s) - real , intent(in) :: vv !wind speed in n-s dir (m/s) - real , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) - real , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle (0-1) - real , intent(in) :: zref !reference height (m) - real , intent(in) :: tbot !bottom condition for soil temp. (k) - real , intent(in) :: zbot !depth for tbot [m] - real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] - real , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: qsnow !snowfall on the ground (mm/s) + real (kind=kind_phys) , intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(in) :: eair !vapor pressure air (pa) + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: qair !specific humidity (kg/kg) + real (kind=kind_phys) , intent(in) :: sfctmp !air temperature (k) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: uu !wind speed in e-w dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in n-s dir (m/s) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys) , intent(in) :: zref !reference height (m) + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. (k) + real (kind=kind_phys) , intent(in) :: zbot !depth for tbot [m] + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] ! input & output - real , intent(inout) :: tg !ground temperature (k) - real , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real , intent(inout) :: snowh !snow height [m] - real , intent(inout) :: sneqv !snow mass (mm) - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) - real , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) - real , intent(inout) :: albold !snow albedo at last time step(class type) - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient - real , intent(inout) :: tauss !snow aging factor - real , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys) , intent(inout) :: sneqv !snow mass (mm) + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step(class type) + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: tauss !snow aging factor + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer #ifdef CCPP character(len=*) , intent(inout) :: errmsg @@ -486,39 +453,41 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i ! outputs integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index [1-melt; 2-freeze] - real , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real , intent(out) :: qmelt !snowmelt [mm/s] - real , intent(out) :: ponding!pounding at ground [mm] - real , intent(out) :: sag !solar rad. absorbed by ground (w/m2) - real , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) - real , intent(out) :: fsr !tot. reflected solar radiation (w/m2) - real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] - real , intent(out) :: trad !radiative temperature (k) - real , intent(out) :: t2m !2 m height air temperature (k) - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(out) :: lathea !latent heat vap./sublimation (j/kg) - real , intent(out) :: q2e - real , intent(out) :: emissi - real , intent(out) :: ch2b !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) , intent(out) :: qmelt !snowmelt [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!pounding at ground [mm] + real (kind=kind_phys) , intent(out) :: sag !solar rad. absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !tot. reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: trad !radiative temperature (k) + real (kind=kind_phys) , intent(out) :: t2m !2 m height air temperature (k) + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(out) :: lathea !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(out) :: q2e + real (kind=kind_phys) , intent(out) :: emissi + real (kind=kind_phys) , intent(out) :: ch2b !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) ! local - real :: ur !wind speed at height zlvl (m/s) - real :: zlvl !reference height (m) - real :: rsurf !ground surface resistance (s/m) - real :: zpd !zero plane displacement (m) - real :: z0mg !z0 momentum, ground (m) - real :: emg !ground emissivity - real :: fire !emitted ir (w/m2) - real, dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change - real, dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] - real :: gamma !psychrometric constant (pa/k) - real :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys) :: zlvl !reference height (m) + real (kind=kind_phys) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys) :: zpd !zero plane displacement (m) + real (kind=kind_phys) :: z0mg !z0 momentum, ground (m) + real (kind=kind_phys) :: emg !ground emissivity + real (kind=kind_phys) :: fire !emitted ir (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys) :: rhsur !raltive humidity in surface soil/snow air space (-) ! --------------------------------------------------------------------------------------------------- @@ -545,7 +514,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i call radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in qsnow ,solad ,solai , & !in albold ,tauss , & !inout - sag ,fsr ,fsa) !out + sag ,fsr ,fsa , albsnd ,albsni) !out ! vegetation and ground emissivity @@ -610,7 +579,7 @@ subroutine energy_glacier (nsnow ,nsoil ,isnow ,dt ,qsnow ,rhoair , & !i if (snowh > 0.05 .and. tg > tfrz) tg = tfrz end if -! energy released or consumed by snow & frozen soil +! energy released or consumed by snow & ice call phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & !in dzsnso , & !in @@ -634,26 +603,26 @@ subroutine thermoprop_glacier (nsoil ,nsnow ,isnow ,dzsnso , & !in integer , intent(in) :: nsoil !number of soil layers integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: isnow !actual no. of snow layers - real , intent(in) :: dt !time step [s] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] - real , intent(in) :: snowh !snow height [m] + real (kind=kind_phys) , intent(in) :: dt !time step [s] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] + real (kind=kind_phys) , intent(in) :: snowh !snow height [m] ! outputs - real, dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change ! -------------------------------------------------------------------------------------------------- ! locals integer :: iz, iz2 - real, dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) - real :: zmid !mid-point soil depth + real (kind=kind_phys), dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) + real (kind=kind_phys) :: zmid !mid-point soil depth ! -------------------------------------------------------------------------------------------------- ! compute snow thermal conductivity and heat capacity @@ -708,22 +677,22 @@ subroutine csnow_glacier (isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso , integer, intent(in) :: isnow !number of snow layers (-) integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] ! outputs - real, dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] ! locals integer :: iz - real, dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) !--------------------------------------------------------------------------------------------------- ! thermal capacity of snow @@ -756,42 +725,42 @@ end subroutine csnow_glacier subroutine radiation_glacier (dt ,tg ,sneqvo ,sneqv ,cosz , & !in qsnow ,solad ,solai , & !in albold ,tauss , & !inout - sag ,fsr ,fsa) !out + sag ,fsr ,fsa,albsnd ,albsni) !out ! -------------------------------------------------------------------------------------------------- implicit none ! -------------------------------------------------------------------------------------------------- ! input - real, intent(in) :: dt !time step [s] - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow mass (mm) - real, intent(in) :: cosz !cosine solar zenith angle (0-1) - real, intent(in) :: qsnow !snowfall (mm/s) - real, dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) - real, dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys), intent(in) :: dt !time step [s] + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow mass (mm) + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys), intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys), dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) ! inout - real, intent(inout) :: albold !snow albedo at last time step (class type) - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), dimension(1:2) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albsni !snow albedo (diffuse) ! output - real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(out) :: fsr !total reflected solar radiation (w/m2) - real, intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsa !total absorbed solar radiation (w/m2) ! local integer :: ib !number of radiation bands integer :: nband !number of radiation bands - real :: fage !snow age function (0 - new snow) - real, dimension(1:2) :: albsnd !snow albedo (direct) - real, dimension(1:2) :: albsni !snow albedo (diffuse) - real :: alb !current class albedo - real :: abs !temporary absorbed rad - real :: ref !temporary reflected rad - real :: fsno !snow-cover fraction, = 1 if any snow - real, dimension(1:2) :: albice !albedo land ice: 1=vis, 2=nir + real (kind=kind_phys) :: fage !snow age function (0 - new snow) + real (kind=kind_phys) :: alb !current class albedo + real (kind=kind_phys) :: abs !temporary absorbed rad + real (kind=kind_phys) :: ref !temporary reflected rad + real (kind=kind_phys) :: fsno !snow-cover fraction, = 1 if any snow + real (kind=kind_phys), dimension(1:2) :: albice !albedo land ice: 1=vis, 2=nir - real,parameter :: mpe = 1.e-6 + real (kind=kind_phys),parameter :: mpe = 1.e-6 ! -------------------------------------------------------------------------------------------------- @@ -851,27 +820,27 @@ subroutine snow_age_glacier (dt,tg,sneqvo,sneqv,tauss,fage) ! from bats ! ------------------------ input/output variables -------------------------------------------------- !input - real, intent(in) :: dt !main time step (s) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow water per unit ground area (mm) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow water per unit ground area (mm) ! inout - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age !output - real, intent(out) :: fage !snow age + real (kind=kind_phys), intent(out) :: fage !snow age !local - real :: tage !total aging effects - real :: age1 !effects of grain growth due to vapor diffusion - real :: age2 !effects of grain growth at freezing of melt water - real :: age3 !effects of soot - real :: dela !temporary variable - real :: sge !temporary variable - real :: dels !temporary variable - real :: dela0 !temporary variable - real :: arg !temporary variable + real (kind=kind_phys) :: tage !total aging effects + real (kind=kind_phys) :: age1 !effects of grain growth due to vapor diffusion + real (kind=kind_phys) :: age2 !effects of grain growth at freezing of melt water + real (kind=kind_phys) :: age3 !effects of soot + real (kind=kind_phys) :: dela !temporary variable + real (kind=kind_phys) :: sge !temporary variable + real (kind=kind_phys) :: dels !temporary variable + real (kind=kind_phys) :: dela0 !temporary variable + real (kind=kind_phys) :: arg !temporary variable ! see yang et al. (1997) j.of climate for detail. !--------------------------------------------------------------------------------------------------- @@ -907,24 +876,24 @@ subroutine snowalb_bats_glacier (nband,cosz,fage,albsnd,albsni) integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: cosz !cosine solar zenith angle - real,intent(in) :: fage !snow age correction + real (kind=kind_phys),intent(in) :: cosz !cosine solar zenith angle + real (kind=kind_phys),intent(in) :: fage !snow age correction ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- - real :: fzen !zenith angle correction - real :: cf1 !temperary variable - real :: sl2 !2.*sl - real :: sl1 !1/sl - real :: sl !adjustable parameter - real, parameter :: c1 = 0.2 !default in bats - real, parameter :: c2 = 0.5 !default in bats -! real, parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's -! real, parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) + real (kind=kind_phys) :: fzen !zenith angle correction + real (kind=kind_phys) :: cf1 !temperary variable + real (kind=kind_phys) :: sl2 !2.*sl + real (kind=kind_phys) :: sl1 !1/sl + real (kind=kind_phys) :: sl !adjustable parameter + real (kind=kind_phys), parameter :: c1 = 0.2 !default in bats + real (kind=kind_phys), parameter :: c2 = 0.5 !default in bats +! real (kind=kind_phys), parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's +! real (kind=kind_phys), parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) ! --------------------------------------------------------------------------------------------- ! zero albedos for all points @@ -957,17 +926,17 @@ subroutine snowalb_class_glacier (nband,qsnow,dt,alb,albold,albsnd,albsni) integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: qsnow !snowfall (mm/s) - real,intent(in) :: dt !time step (sec) - real,intent(in) :: albold !snow albedo at last time step + real (kind=kind_phys),intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys),intent(in) :: dt !time step (sec) + real (kind=kind_phys),intent(in) :: albold !snow albedo at last time step ! in & out - real, intent(inout) :: alb ! + real (kind=kind_phys), intent(inout) :: alb ! ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- ! --------------------------------------------------------------------------------------------- @@ -1021,35 +990,35 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z ! input integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !number of soil layers - real, intent(in) :: emg !ground emissivity + real (kind=kind_phys), intent(in) :: emg !ground emissivity integer, intent(in) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: qair !specific humidity at height zlvl (kg/kg) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: rhoair !density air (kg/m3) - real, intent(in) :: sfcprs !density air (kg/m3) - real, intent(in) :: ur !wind speed at height zlvl (m/s) - real, intent(in) :: gamma !psychrometric constant (pa/k) - real, intent(in) :: rsurf !ground surface resistance (s/m) - real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) - real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) - real, intent(in) :: eair !vapor pressure air at height (pa) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture - real, dimension( 1:nsoil), intent(in) :: sh2o !soil liquid water - real, intent(in) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(in) :: snowh !actual snow depth [m] - real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: qair !specific humidity at height zlvl (kg/kg) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys), intent(in) :: sfcprs !density air (kg/m3) + real (kind=kind_phys), intent(in) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys), intent(in) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys), intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real (kind=kind_phys), intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys), intent(in) :: eair !vapor pressure air at height (pa) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sh2o !soil liquid water + real (kind=kind_phys), intent(in) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: snowh !actual snow depth [m] + real (kind=kind_phys), intent(in) :: lathea !latent heat of vaporization/subli (j/kg) ! input/output - real, intent(inout) :: cm !momentum drag coefficient - real, intent(inout) :: ch !sensible heat exchange coefficient - real, intent(inout) :: tgb !ground temperature (k) - real, intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: tgb !ground temperature (k) + real (kind=kind_phys), intent(inout) :: qsfc !mixing ratio at lowest model layer #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -1058,49 +1027,49 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z ! output ! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 - real, intent(out) :: irb !net longwave rad (w/m2) [+ to atm] - real, intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] - real, intent(out) :: evb !latent heat flux (w/m2) [+ to atm] - real, intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] - real, intent(out) :: t2mb !2 m height air temperature (k) - real, intent(out) :: q2b !bare ground heat conductance - real, intent(out) :: ehb2 !sensible heat conductance for diagnostics + real (kind=kind_phys), intent(out) :: irb !net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: evb !latent heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys), intent(out) :: t2mb !2 m height air temperature (k) + real (kind=kind_phys), intent(out) :: q2b !bare ground heat conductance + real (kind=kind_phys), intent(out) :: ehb2 !sensible heat conductance for diagnostics ! local variables integer :: niterb !number of iterations for surface temperature - real :: mpe !prevents overflow error if division by zero - real :: dtg !change in tg, last iteration (k) + real (kind=kind_phys) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys) :: dtg !change in tg, last iteration (k) integer :: mozsgn !number of times moz changes sign - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: fm2 !monin-obukhov momentum adjustment at 2m - real :: fh2 !monin-obukhov heat adjustment at 2m - real :: ch2 !surface exchange at 2m - real :: h !temporary sensible heat flux (w/m2) - real :: fv !friction velocity (m/s) - real :: cir !coefficients for ir as function of ts**4 - real :: cgh !coefficients for st as function of ts - real :: csh !coefficients for sh as function of ts - real :: cev !coefficients for ev as function of esat[ts] - real :: cq2b ! + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: fm2 !monin-obukhov momentum adjustment at 2m + real (kind=kind_phys) :: fh2 !monin-obukhov heat adjustment at 2m + real (kind=kind_phys) :: ch2 !surface exchange at 2m + real (kind=kind_phys) :: h !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: fv !friction velocity (m/s) + real (kind=kind_phys) :: cir !coefficients for ir as function of ts**4 + real (kind=kind_phys) :: cgh !coefficients for st as function of ts + real (kind=kind_phys) :: csh !coefficients for sh as function of ts + real (kind=kind_phys) :: cev !coefficients for ev as function of esat[ts] + real (kind=kind_phys) :: cq2b ! integer :: iter !iteration index - real :: z0h !roughness length, sensible heat, ground (m) - real :: moz !monin-obukhov stability parameter - real :: fm !momentum stability correction, weighted by prior iters - real :: fh !sen heat stability correction, weighted by prior iters - real :: ramb !aerodynamic resistance for momentum (s/m) - real :: rahb !aerodynamic resistance for sensible heat (s/m) - real :: rawb !aerodynamic resistance for water vapor (s/m) - real :: estg !saturation vapor pressure at tg (pa) - real :: destg !d(es)/dt at tg (pa/k) - real :: esatw !es for water - real :: esati !es for ice - real :: dsatw !d(es)/dt at tg (pa/k) for water - real :: dsati !d(es)/dt at tg (pa/k) for ice - real :: a !temporary calculation - real :: b !temporary calculation - real :: t, tdc !kelvin to degree celsius with limit -50 to +50 - real, dimension( 1:nsoil) :: sice !soil ice + real (kind=kind_phys) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys) :: moz !monin-obukhov stability parameter + real (kind=kind_phys) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys) :: ramb !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahb !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawb !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: estg !saturation vapor pressure at tg (pa) + real (kind=kind_phys) :: destg !d(es)/dt at tg (pa/k) + real (kind=kind_phys) :: esatw !es for water + real (kind=kind_phys) :: esati !es for ice + real (kind=kind_phys) :: dsatw !d(es)/dt at tg (pa/k) for water + real (kind=kind_phys) :: dsati !d(es)/dt at tg (pa/k) for ice + real (kind=kind_phys) :: a !temporary calculation + real (kind=kind_phys) :: b !temporary calculation + real (kind=kind_phys) :: t, tdc !kelvin to degree celsius with limit -50 to +50 + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice tdc(t) = min( 50., max(-50.,(t-tfrz)) ) @@ -1156,7 +1125,11 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z end if csh = rhoair*cpair/rahb - cev = rhoair*cpair/gamma/(rsurf+rawb) + if(snowh > 0.0 .or. opt_gla == 1) then + cev = rhoair*cpair/gamma/(rsurf+rawb) + else + cev = 0.0 ! don't allow any sublimation of glacier in opt_gla=2 + end if ! surface fluxes and dtg @@ -1195,9 +1168,13 @@ subroutine glacier_flux (nsoil ,nsnow ,emg ,isnow ,df ,dzsnso ,z ! if snow on ground and tg > tfrz: reset tg = tfrz. reevaluate ground fluxes. sice = smc - sh2o - if(opt_stc == 1) then - if ((maxval(sice) > 0.0 .or. snowh > 0.0) .and. tgb > tfrz) then + if(opt_stc == 1 .or. opt_stc ==3) then + if ((maxval(sice) > 0.0 .or. snowh > 0.0) .and. tgb > tfrz .and. opt_gla == 1) then tgb = tfrz + t = tdc(tgb) ! mb: recalculate estg + call esat(t, esatw, esati, dsatw, dsati) + estg = esati + qsfc = 0.622*(estg*rhsur)/(sfcprs-0.378*(estg*rhsur)) irb = cir * tgb**4 - emg*lwdn shb = csh * (tgb - sfctmp) evb = cev * (estg*rhsur - eair ) !estg reevaluate ? @@ -1230,21 +1207,21 @@ subroutine esat(t, esw, esi, desw, desi) !--------------------------------------------------------------------------------------------------- ! in - real, intent(in) :: t !temperature + real (kind=kind_phys), intent(in) :: t !temperature !out - real, intent(out) :: esw !saturation vapor pressure over water (pa) - real, intent(out) :: esi !saturation vapor pressure over ice (pa) - real, intent(out) :: desw !d(esat)/dt over water (pa/k) - real, intent(out) :: desi !d(esat)/dt over ice (pa/k) + real (kind=kind_phys), intent(out) :: esw !saturation vapor pressure over water (pa) + real (kind=kind_phys), intent(out) :: esi !saturation vapor pressure over ice (pa) + real (kind=kind_phys), intent(out) :: desw !d(esat)/dt over water (pa/k) + real (kind=kind_phys), intent(out) :: desi !d(esat)/dt over ice (pa/k) ! local - real :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water - real :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice - real :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water - real :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice + real (kind=kind_phys) :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water + real (kind=kind_phys) :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice + real (kind=kind_phys) :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water + real (kind=kind_phys) :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice parameter (a0=6.107799961 , a1=4.436518521e-01, & a2=1.428945805e-02, a3=2.650648471e-04, & @@ -1289,24 +1266,24 @@ subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in ! ------------------------------------------------------------------------------------------------- ! inputs integer, intent(in) :: iter !iteration index - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0h !roughness length, sensible heat, ground (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: qair !specific humidity at reference height (kg/kg) - real, intent(in) :: sfctmp !temperature at reference height (k) - real, intent(in) :: h !sensible heat flux (w/m2) [+ to atm] - real, intent(in) :: rhoair !density air (kg/m**3) - real, intent(in) :: mpe !prevents overflow error if division by zero - real, intent(in) :: ur !wind speed (m/s) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: qair !specific humidity at reference height (kg/kg) + real (kind=kind_phys), intent(in) :: sfctmp !temperature at reference height (k) + real (kind=kind_phys), intent(in) :: h !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m**3) + real (kind=kind_phys), intent(in) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys), intent(in) :: ur !wind speed (m/s) ! in & out - real, intent(inout) :: moz !monin-obukhov stability (z/l) + real (kind=kind_phys), intent(inout) :: moz !monin-obukhov stability (z/l) integer, intent(inout) :: mozsgn !number of times moz changes sign - real, intent(inout) :: fm !momentum stability correction, weighted by prior iters - real, intent(inout) :: fh !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -1314,28 +1291,28 @@ subroutine sfcdif1_glacier(iter ,zlvl ,zpd ,z0h ,z0m , & !in #endif ! outputs - real, intent(out) :: fv !friction velocity (m/s) - real, intent(out) :: cm !drag coefficient for momentum - real, intent(out) :: ch !drag coefficient for heat - real, intent(out) :: ch2 !drag coefficient for heat + real (kind=kind_phys), intent(out) :: fv !friction velocity (m/s) + real (kind=kind_phys), intent(out) :: cm !drag coefficient for momentum + real (kind=kind_phys), intent(out) :: ch !drag coefficient for heat + real (kind=kind_phys), intent(out) :: ch2 !drag coefficient for heat ! locals - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: tmpcm !temporary calculation for cm - real :: tmpch !temporary calculation for ch - real :: mol !monin-obukhov length (m) - real :: tvir !temporary virtual temperature (k) - real :: tmp1,tmp2,tmp3 !temporary calculation - real :: fmnew !stability correction factor, momentum, for current moz - real :: fhnew !stability correction factor, sen heat, for current moz - real :: moz2 !2/l - real :: tmpcm2 !temporary calculation for cm2 - real :: tmpch2 !temporary calculation for ch2 - real :: fm2new !stability correction factor, momentum, for current moz - real :: fh2new !stability correction factor, sen heat, for current moz - real :: tmp12,tmp22,tmp32 !temporary calculation - - real :: cmfm, chfh, cm2fm2, ch2fh2 + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: tmpcm !temporary calculation for cm + real (kind=kind_phys) :: tmpch !temporary calculation for ch + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: tvir !temporary virtual temperature (k) + real (kind=kind_phys) :: tmp1,tmp2,tmp3 !temporary calculation + real (kind=kind_phys) :: fmnew !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fhnew !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: moz2 !2/l + real (kind=kind_phys) :: tmpcm2 !temporary calculation for cm2 + real (kind=kind_phys) :: tmpch2 !temporary calculation for ch2 + real (kind=kind_phys) :: fm2new !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fh2new !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: tmp12,tmp22,tmp32 !temporary calculation + + real (kind=kind_phys) :: cmfm, chfh, cm2fm2, ch2fh2 ! ------------------------------------------------------------------------------------------------- @@ -1465,26 +1442,26 @@ subroutine tsnosoi_glacier (nsoil ,nsnow ,isnow ,dt ,tbot , & !in integer, intent(in) :: nsnow !maximum no of snow layers (3) integer, intent(in) :: isnow !actual no of snow layers - real, intent(in) :: dt !time step (s) - real, intent(in) :: tbot ! - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, intent(in) :: snowh !snow depth (m) - real, intent(in) :: zbot !from soil surface (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: tbot ! + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), intent(in) :: snowh !snow depth (m) + real (kind=kind_phys), intent(in) :: zbot !from soil surface (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) !input and output - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !local integer :: iz - real :: zbotsno !zbot from snow surface - real, dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts - real :: eflxb !energy influx from soil bottom (w/m2) - real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) + real (kind=kind_phys) :: zbotsno !zbot from snow surface + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts + real (kind=kind_phys) :: eflxb !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) ! ---------------------------------------------------------------------- @@ -1530,32 +1507,32 @@ subroutine hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & !in integer, intent(in) :: nsoil !no of soil layers (4) integer, intent(in) :: nsnow !maximum no of snow layers (3) integer, intent(in) :: isnow !actual no of snow layers - real, intent(in) :: tbot !bottom soil temp. at zbot (k) - real, intent(in) :: zbot !depth of lower boundary condition (m) + real (kind=kind_phys), intent(in) :: tbot !bottom soil temp. at zbot (k) + real (kind=kind_phys), intent(in) :: zbot !depth of lower boundary condition (m) !from soil surface not snow surface - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) ! output - real, dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix - real, dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient - real, intent(out) :: botflx !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient + real (kind=kind_phys), intent(out) :: botflx !energy influx from soil bottom (w/m2) ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: ddz - real, dimension(-nsnow+1:nsoil) :: denom - real, dimension(-nsnow+1:nsoil) :: dtsdz - real, dimension(-nsnow+1:nsoil) :: eflux - real :: temp1 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ddz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: denom + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dtsdz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: eflux + real (kind=kind_phys) :: temp1 ! ---------------------------------------------------------------------- do k = isnow+1, nsoil @@ -1589,7 +1566,7 @@ subroutine hrt_glacier (nsnow ,nsoil ,isnow ,zsnso , & !in if (k == isnow+1) then ai(k) = 0.0 ci(k) = - df(k) * ddz(k) / denom(k) - if (opt_stc == 1) then + if (opt_stc == 1 .or. opt_stc == 3) then bi(k) = - ci(k) end if if (opt_stc == 2) then @@ -1624,19 +1601,19 @@ subroutine hstep_glacier (nsnow ,nsoil ,isnow ,dt , & !in integer, intent(in) :: nsoil integer, intent(in) :: nsnow integer, intent(in) :: isnow - real, intent(in) :: dt + real (kind=kind_phys), intent(in) :: dt ! output & input - real, dimension(-nsnow+1:nsoil), intent(inout) :: ai - real, dimension(-nsnow+1:nsoil), intent(inout) :: bi - real, dimension(-nsnow+1:nsoil), intent(inout) :: ci - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc - real, dimension(-nsnow+1:nsoil), intent(inout) :: rhsts + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ai + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: bi + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ci + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: rhsts ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: rhstsin - real, dimension(-nsnow+1:nsoil) :: ciin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: rhstsin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ciin ! ---------------------------------------------------------------------- do k = isnow+1,nsoil @@ -1691,8 +1668,8 @@ subroutine rosr12_glacier (p,a,b,c,d,delta,ntop,nsoil,nsnow) integer, intent(in) :: nsoil,nsnow integer :: k, kk - real, dimension(-nsnow+1:nsoil),intent(in):: a, b, d - real, dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(in):: a, b, d + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta ! ---------------------------------------------------------------------- ! initialize eqn coef c for the lowest soil layer @@ -1742,39 +1719,39 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & integer, intent(in) :: nsnow !maximum no. of snow layers [=3] integer, intent(in) :: nsoil !no. of soil layers [=4] integer, intent(in) :: isnow !actual no. of snow layers [<=3] - real, intent(in) :: dt !land model time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), intent(in) :: dt !land model time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] ! inputs/outputs - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] - real, intent(inout) :: sneqv - real, intent(inout) :: snowh - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: sneqv + real (kind=kind_phys), intent(inout) :: snowh + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] ! outputs - real, intent(out) :: qmelt !snowmelt rate [mm/s] + real (kind=kind_phys), intent(out) :: qmelt !snowmelt rate [mm/s] integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index - real, intent(out) :: ponding!snowmelt when snow has no layer [mm] + real (kind=kind_phys), intent(out) :: ponding!snowmelt when snow has no layer [mm] ! local integer :: j,k !do loop index - real, dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] - real, dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] - real, dimension(-nsnow+1:nsoil) :: wmass0 - real, dimension(-nsnow+1:nsoil) :: wice0 - real, dimension(-nsnow+1:nsoil) :: wliq0 - real, dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] - real, dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] - real, dimension(-nsnow+1:nsoil) :: heatr !energy residual or loss after melting/freezing - real :: temp1 !temporary variables [kg/m2] - real :: propor - real :: xmf !total latent heat of phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wmass0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wice0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wliq0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: heatr !energy residual or loss after melting/freezing + real (kind=kind_phys) :: temp1 !temporary variables [kg/m2] + real (kind=kind_phys) :: propor + real (kind=kind_phys) :: xmf !total latent heat of phase change ! ---------------------------------------------------------------------- ! initialization @@ -1788,12 +1765,106 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & mliq(j) = snliq(j) end do + do j = isnow+1,0 ! all snow layers; do ice later + imelt(j) = 0 + hm(j) = 0. + xm(j) = 0. + wice0(j) = mice(j) + wliq0(j) = mliq(j) + wmass0(j) = mice(j) + mliq(j) + enddo + + do j = isnow+1,0 + if (mice(j) > 0. .and. stc(j) >= tfrz) then ! melting + imelt(j) = 1 + endif + if (mliq(j) > 0. .and. stc(j) < tfrz) then ! freezing + imelt(j) = 2 + endif + + enddo + +! calculate the energy surplus and loss for melting and freezing + + do j = isnow+1,0 + if (imelt(j) > 0) then + hm(j) = (stc(j)-tfrz)/fact(j) + stc(j) = tfrz + endif + + if (imelt(j) == 1 .and. hm(j) < 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + if (imelt(j) == 2 .and. hm(j) > 0.) then + hm(j) = 0. + imelt(j) = 0 + endif + xm(j) = hm(j)*dt/hfus + enddo + +! the rate of melting and freezing for snow without a layer, opt_gla==1 treated below + +if (opt_gla == 2) then + + if (isnow == 0 .and. sneqv > 0. .and. stc(1) >= tfrz) then + hm(1) = (stc(1)-tfrz)/fact(1) ! available heat + stc(1) = tfrz ! set t to freezing + xm(1) = hm(1)*dt/hfus ! total snow melt possible + + temp1 = sneqv + sneqv = max(0.,temp1-xm(1)) ! snow remaining + propor = sneqv/temp1 ! fraction melted + snowh = max(0.,propor * snowh) ! new snow height + heatr(1) = hm(1) - hfus*(temp1-sneqv)/dt ! excess heat + if (heatr(1) > 0.) then + xm(1) = heatr(1)*dt/hfus + stc(1) = stc(1) + fact(1)*heatr(1) ! re-heat ice + else + xm(1) = 0. ! heat used up + hm(1) = 0. + endif + qmelt = max(0.,(temp1-sneqv))/dt ! melted snow rate + xmf = hfus*qmelt ! melted snow energy + ponding = temp1-sneqv ! melt water + endif + +end if ! opt_gla == 2 + +! the rate of melting and freezing for snow + + do j = isnow+1,0 + if (imelt(j) > 0 .and. abs(hm(j)) > 0.) then + + heatr(j) = 0. + if (xm(j) > 0.) then + mice(j) = max(0., wice0(j)-xm(j)) + heatr(j) = hm(j) - hfus*(wice0(j)-mice(j))/dt + else if (xm(j) < 0.) then + mice(j) = min(wmass0(j), wice0(j)-xm(j)) + heatr(j) = hm(j) - hfus*(wice0(j)-mice(j))/dt + endif + + mliq(j) = max(0.,wmass0(j)-mice(j)) + + if (abs(heatr(j)) > 0.) then + stc(j) = stc(j) + fact(j)*heatr(j) + if (mliq(j)*mice(j)>0.) stc(j) = tfrz + endif + + qmelt = qmelt + max(0.,(wice0(j)-mice(j)))/dt + + endif + enddo + +if (opt_gla == 1) then ! operate on the ice layers + do j = 1, nsoil ! all soil layers mliq(j) = sh2o(j) * dzsnso(j) * 1000. mice(j) = (smc(j) - sh2o(j)) * dzsnso(j) * 1000. end do - do j = isnow+1,nsoil ! all layers + do j = 1,nsoil ! all layers imelt(j) = 0 hm(j) = 0. xm(j) = 0. @@ -1802,7 +1873,7 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & wmass0(j) = mice(j) + mliq(j) enddo - do j = isnow+1,nsoil + do j = 1,nsoil if (mice(j) > 0. .and. stc(j) >= tfrz) then ! melting imelt(j) = 1 endif @@ -1820,7 +1891,7 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & ! calculate the energy surplus and loss for melting and freezing - do j = isnow+1,nsoil + do j = 1,nsoil if (imelt(j) > 0) then hm(j) = (stc(j)-tfrz)/fact(j) stc(j) = tfrz @@ -1859,9 +1930,9 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & ponding = temp1-sneqv endif -! the rate of melting and freezing for snow and soil +! the rate of melting and freezing for soil - do j = isnow+1,nsoil + do j = 1,nsoil if (imelt(j) > 0 .and. abs(hm(j)) > 0.) then heatr(j) = 0. @@ -2001,6 +2072,8 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & end if end do end if + +end if ! opt_gla == 1 do j = isnow+1,0 ! snow snliq(j) = mliq(j) @@ -2008,10 +2081,14 @@ subroutine phasechange_glacier (nsnow ,nsoil ,isnow ,dt ,fact , & end do do j = 1, nsoil ! soil + if(opt_gla == 1) then sh2o(j) = mliq(j) / (1000. * dzsnso(j)) sh2o(j) = max(0.0,min(1.0,sh2o(j))) ! smc(j) = (mliq(j) + mice(j)) / (1000. * dzsnso(j)) - smc(j) = 1.0 + elseif(opt_gla == 2) then + sh2o(j) = 0.0 ! ice, assume all frozen...forever + end if + smc(j) = 1.0 end do end subroutine phasechange_glacier @@ -2020,7 +2097,7 @@ end subroutine phasechange_glacier subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in qvap ,qdew ,ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq ,stc , & !inout - dzsnso ,sh2o ,sice ,ponding,zsnso , & !inout + dzsnso ,sh2o ,sice ,ponding,zsnso ,fsh , & !inout runsrf ,runsub ,qsnow ,ponding1 ,ponding2,qsnbot,fpice,esnow & !out ) !out ! ---------------------------------------------------------------------- @@ -2033,49 +2110,50 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [1-melt; 2-freeze] - real, intent(in) :: dt !main time step (s) - real, intent(in) :: prcp !precipitation (mm/s) - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: qvap !soil surface evaporation rate[mm/s] - real, intent(in) :: qdew !soil surface dew rate[mm/s] - real, dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: prcp !precipitation (mm/s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(inout) :: qvap !soil surface evaporation rate[mm/s] + real (kind=kind_phys), intent(inout) :: qdew !soil surface dew rate[mm/s] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) ! input/output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] - real , intent(inout) :: ponding ![mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] + real (kind=kind_phys) , intent(inout) :: ponding ![mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , intent(inout) :: fsh !total sensible heat (w/m2) [+ to atm] ! output - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: runsub !baseflow (sturation excess) [mm/s] - real, intent(out) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real, intent(out) :: fpice !precipitation frozen fraction - real, intent(out) :: esnow ! + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: runsub !baseflow (sturation excess) [mm/s] + real (kind=kind_phys), intent(out) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: fpice !precipitation frozen fraction + real (kind=kind_phys), intent(out) :: esnow ! ! local - real :: qrain !rain at ground srf (mm) [+] - real :: qseva !soil surface evap rate [mm/s] - real :: qsdew !soil surface dew rate [mm/s] - real :: qsnfro !snow surface frost rate[mm/s] - real :: qsnsub !snow surface sublimation rate [mm/s] - real :: snowhin !snow depth increasing rate (m/s) - real :: snoflow !glacier flow [mm/s] - real :: bdfall !density of new snow (mm water/m snow) - real :: replace !replacement water due to sublimation of glacier - real, dimension( 1:nsoil) :: sice_save !soil ice content [m3/m3] - real, dimension( 1:nsoil) :: sh2o_save !soil liquid water content [m3/m3] + real (kind=kind_phys) :: qrain !rain at ground srf (mm) [+] + real (kind=kind_phys) :: qseva !soil surface evap rate [mm/s] + real (kind=kind_phys) :: qsdew !soil surface dew rate [mm/s] + real (kind=kind_phys) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys) :: qsnsub !snow surface sublimation rate [mm/s] + real (kind=kind_phys) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys) :: snoflow !glacier flow [mm/s] + real (kind=kind_phys) :: bdfall !density of new snow (mm water/m snow) + real (kind=kind_phys) :: replace !replacement water due to sublimation of glacier + real (kind=kind_phys), dimension( 1:nsoil) :: sice_save !soil ice content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil) :: sh2o_save !soil liquid water content [m3/m3] integer :: ilev @@ -2136,38 +2214,17 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in ! sublimation, frost, evaporation, and dew -! qsnsub = 0. -! if (sneqv > 0.) then -! qsnsub = min(qvap, sneqv/dt) -! endif -! qseva = qvap-qsnsub - -! qsnfro = 0. -! if (sneqv > 0.) then -! qsnfro = qdew -! endif -! qsdew = qdew - qsnfro - qsnsub = qvap ! send total sublimation/frost to snowwater and deal with it there qsnfro = qdew esnow = qsnsub*2.83e+6 - -! print *, 'qvap',qvap,qvap*dt -! print *, 'qsnsub',qsnsub,qsnsub*dt -! print *, 'qseva',qseva,qseva*dt -! print *, 'qsnfro',qsnfro,qsnfro*dt -! print *, 'qdew',qdew,qdew*dt -! print *, 'qsdew',qsdew,qsdew*dt -!print *, 'before snowwater', sneqv,snowh,snice,snliq,sh2o,sice call snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in snowhin,qsnow ,qsnfro ,qsnsub ,qrain , & !in ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq , & !inout sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout + fsh , & !inout qsnbot ,snoflow,ponding1 ,ponding2) !out -!print *, 'after snowwater', sneqv,snowh,snice,snliq,sh2o,sice -!print *, 'ponding', ponding,ponding1,ponding2 !ponding: melting water from snow when there is no layer @@ -2180,20 +2237,29 @@ subroutine water_glacier (nsnow ,nsoil ,imelt ,dt ,prcp ,sfctmp , & !in endif - replace = 0.0 - do ilev = 1,nsoil + if(opt_gla == 1) then + replace = 0.0 + do ilev = 1,nsoil replace = replace + dzsnso(ilev)*(sice(ilev) - sice_save(ilev) + sh2o(ilev) - sh2o_save(ilev)) - end do - replace = replace * 1000.0 / dt ! convert to [mm/s] + end do + replace = replace * 1000.0 / dt ! convert to [mm/s] - sice = min(1.0,sice_save) + sice = min(1.0,sice_save) + elseif(opt_gla == 2) then + sice = 1.0 + end if sh2o = 1.0 - sice -!print *, 'replace', replace ! use runsub as a water balancer, snoflow is snow that disappears, replace is ! water from below that replaces glacier loss - runsub = snoflow + replace + if(opt_gla == 1) then + runsub = snoflow + replace + elseif(opt_gla == 2) then + runsub = snoflow + qvap = qsnsub + qdew = qsnfro + end if end subroutine water_glacier ! ================================================================================================== @@ -2204,6 +2270,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in ficeold,zsoil , & !in isnow ,snowh ,sneqv ,snice ,snliq , & !inout sh2o ,sice ,stc ,dzsnso ,zsnso , & !inout + fsh , & !inout qsnbot ,snoflow,ponding1 ,ponding2) !out ! ---------------------------------------------------------------------- implicit none @@ -2212,37 +2279,38 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (s) - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] - real, dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(inout) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(inout) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) ! input & output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys), intent(inout) :: fsh !total sensible heat (w/m2) [+ to atm] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real, intent(out) :: snoflow!glacier flow [mm] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: snoflow!glacier flow [mm] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 ! local integer :: iz - real :: bdsnow !bulk density of snow (kg/m3) + real (kind=kind_phys) :: bdsnow !bulk density of snow (kg/m3) ! ---------------------------------------------------------------------- snoflow = 0.0 ponding1 = 0.0 @@ -2281,7 +2349,7 @@ subroutine snowwater_glacier (nsnow ,nsoil ,imelt ,dt ,sfctmp , & !in qrain , & !in isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout snliq ,sh2o ,sice ,stc , & !inout - ponding1 ,ponding2 , & !inout + ponding1 ,ponding2 ,fsh , & !inout qsnbot ) !out !to obtain equilibrium state of snow in glacier region @@ -2340,20 +2408,20 @@ subroutine snowfall_glacier (nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, intent(in) :: dt !main time step (s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow depth [m] - real, intent(inout) :: sneqv !swow water equivalent [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !swow water equivalent [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] ! local @@ -2403,35 +2471,35 @@ subroutine compact_glacier (nsnow ,nsoil ,dt ,stc ,snice , & !in integer, intent(in) :: nsoil !no. of soil layers [ =4] integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep ! input and output integer, intent(inout) :: isnow ! actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] ! local - real, parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 - real, parameter :: c3 = 2.5e-6 ![1/s] - real, parameter :: c4 = 0.04 ![1/k] - real, parameter :: c5 = 2.0 ! - real, parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] - real, parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] + real (kind=kind_phys), parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 + real (kind=kind_phys), parameter :: c3 = 2.5e-6 ![1/s] + real (kind=kind_phys), parameter :: c4 = 0.04 ![1/k] + real (kind=kind_phys), parameter :: c5 = 2.0 ! + real (kind=kind_phys), parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] + real (kind=kind_phys), parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] !according to anderson, it is between 0.52e6~1.38e6 - real :: burden !pressure of overlying snow [kg/m2] - real :: ddz1 !rate of settling of snow pack due to destructive metamorphism. - real :: ddz2 !rate of compaction of snow pack due to overburden. - real :: ddz3 !rate of compaction of snow pack due to melt [1/s] - real :: dexpf !expf=exp(-c4*(273.15-stc)). - real :: td !stc - tfrz [k] - real :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] - real :: void !void (1 - snice - snliq) - real :: wx !water mass (ice + liquid) [kg/m2] - real :: bi !partial density of ice [kg/m3] - real, dimension(-nsnow+1:0) :: fice !fraction of ice at current time step + real (kind=kind_phys) :: burden !pressure of overlying snow [kg/m2] + real (kind=kind_phys) :: ddz1 !rate of settling of snow pack due to destructive metamorphism. + real (kind=kind_phys) :: ddz2 !rate of compaction of snow pack due to overburden. + real (kind=kind_phys) :: ddz3 !rate of compaction of snow pack due to melt [1/s] + real (kind=kind_phys) :: dexpf !expf=exp(-c4*(273.15-stc)). + real (kind=kind_phys) :: td !stc - tfrz [k] + real (kind=kind_phys) :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] + real (kind=kind_phys) :: void !void (1 - snice - snliq) + real (kind=kind_phys) :: wx !water mass (ice + liquid) [kg/m2] + real (kind=kind_phys) :: bi !partial density of ice [kg/m3] + real (kind=kind_phys), dimension(-nsnow+1:0) :: fice !fraction of ice at current time step integer :: j @@ -2507,16 +2575,16 @@ subroutine combine_glacier (nsnow ,nsoil , & !in ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] - real, intent(inout) :: sneqv !snow water equivalent [m] - real, intent(inout) :: snowh !snow depth [m] - real, intent(inout) :: ponding1 - real, intent(inout) :: ponding2 + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water equivalent [m] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(inout) :: ponding1 + real (kind=kind_phys), intent(inout) :: ponding2 ! local variables: @@ -2524,9 +2592,9 @@ subroutine combine_glacier (nsnow ,nsoil , & !in integer :: isnow_old ! number of top snow layer integer :: mssi ! node index integer :: neibor ! adjacent node selected for combination - real :: zwice ! total ice mass in snow - real :: zwliq ! total liquid water in snow - real :: dzmin(3) ! minimum of top snow layer + real (kind=kind_phys) :: zwice ! total ice mass in snow + real (kind=kind_phys) :: zwliq ! total liquid water in snow + real (kind=kind_phys) :: dzmin(3) ! minimum of top snow layer data dzmin /0.045, 0.05, 0.2/ ! data dzmin /0.025, 0.025, 0.1/ ! mb: change limit !----------------------------------------------------------------------- @@ -2673,24 +2741,24 @@ subroutine combo_glacier(dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! ----------------------------------------------------------------------s ! input - real, intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] - real, intent(in) :: wliq2 !liquid water of element 2 [kg/m2] - real, intent(in) :: wice2 !ice of element 2 [kg/m2] - real, intent(in) :: t2 !nodal temperature of element 2 [k] - real, intent(inout) :: dz !nodal thickness of 1 elements being combined [m] - real, intent(inout) :: wliq !liquid water of element 1 - real, intent(inout) :: wice !ice of element 1 [kg/m2] - real, intent(inout) :: t !node temperature of element 1 [k] + real (kind=kind_phys), intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] + real (kind=kind_phys), intent(in) :: wliq2 !liquid water of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: wice2 !ice of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: t2 !nodal temperature of element 2 [k] + real (kind=kind_phys), intent(inout) :: dz !nodal thickness of 1 elements being combined [m] + real (kind=kind_phys), intent(inout) :: wliq !liquid water of element 1 + real (kind=kind_phys), intent(inout) :: wice !ice of element 1 [kg/m2] + real (kind=kind_phys), intent(inout) :: t !node temperature of element 1 [k] ! local - real :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). - real :: wliqc !combined liquid water [kg/m2] - real :: wicec !combined ice [kg/m2] - real :: tc !combined node temperature [k] - real :: h !enthalpy of element 1 [j/m2] - real :: h2 !enthalpy of element 2 [j/m2] - real :: hc !temporary + real (kind=kind_phys) :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). + real (kind=kind_phys) :: wliqc !combined liquid water [kg/m2] + real (kind=kind_phys) :: wicec !combined ice [kg/m2] + real (kind=kind_phys) :: tc !combined node temperature [k] + real (kind=kind_phys) :: h !enthalpy of element 1 [j/m2] + real (kind=kind_phys) :: h2 !enthalpy of element 2 [j/m2] + real (kind=kind_phys) :: hc !temporary !----------------------------------------------------------------------- @@ -2730,24 +2798,24 @@ subroutine divide_glacier (nsnow ,nsoil , & !in ! input and output integer , intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] ! local variables: integer :: j !indices integer :: msno !number of layer (top) to msno (bot) - real :: drr !thickness of the combined [m] - real, dimension( 1:nsnow) :: dz !snow layer thickness [m] - real, dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] - real, dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] - real, dimension( 1:nsnow) :: tsno !node temperature [k] - real :: zwice !temporary - real :: zwliq !temporary - real :: propor!temporary - real :: dtdz !temporary + real (kind=kind_phys) :: drr !thickness of the combined [m] + real (kind=kind_phys), dimension( 1:nsnow) :: dz !snow layer thickness [m] + real (kind=kind_phys), dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: tsno !node temperature [k] + real (kind=kind_phys) :: zwice !temporary + real (kind=kind_phys) :: zwliq !temporary + real (kind=kind_phys) :: propor!temporary + real (kind=kind_phys) :: dtdz !temporary ! ---------------------------------------------------------------------- do j = 1,nsnow @@ -2847,7 +2915,7 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in qrain , & !in isnow ,dzsnso ,snowh ,sneqv ,snice , & !inout snliq ,sh2o ,sice ,stc , & !inout - ponding1 ,ponding2 , & !inout + ponding1 ,ponding2 ,fsh , & !inout qsnbot ) !out ! ---------------------------------------------------------------------- ! renew the mass of ice lens (snice) and liquid (snliq) of the @@ -2859,45 +2927,52 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in integer, intent(in) :: nsnow !maximum no. of snow layers[=3] integer, intent(in) :: nsoil !no. of soil layers[=4] - real, intent(in) :: dt !time step - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), intent(in) :: dt !time step + real (kind=kind_phys), intent(inout) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(inout) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, intent(inout) :: ponding1 - real, intent(inout) :: ponding2 + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), intent(inout) :: ponding1 + real (kind=kind_phys), intent(inout) :: ponding2 + real (kind=kind_phys), intent(inout) :: fsh !total sensible heat (w/m2) [+ to atm] ! local variables: integer :: j !do loop/array indices - real :: qin !water flow into the element (mm/s) - real :: qout !water flow out of the element (mm/s) - real :: wgdif !ice mass after minus sublimation - real, dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer - real, dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer - real, dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice - real :: propor, temp + real (kind=kind_phys) :: qin !water flow into the element (mm/s) + real (kind=kind_phys) :: qout !water flow out of the element (mm/s) + real (kind=kind_phys) :: wgdif !ice mass after minus sublimation + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice + real (kind=kind_phys) :: propor, temp ! ---------------------------------------------------------------------- !for the case when sneqv becomes '0' after 'combine' if(sneqv == 0.) then - sice(1) = sice(1) + (qsnfro-qsnsub)*dt/(dzsnso(1)*1000.) + if(opt_gla == 1) then + sice(1) = sice(1) + (qsnfro-qsnsub)*dt/(dzsnso(1)*1000.) + elseif(opt_gla == 2) then + fsh = fsh - (qsnfro-qsnsub)*hsub + qsnfro = 0.0 + qsnsub = 0.0 + end if end if ! for shallow snow without a layer @@ -2906,10 +2981,16 @@ subroutine snowh2o_glacier (nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in ! to aviod this problem. if(isnow == 0 .and. sneqv > 0.) then - temp = sneqv - sneqv = sneqv - qsnsub*dt + qsnfro*dt - propor = sneqv/temp - snowh = max(0.,propor * snowh) + if(opt_gla == 1) then + temp = sneqv + sneqv = sneqv - qsnsub*dt + qsnfro*dt + propor = sneqv/temp + snowh = max(0.,propor * snowh) + elseif(opt_gla == 2) then + fsh = fsh - (qsnfro-qsnsub)*hsub + qsnfro = 0.0 + qsnsub = 0.0 + end if if(sneqv < 0.) then sice(1) = sice(1) + sneqv/(dzsnso(1)*1000.) @@ -3006,32 +3087,32 @@ subroutine error_glacier (iloc ,jloc ,swdown ,fsa ,fsr ,fira , & ! inputs integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] - real , intent(in) :: fsa !total absorbed solar radiation (w/m2) - real , intent(in) :: fsr !total reflected solar radiation (w/m2) - real , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] - real , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] - real , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(in) :: sag - - real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) - real , intent(in) :: edir !soil surface evaporation rate[mm/s] - real , intent(in) :: runsrf !surface runoff [mm/s] - real , intent(in) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(in) :: sneqv !snow water eqv. [mm] - real , intent(in) :: dt !time step [sec] - real , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] + real (kind=kind_phys) , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(in) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(in) :: sag + + real (kind=kind_phys) , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real (kind=kind_phys) , intent(in) :: edir !soil surface evaporation rate[mm/s] + real (kind=kind_phys) , intent(in) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(in) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(in) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg #endif - real :: end_wb !water storage at end of a timestep [mm] - real :: errwat !error in water balance [mm/timestep] - real :: erreng !error in surface energy balance [w/m2] - real :: errsw !error in shortwave radiation balance [w/m2] + real (kind=kind_phys) :: end_wb !water storage at end of a timestep [mm] + real (kind=kind_phys) :: errwat !error in water balance [mm/timestep] + real (kind=kind_phys) :: erreng !error in surface energy balance [w/m2] + real (kind=kind_phys) :: errsw !error in shortwave radiation balance [w/m2] character(len=256) :: message ! -------------------------------------------------------------------------------------------------- errsw = swdown - (fsa + fsr) @@ -3077,41 +3158,24 @@ end subroutine error_glacier ! ================================================================================================== !>\ingroup NoahMP_LSM - subroutine noahmp_options_glacier(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & - iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) + subroutine noahmp_options_glacier(iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, iopt_gla ) implicit none - integer, intent(in) :: idveg !dynamic vegetation (1 -> off ; 2 -> on) with opt_crs = 1 - integer, intent(in) :: iopt_crs !canopy stomatal resistance (1-> ball-berry; 2->jarvis) - integer, intent(in) :: iopt_btr !soil moisture factor for stomatal resistance (1-> noah; 2-> clm; 3-> ssib) - integer, intent(in) :: iopt_run !runoff and groundwater (1->simgm; 2->simtop; 3->schaake96; 4->bats) - integer, intent(in) :: iopt_sfc !surface layer drag coeff (ch & cm) (1->m-o; 2->chen97) - integer, intent(in) :: iopt_frz !supercooled liquid water (1-> ny06; 2->koren99) - integer, intent(in) :: iopt_inf !frozen soil permeability (1-> ny06; 2->koren99) - integer, intent(in) :: iopt_rad !radiation transfer (1->gap=f(3d,cosz); 2->gap=0; 3->gap=1-fveg) integer, intent(in) :: iopt_alb !snow surface albedo (1->bats; 2->class) integer, intent(in) :: iopt_snf !rainfall & snowfall (1-jordan91; 2->bats; 3->noah) integer, intent(in) :: iopt_tbot !lower boundary of soil temperature (1->zero-flux; 2->noah) - integer, intent(in) :: iopt_stc !snow/soil temperature time scheme (only layer 1) ! 1 -> semi-implicit; 2 -> full implicit (original noah) + integer, intent(in) :: iopt_gla ! glacier option (1->phase change; 2->simple) ! ------------------------------------------------------------------------------------------------- - dveg = idveg - - opt_crs = iopt_crs - opt_btr = iopt_btr - opt_run = iopt_run - opt_sfc = iopt_sfc - opt_frz = iopt_frz - opt_inf = iopt_inf - opt_rad = iopt_rad opt_alb = iopt_alb opt_snf = iopt_snf opt_tbot = iopt_tbot opt_stc = iopt_stc + opt_gla = iopt_gla end subroutine noahmp_options_glacier diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index 567f4a0cf..8cba5871e 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -4,9 +4,10 @@ !>\ingroup NoahMP_LSM module module_sf_noahmplsm -#ifndef CCPP +#ifndef CCPP use module_wrf_utl #endif +use machine , only : kind_phys implicit none @@ -78,6 +79,11 @@ module module_sf_noahmplsm ! 3 -> off (use table lai; calculate fveg) ! **4 -> off (use table lai; use maximum vegetation fraction) ! **5 -> on (use maximum vegetation fraction) + ! 6 -> on (use FVEG = SHDFAC from input) + ! 7 -> off (use input LAI; use FVEG = SHDFAC from input) + ! 8 -> off (use input LAI; calculate FVEG) + ! 9 -> off (use input LAI; use maximum vegetation fraction) + ! 10 -> crop model on (use maximum vegetation fraction) integer :: opt_crs ! options for canopy stomatal resistance ! **1 -> ball-berry @@ -133,29 +139,50 @@ module module_sf_noahmplsm ! 2 -> full implicit (original noah); temperature top boundary condition ! 3 -> same as 1, but fsno for ts calculation (generally improves snow; v3.7) + integer :: opt_rsf ! options for surface resistent to evaporation/sublimation + ! **1 -> sakaguchi and zeng, 2009 + ! 2 -> sellers (1992) + ! 3 -> adjusted sellers to decrease rsurf for wet soil + ! 4 -> option 1 for non-snow; rsurf = rsurf_snow for snow (set in mptable); ad v3.8 + + integer :: opt_soil ! options for defining soil properties + ! **1 -> use input dominant soil texture + ! 2 -> use input soil texture that varies with depth + ! 3 -> use soil composition (sand, clay, orgm) and pedotransfer functions (opt_pedo) + ! 4 -> use input soil properties (bexp_3d, smcmax_3d, etc.) + + integer :: opt_pedo ! options for pedotransfer functions (used when opt_soil = 3) + ! **1 -> saxton and rawls (2006) + + integer :: opt_crop ! options for crop model + ! **0 -> no crop model, will run default dynamic vegetation + ! 1 -> liu, et al. 2016 + !------------------------------------------------------------------------------------------! ! physical constants: ! !------------------------------------------------------------------------------------------! - real, parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) - real, parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) - real, parameter :: vkc = 0.40 !von karman constant - real, parameter :: tfrz = 273.16 !freezing/melting point (k) - real, parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) - real, parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) - real, parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) - real, parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) - real, parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) - real, parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) - real, parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) - real, parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) - real, parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) (not used mb: 20140718) - real, parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) - real, parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) - real, parameter :: denh2o = 1000. !density of water (kg/m3) - real, parameter :: denice = 917. !density of ice (kg/m3) + real (kind=kind_phys), parameter :: grav = 9.80616 !acceleration due to gravity (m/s2) + real (kind=kind_phys), parameter :: sb = 5.67e-08 !stefan-boltzmann constant (w/m2/k4) + real (kind=kind_phys), parameter :: vkc = 0.40 !von karman constant + real (kind=kind_phys), parameter :: tfrz = 273.16 !freezing/melting point (k) + real (kind=kind_phys), parameter :: hsub = 2.8440e06 !latent heat of sublimation (j/kg) + real (kind=kind_phys), parameter :: hvap = 2.5104e06 !latent heat of vaporization (j/kg) + real (kind=kind_phys), parameter :: hfus = 0.3336e06 !latent heat of fusion (j/kg) + real (kind=kind_phys), parameter :: cwat = 4.188e06 !specific heat capacity of water (j/m3/k) + real (kind=kind_phys), parameter :: cice = 2.094e06 !specific heat capacity of ice (j/m3/k) + real (kind=kind_phys), parameter :: cpair = 1004.64 !heat capacity dry air at const pres (j/kg/k) + real (kind=kind_phys), parameter :: tkwat = 0.6 !thermal conductivity of water (w/m/k) + real (kind=kind_phys), parameter :: tkice = 2.2 !thermal conductivity of ice (w/m/k) + real (kind=kind_phys), parameter :: tkair = 0.023 !thermal conductivity of air (w/m/k) (not used mb: 20140718) + real (kind=kind_phys), parameter :: rair = 287.04 !gas constant for dry air (j/kg/k) + real (kind=kind_phys), parameter :: rw = 461.269 !gas constant for water vapor (j/kg/k) + real (kind=kind_phys), parameter :: denh2o = 1000. !density of water (kg/m3) + real (kind=kind_phys), parameter :: denice = 917. !density of ice (kg/m3) integer, private, parameter :: mband = 2 + integer, private, parameter :: nsoil = 4 + integer, private, parameter :: nstage = 8 type noahmp_parameters ! define a noahmp parameters type @@ -167,114 +194,176 @@ module module_sf_noahmplsm integer :: iswater integer :: isbarren integer :: isice + integer :: iscrop integer :: eblforest - real :: ch2op !maximum intercepted h2o per unit lai+sai (mm) - real :: dleaf !characteristic leaf dimension (m) - real :: z0mvt !momentum roughness length (m) - real :: hvt !top of canopy (m) - real :: hvb !bottom of canopy (m) - real :: den !tree density (no. of trunks per m2) - real :: rc !tree crown radius (m) - real :: mfsno !snowmelt m parameter () - real :: saim(12) !monthly stem area index, one-sided - real :: laim(12) !monthly leaf area index, one-sided - real :: sla !single-side leaf area per kg [m2/kg] - real :: dilefc !coeficient for leaf stress death [1/s] - real :: dilefw !coeficient for leaf stress death [1/s] - real :: fragr !fraction of growth respiration !original was 0.3 - real :: ltovrc !leaf turnover [1/s] - - real :: c3psn !photosynthetic pathway: 0. = c4, 1. = c3 - real :: kc25 !co2 michaelis-menten constant at 25c (pa) - real :: akc !q10 for kc25 - real :: ko25 !o2 michaelis-menten constant at 25c (pa) - real :: ako !q10 for ko25 - real :: vcmx25 !maximum rate of carboxylation at 25c (umol co2/m**2/s) - real :: avcmx !q10 for vcmx25 - real :: bp !minimum leaf conductance (umol/m**2/s) - real :: mp !slope of conductance-to-photosynthesis relationship - real :: qe25 !quantum efficiency at 25c (umol co2 / umol photon) - real :: aqe !q10 for qe25 - real :: rmf25 !leaf maintenance respiration at 25c (umol co2/m**2/s) - real :: rms25 !stem maintenance respiration at 25c (umol co2/kg bio/s) - real :: rmr25 !root maintenance respiration at 25c (umol co2/kg bio/s) - real :: arm !q10 for maintenance respiration - real :: folnmx !foliage nitrogen concentration when f(n)=1 (%) - real :: tmin !minimum temperature for photosynthesis (k) + real (kind=kind_phys) :: ch2op !maximum intercepted h2o per unit lai+sai (mm) + real (kind=kind_phys) :: dleaf !characteristic leaf dimension (m) + real (kind=kind_phys) :: z0mvt !momentum roughness length (m) + real (kind=kind_phys) :: hvt !top of canopy (m) + real (kind=kind_phys) :: hvb !bottom of canopy (m) + real (kind=kind_phys) :: den !tree density (no. of trunks per m2) + real (kind=kind_phys) :: rc !tree crown radius (m) + real (kind=kind_phys) :: mfsno !snowmelt m parameter () + real (kind=kind_phys) :: scffac !snow cover factor (m) + real (kind=kind_phys) :: saim(12) !monthly stem area index, one-sided + real (kind=kind_phys) :: laim(12) !monthly leaf area index, one-sided + real (kind=kind_phys) :: sla !single-side leaf area per kg [m2/kg] + real (kind=kind_phys) :: dilefc !coeficient for leaf stress death [1/s] + real (kind=kind_phys) :: dilefw !coeficient for leaf stress death [1/s] + real (kind=kind_phys) :: fragr !fraction of growth respiration !original was 0.3 + real (kind=kind_phys) :: ltovrc !leaf turnover [1/s] + + real (kind=kind_phys) :: c3psn !photosynthetic pathway: 0. = c4, 1. = c3 + real (kind=kind_phys) :: kc25 !co2 michaelis-menten constant at 25c (pa) + real (kind=kind_phys) :: akc !q10 for kc25 + real (kind=kind_phys) :: ko25 !o2 michaelis-menten constant at 25c (pa) + real (kind=kind_phys) :: ako !q10 for ko25 + real (kind=kind_phys) :: vcmx25 !maximum rate of carboxylation at 25c (umol co2/m**2/s) + real (kind=kind_phys) :: avcmx !q10 for vcmx25 + real (kind=kind_phys) :: bp !minimum leaf conductance (umol/m**2/s) + real (kind=kind_phys) :: mp !slope of conductance-to-photosynthesis relationship + real (kind=kind_phys) :: qe25 !quantum efficiency at 25c (umol co2 / umol photon) + real (kind=kind_phys) :: aqe !q10 for qe25 + real (kind=kind_phys) :: rmf25 !leaf maintenance respiration at 25c (umol co2/m**2/s) + real (kind=kind_phys) :: rms25 !stem maintenance respiration at 25c (umol co2/kg bio/s) + real (kind=kind_phys) :: rmr25 !root maintenance respiration at 25c (umol co2/kg bio/s) + real (kind=kind_phys) :: arm !q10 for maintenance respiration + real (kind=kind_phys) :: folnmx !foliage nitrogen concentration when f(n)=1 (%) + real (kind=kind_phys) :: tmin !minimum temperature for photosynthesis (k) - real :: xl !leaf/stem orientation index - real :: rhol(mband) !leaf reflectance: 1=vis, 2=nir - real :: rhos(mband) !stem reflectance: 1=vis, 2=nir - real :: taul(mband) !leaf transmittance: 1=vis, 2=nir - real :: taus(mband) !stem transmittance: 1=vis, 2=nir + real (kind=kind_phys) :: xl !leaf/stem orientation index + real (kind=kind_phys) :: rhol(mband) !leaf reflectance: 1=vis, 2=nir + real (kind=kind_phys) :: rhos(mband) !stem reflectance: 1=vis, 2=nir + real (kind=kind_phys) :: taul(mband) !leaf transmittance: 1=vis, 2=nir + real (kind=kind_phys) :: taus(mband) !stem transmittance: 1=vis, 2=nir - real :: mrp !microbial respiration parameter (umol co2 /kg c/ s) - real :: cwpvt !empirical canopy wind parameter + real (kind=kind_phys) :: mrp !microbial respiration parameter (umol co2 /kg c/ s) + real (kind=kind_phys) :: cwpvt !empirical canopy wind parameter - real :: wrrat !wood to non-wood ratio - real :: wdpool !wood pool (switch 1 or 0) depending on woody or not [-] - real :: tdlef !characteristic t for leaf freezing [k] + real (kind=kind_phys) :: wrrat !wood to non-wood ratio + real (kind=kind_phys) :: wdpool !wood pool (switch 1 or 0) depending on woody or not [-] + real (kind=kind_phys) :: tdlef !characteristic t for leaf freezing [k] integer :: nroot !number of soil layers with root present - real :: rgl !parameter used in radiation stress function - real :: rsmin !minimum stomatal resistance [s m-1] - real :: hs !parameter used in vapor pressure deficit function - real :: topt !optimum transpiration air temperature [k] - real :: rsmax !maximal stomatal resistance [s m-1] + real (kind=kind_phys) :: rgl !parameter used in radiation stress function + real (kind=kind_phys) :: rsmin !minimum stomatal resistance [s m-1] + real (kind=kind_phys) :: hs !parameter used in vapor pressure deficit function + real (kind=kind_phys) :: topt !optimum transpiration air temperature [k] + real (kind=kind_phys) :: rsmax !maximal stomatal resistance [s m-1] - real :: slarea - real :: eps(5) + real (kind=kind_phys) :: slarea + real (kind=kind_phys) :: eps(5) !------------------------------------------------------------------------------------------! ! from the rad section of mptable.tbl !------------------------------------------------------------------------------------------! - real :: albsat(mband) !saturated soil albedos: 1=vis, 2=nir - real :: albdry(mband) !dry soil albedos: 1=vis, 2=nir - real :: albice(mband) !albedo land ice: 1=vis, 2=nir - real :: alblak(mband) !albedo frozen lakes: 1=vis, 2=nir - real :: omegas(mband) !two-stream parameter omega for snow - real :: betads !two-stream parameter betad for snow - real :: betais !two-stream parameter betad for snow - real :: eg(2) !emissivity + real (kind=kind_phys) :: albsat(mband) !saturated soil albedos: 1=vis, 2=nir + real (kind=kind_phys) :: albdry(mband) !dry soil albedos: 1=vis, 2=nir + real (kind=kind_phys) :: albice(mband) !albedo land ice: 1=vis, 2=nir + real (kind=kind_phys) :: alblak(mband) !albedo frozen lakes: 1=vis, 2=nir + real (kind=kind_phys) :: omegas(mband) !two-stream parameter omega for snow + real (kind=kind_phys) :: betads !two-stream parameter betad for snow + real (kind=kind_phys) :: betais !two-stream parameter betad for snow + real (kind=kind_phys) :: eg(2) !emissivity !------------------------------------------------------------------------------------------! ! from the globals section of mptable.tbl !------------------------------------------------------------------------------------------! - real :: co2 !co2 partial pressure - real :: o2 !o2 partial pressure - real :: timean !gridcell mean topgraphic index (global mean) - real :: fsatmx !maximum surface saturated fraction (global mean) - real :: z0sno !snow surface roughness length (m) (0.002) - real :: ssi !liquid water holding capacity for snowpack (m3/m3) - real :: swemx !new snow mass to fully cover old snow (mm) + real (kind=kind_phys) :: co2 !co2 partial pressure + real (kind=kind_phys) :: o2 !o2 partial pressure + real (kind=kind_phys) :: timean !gridcell mean topgraphic index (global mean) + real (kind=kind_phys) :: fsatmx !maximum surface saturated fraction (global mean) + real (kind=kind_phys) :: z0sno !snow surface roughness length (m) (0.002) + real (kind=kind_phys) :: ssi !liquid water holding capacity for snowpack (m3/m3) + real (kind=kind_phys) :: snow_ret_fac !snowpack water release timescale factor (1/s) + real (kind=kind_phys) :: swemx !new snow mass to fully cover old snow (mm) + real (kind=kind_phys) :: snow_emis !snow emissivity + real (kind=kind_phys) :: tau0 !tau0 from yang97 eqn. 10a + real (kind=kind_phys) :: grain_growth !growth from vapor diffusion yang97 eqn. 10b + real (kind=kind_phys) :: extra_growth !extra growth near freezing yang97 eqn. 10c + real (kind=kind_phys) :: dirt_soot !dirt and soot term yang97 eqn. 10d + real (kind=kind_phys) :: bats_cosz !zenith angle snow albedo adjustment; b in yang97 eqn. 15 + real (kind=kind_phys) :: bats_vis_new !new snow visible albedo + real (kind=kind_phys) :: bats_nir_new !new snow nir albedo + real (kind=kind_phys) :: bats_vis_age !age factor for diffuse visible snow albedo yang97 eqn. 17 + real (kind=kind_phys) :: bats_nir_age !age factor for diffuse nir snow albedo yang97 eqn. 18 + real (kind=kind_phys) :: bats_vis_dir !cosz factor for direct visible snow albedo yang97 eqn. 15 + real (kind=kind_phys) :: bats_nir_dir !cosz factor for direct nir snow albedo yang97 eqn. 16 + real (kind=kind_phys) :: rsurf_snow !surface resistance for snow(s/m) + real (kind=kind_phys) :: rsurf_exp !exponent in the shape parameter for soil resistance option 1 + +!------------------------------------------------------------------------------------------! +! from the crop section of mptable.tbl +!------------------------------------------------------------------------------------------! + + integer :: pltday ! planting date + integer :: hsday ! harvest date + real (kind=kind_phys) :: plantpop ! plant density [per ha] - used? + real (kind=kind_phys) :: irri ! irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) + real (kind=kind_phys) :: gddtbase ! base temperature for gdd accumulation [c] + real (kind=kind_phys) :: gddtcut ! upper temperature for gdd accumulation [c] + real (kind=kind_phys) :: gdds1 ! gdd from seeding to emergence + real (kind=kind_phys) :: gdds2 ! gdd from seeding to initial vegetative + real (kind=kind_phys) :: gdds3 ! gdd from seeding to post vegetative + real (kind=kind_phys) :: gdds4 ! gdd from seeding to intial reproductive + real (kind=kind_phys) :: gdds5 ! gdd from seeding to pysical maturity + integer :: c3c4 ! photosynthetic pathway: 1 = c3 2 = c4 + real (kind=kind_phys) :: aref ! reference maximum co2 assimulation rate + real (kind=kind_phys) :: psnrf ! co2 assimulation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) + real (kind=kind_phys) :: i2par ! fraction of incoming solar radiation to photosynthetically active radiation + real (kind=kind_phys) :: tassim0 ! minimum temperature for co2 assimulation [c] + real (kind=kind_phys) :: tassim1 ! co2 assimulation linearly increasing until temperature reaches t1 [c] + real (kind=kind_phys) :: tassim2 ! co2 assmilation rate remain at aref until temperature reaches t2 [c] + real (kind=kind_phys) :: k ! light extinction coefficient + real (kind=kind_phys) :: epsi ! initial light use efficiency + real (kind=kind_phys) :: q10mr ! q10 for maintainance respiration + real (kind=kind_phys) :: foln_mx ! foliage nitrogen concentration when f(n)=1 (%) + real (kind=kind_phys) :: lefreez ! characteristic t for leaf freezing [k] + real (kind=kind_phys) :: dile_fc(nstage) ! coeficient for temperature leaf stress death [1/s] + real (kind=kind_phys) :: dile_fw(nstage) ! coeficient for water leaf stress death [1/s] + real (kind=kind_phys) :: fra_gr ! fraction of growth respiration + real (kind=kind_phys) :: lf_ovrc(nstage) ! fraction of leaf turnover [1/s] + real (kind=kind_phys) :: st_ovrc(nstage) ! fraction of stem turnover [1/s] + real (kind=kind_phys) :: rt_ovrc(nstage) ! fraction of root tunrover [1/s] + real (kind=kind_phys) :: lfmr25 ! leaf maintenance respiration at 25c [umol co2/m**2 /s] + real (kind=kind_phys) :: stmr25 ! stem maintenance respiration at 25c [umol co2/kg bio/s] + real (kind=kind_phys) :: rtmr25 ! root maintenance respiration at 25c [umol co2/kg bio/s] + real (kind=kind_phys) :: grainmr25 ! grain maintenance respiration at 25c [umol co2/kg bio/s] + real (kind=kind_phys) :: lfpt(nstage) ! fraction of carbohydrate flux to leaf + real (kind=kind_phys) :: stpt(nstage) ! fraction of carbohydrate flux to stem + real (kind=kind_phys) :: rtpt(nstage) ! fraction of carbohydrate flux to root + real (kind=kind_phys) :: grainpt(nstage) ! fraction of carbohydrate flux to grain + real (kind=kind_phys) :: bio2lai ! leaf are per living leaf biomass [m^2/kg] !------------------------------------------------------------------------------------------! ! from the soilparm.tbl tables, as functions of soil category. !------------------------------------------------------------------------------------------! - real :: bexp !b parameter - real :: smcdry !dry soil moisture threshold where direct evap from top + real (kind=kind_phys) :: bexp(nsoil) !b parameter + real (kind=kind_phys) :: smcdry(nsoil) !dry soil moisture threshold where direct evap from top !layer ends (volumetric) (not used mb: 20140718) - real :: smcwlt !wilting point soil moisture (volumetric) - real :: smcref !reference soil moisture (field capacity) (volumetric) - real :: smcmax !porosity, saturated value of soil moisture (volumetric) - real :: f1 !soil thermal diffusivity/conductivity coef (not used mb: 20140718) - real :: psisat !saturated soil matric potential - real :: dksat !saturated soil hydraulic conductivity - real :: dwsat !saturated soil hydraulic diffusivity - real :: quartz !soil quartz content + real (kind=kind_phys) :: smcwlt(nsoil) !wilting point soil moisture (volumetric) + real (kind=kind_phys) :: smcref(nsoil) !reference soil moisture (field capacity) (volumetric) + real (kind=kind_phys) :: smcmax (nsoil) !porosity, saturated value of soil moisture (volumetric) + real (kind=kind_phys) :: psisat(nsoil) !saturated soil matric potential + real (kind=kind_phys) :: dksat(nsoil) !saturated soil hydraulic conductivity + real (kind=kind_phys) :: dwsat(nsoil) !saturated soil hydraulic diffusivity + real (kind=kind_phys) :: quartz(nsoil) !soil quartz content + real (kind=kind_phys) :: f1 !soil thermal diffusivity/conductivity coef (not used mb: 20140718) !------------------------------------------------------------------------------------------! ! from the genparm.tbl file !------------------------------------------------------------------------------------------! - real :: slope !slope index (0 - 1) - real :: csoil !vol. soil heat capacity [j/m3/k] - real :: zbot !depth (m) of lower boundary soil temperature - real :: czil !calculate roughness length of heat + real (kind=kind_phys) :: slope !slope index (0 - 1) + real (kind=kind_phys) :: csoil !vol. soil heat capacity [j/m3/k] + real (kind=kind_phys) :: zbot !depth (m) of lower boundary soil temperature + real (kind=kind_phys) :: czil !calculate roughness length of heat + real (kind=kind_phys) :: refdk + real (kind=kind_phys) :: refkdt - real :: kdt !used in compute maximum infiltration rate (in infil) - real :: frzx !used in compute maximum infiltration rate (in infil) + real (kind=kind_phys) :: kdt !used in compute maximum infiltration rate (in infil) + real (kind=kind_phys) :: frzx !used in compute maximum infiltration rate (in infil) end type noahmp_parameters @@ -286,7 +375,7 @@ module module_sf_noahmplsm subroutine noahmp_sflx (parameters, & iloc , jloc , lat , yearlen , julian , cosz , & ! in : time/space-related dt , dx , dz8w , nsoil , zsoil , nsnow , & ! in : model configuration - shdfac , shdmax , vegtyp , ice , ist , & ! in : vegetation/soil characteristics + shdfac , shdmax , vegtyp , ice , ist , croptype, & ! in : vegetation/soil characteristics smceq , & ! in : vegetation/soil characteristics sfctmp , sfcprs , psfc , uu , vv , q2 , & ! in : forcing qc , soldn , lwdn , & ! in : forcing @@ -294,12 +383,13 @@ subroutine noahmp_sflx (parameters, & tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing albold , sneqvo , & ! in/out : stc , sh2o , smc , tah , eah , fwet , & ! in/out : - canliq , canice , tv , tg , qsfc , qsnow , & ! in/out : + canliq , canice , tv , tg , qsfc, qsnow, qrain, & ! in/out : isnow , zsnso , snowh , sneqv , snice , snliq , & ! in/out : zwt , wa , wt , wslake , lfmass , rtmass , & ! in/out : stmass , wood , stblcp , fastcp , lai , sai , & ! in/out : cm , ch , tauss , & ! in/out : - smcwtd ,deeprech , rech , & ! in/out : + grain , gdd , pgs , & ! in/out + smcwtd ,deeprech , rech , & ! in/out : z0wrf , & fsa , fsr , fira , fsh , ssoil , fcev , & ! out : fgev , fctr , ecan , etran , edir , trad , & ! out : @@ -307,19 +397,22 @@ subroutine noahmp_sflx (parameters, & runsrf , runsub , apar , psn , sav , sag , & ! out : fsno , nee , gpp , npp , fveg , albedo , & ! out : qsnbot , ponding , ponding1, ponding2, rssun , rssha , & ! out : + albd , albi , albsnd , albsni , & ! out : bgap , wgap , chv , chb , emissi , & ! out : shg , shc , shb , evg , evb , ghv , & ! out : ghb , irg , irc , irb , tr , evc , & ! out : chleaf , chuc , chv2 , chb2 , fpice , pahv , & + pahg , pahb , pah , esnow , laisun , laisha , rb & #ifdef CCPP - pahg , pahb , pah , esnow, errmsg, errflg) + ,errmsg, errflg) #else - pahg , pahb , pah , esnow) + ) #endif ! -------------------------------------------------------------------------------------------------- ! initial code: guo-yue niu, oct. 2007 ! -------------------------------------------------------------------------------------------------- + implicit none ! -------------------------------------------------------------------------------------------------- ! input @@ -328,121 +421,130 @@ subroutine noahmp_sflx (parameters, & integer , intent(in) :: ice !ice (ice = 1) integer , intent(in) :: ist !surface type 1->soil; 2->lake integer , intent(in) :: vegtyp !vegetation type + INTEGER , INTENT(IN) :: CROPTYPE !crop type integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !no. of soil layers integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: dt !time step [sec] - real, dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) - real , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: uu !wind speed in eastward dir (m/s) - real , intent(in) :: vv !wind speed in northward dir (m/s) - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: sfcprs !pressure (pa) - real , intent(inout) :: zlvl !reference height (m) - real , intent(in) :: cosz !cosine solar zenith angle [0-1] - real , intent(in) :: tbot !bottom condition for soil temp. [k] - real , intent(in) :: foln !foliage nitrogen (%) [1-saturated] - real , intent(in) :: shdfac !green vegetation fraction [0.0-1.0] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf (m) + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) lowest model layer + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(inout) :: zlvl !reference height (m) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. [k] + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) [1-saturated] + real (kind=kind_phys) , intent(in) :: shdfac !green vegetation fraction [0.0-1.0] integer , intent(in) :: yearlen!number of days in the particular year. - real , intent(in) :: julian !julian day of year (floating point) - real , intent(in) :: lat !latitude (radians) - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep - real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] - real , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: julian !julian day of year (floating point) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] + real (kind=kind_phys) , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 !jref:start; in - real , intent(in) :: qc !cloud water mixing ratio - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: dz8w !thickness of lowest layer - real , intent(in) :: dx - real , intent(in) :: shdmax !yearly max vegetation fraction + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(in) :: dx + real (kind=kind_phys) , intent(in) :: shdmax !yearly max vegetation fraction !jref:end ! input/output : need arbitary intial values - real , intent(inout) :: qsnow !snowfall [mm/s] - real , intent(inout) :: fwet !wetted or snowed fraction of canopy (-) - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , intent(inout) :: eah !canopy air vapor pressure (pa) - real , intent(inout) :: tah !canopy air tmeperature (k) - real , intent(inout) :: albold !snow albedo at last time step (class type) - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient - real , intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys) , intent(inout) :: qsnow !snowfall [mm/s] + REAL (kind=kind_phys) , INTENT(INOUT) :: QRAIN !rainfall [mm/s] + real (kind=kind_phys) , intent(inout) :: fwet !wetted or snowed fraction of canopy (-) + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , intent(inout) :: eah !canopy air vapor pressure (pa) + real (kind=kind_phys) , intent(inout) :: tah !canopy air tmeperature (k) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: tauss !non-dimensional snow age ! prognostic variables integer , intent(inout) :: isnow !actual no. of snow layers [-] - real , intent(inout) :: canliq !intercepted liquid water (mm) - real , intent(inout) :: canice !intercepted ice mass (mm) - real , intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] - real , intent(inout) :: snowh !snow height [m] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real , intent(inout) :: tv !vegetation temperature (k) - real , intent(inout) :: tg !ground temperature (k) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , intent(inout) :: zwt !depth to water table [m] - real , intent(inout) :: wa !water storage in aquifer [mm] - real , intent(inout) :: wt !water in aquifer&saturated soil [mm] - real , intent(inout) :: wslake !lake water storage (can be neg.) (mm) - real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] - real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] - real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) + real (kind=kind_phys) , intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys) , intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys) , intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys) , intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , intent(inout) :: zwt !depth to water table [m] + real (kind=kind_phys) , intent(inout) :: wa !water storage in aquifer [mm] + real (kind=kind_phys) , intent(inout) :: wt !water in aquifer&saturated soil [mm] + real (kind=kind_phys) , intent(inout) :: wslake !lake water storage (can be neg.) (mm) + real (kind=kind_phys), intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] + real (kind=kind_phys), intent(inout) :: deeprech !recharge to or from the water table when deep [m] + real (kind=kind_phys), intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) ! output - real , intent(out) :: z0wrf !combined z0 sent to coupled model - real , intent(out) :: fsa !total absorbed solar radiation (w/m2) - real , intent(out) :: fsr !total reflected solar radiation (w/m2) - real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fcev !canopy evap heat (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] - real , intent(out) :: fctr !transpiration heat (w/m2) [+ to atm] - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(out) :: trad !surface radiative temperature (k) - real :: ts !surface temperature (k) - real , intent(out) :: ecan !evaporation of intercepted water (mm/s) - real , intent(out) :: etran !transpiration rate (mm/s) - real , intent(out) :: edir !soil surface evaporation rate (mm/s] - real , intent(out) :: runsrf !surface runoff [mm/s] - real , intent(out) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(out) :: psn !total photosynthesis (umol co2/m2/s) [+] - real , intent(out) :: apar !photosyn active energy by canopy (w/m2) - real , intent(out) :: sav !solar rad absorbed by veg. (w/m2) - real , intent(out) :: sag !solar rad absorbed by ground (w/m2) - real , intent(out) :: fsno !snow cover fraction on the ground (-) - real , intent(out) :: fveg !green vegetation fraction [0.0-1.0] - real , intent(out) :: albedo !surface albedo [-] - real :: errwat !water error [kg m{-2}] - real , intent(out) :: qsnbot !snowmelt out bottom of pack [mm/s] - real , intent(out) :: ponding!surface ponding [mm] - real , intent(out) :: ponding1!surface ponding [mm] - real , intent(out) :: ponding2!surface ponding [mm] - real , intent(out) :: esnow + real (kind=kind_phys) , intent(out) :: z0wrf !combined z0 sent to coupled model + real (kind=kind_phys) , intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fcev !canopy evap heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fctr !transpiration heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(out) :: trad !surface radiative temperature (k) + real (kind=kind_phys) :: ts !surface temperature (k) + real (kind=kind_phys) , intent(out) :: ecan !evaporation of intercepted water (mm/s) + real (kind=kind_phys) , intent(out) :: etran !transpiration rate (mm/s) + real (kind=kind_phys) , intent(out) :: edir !soil surface evaporation rate (mm/s] + real (kind=kind_phys) , intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(out) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(out) :: psn !total photosynthesis (umol co2/m2/s) [+] + real (kind=kind_phys) , intent(out) :: apar !photosyn active energy by canopy (w/m2) + real (kind=kind_phys) , intent(out) :: sav !solar rad absorbed by veg. (w/m2) + real (kind=kind_phys) , intent(out) :: sag !solar rad absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: fsno !snow cover fraction on the ground (-) + real (kind=kind_phys) , intent(out) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys) , intent(out) :: albedo !surface albedo [-] + real (kind=kind_phys) :: errwat !water error [kg m{-2}] + real (kind=kind_phys) , intent(out) :: qsnbot !snowmelt out bottom of pack [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding1!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: ponding2!surface ponding [mm] + real (kind=kind_phys) , intent(out) :: esnow + real (kind=kind_phys) , intent(out) :: rb ! leaf boundary layer resistance (s/m) + real (kind=kind_phys) , intent(out) :: laisun ! sunlit leaf area index (m2/m2) + real (kind=kind_phys) , intent(out) :: laisha ! shaded leaf area index (m2/m2) !jref:start; output - real , intent(out) :: t2mv !2-m air temperature over vegetated part [k] - real , intent(out) :: t2mb !2-m air temperature over bare ground part [k] - real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) - real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) - real, intent(out) :: bgap - real, intent(out) :: wgap - real, intent(out) :: tgv - real, intent(out) :: tgb - real :: q1 - real, intent(out) :: emissi + real (kind=kind_phys) , intent(out) :: t2mv !2-m air temperature over vegetated part [k] + real (kind=kind_phys) , intent(out) :: t2mb !2-m air temperature over bare ground part [k] + real (kind=kind_phys), intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: bgap + real (kind=kind_phys), intent(out) :: wgap + real (kind=kind_phys), dimension(1:2) , intent(out) :: albd ! albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albi ! albedo (diffuse) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) + real (kind=kind_phys), intent(out) :: tgv + real (kind=kind_phys), intent(out) :: tgb + real (kind=kind_phys) :: q1 + real (kind=kind_phys), intent(out) :: emissi !jref:end #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -452,113 +554,117 @@ subroutine noahmp_sflx (parameters, & ! local integer :: iz !do-loop index integer, dimension(-nsnow+1:nsoil) :: imelt !phase change index [1-melt; 2-freeze] - real :: cmc !intercepted water (canice+canliq) (mm) - real :: taux !wind stress: e-w (n/m2) - real :: tauy !wind stress: n-s (n/m2) - real :: rhoair !density air (kg/m3) -! real, dimension( 1: 5) :: vocflx !voc fluxes [ug c m-2 h-1] - real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] - real :: thair !potential temperature (k) - real :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real :: eair !vapor pressure air (pa) - real, dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) - real, dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) - real :: qprecc !convective precipitation (mm/s) - real :: qprecl !large-scale precipitation (mm/s) - real :: igs !growing season index (0=off, 1=on) - real :: elai !leaf area index, after burying by snow - real :: esai !stem area index, after burying by snow - real :: bevap !soil water evaporation factor (0 - 1) - real, dimension( 1:nsoil) :: btrani !soil water transpiration factor (0 - 1) - real :: btran !soil water transpiration factor (0 - 1) - real :: qin !groundwater recharge [mm/s] - real :: qdis !groundwater discharge [mm/s] - real, dimension( 1:nsoil) :: sice !soil ice content (m3/m3) - real, dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] - real, dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] - real :: totsc !total soil carbon (g/m2) - real :: totlb !total living carbon (g/m2) - real :: t2m !2-meter air temperature (k) - real :: qdew !ground surface dew rate [mm/s] - real :: qvap !ground surface evap. rate [mm/s] - real :: lathea !latent heat [j/kg] - real :: swdown !downward solar [w/m2] - real :: qmelt !snowmelt [mm/s] - real :: beg_wb !water storage at begin of a step [mm] - real,intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] - real,intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] - real,intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] - real,intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] - real,intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] - real,intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] - real,intent(out) :: shb !sensible heat [w/m2] [+ to atm] - real,intent(out) :: evb !evaporation heat [w/m2] [+ to atm] - real,intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] - real,intent(out) :: tr !transpiration heat [w/m2] [+ to atm] - real, intent(out) :: fpice !snow fraction in precipitation - real, intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) - real, intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) - real, intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) - real, intent(out) :: pah !precipitation advected heat - total (w/m2) + real (kind=kind_phys) :: cmc !intercepted water (canice+canliq) (mm) + real (kind=kind_phys) :: taux !wind stress: e-w (n/m2) + real (kind=kind_phys) :: tauy !wind stress: n-s (n/m2) + real (kind=kind_phys) :: rhoair !density air (kg/m3) +! real (kind=kind_phys), dimension( 1: 5) :: vocflx !voc fluxes [ug c m-2 h-1] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys) :: thair !potential temperature (k) + real (kind=kind_phys) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) :: eair !vapor pressure air (pa) + real (kind=kind_phys), dimension( 1: 2) :: solad !incoming direct solar rad (w/m2) + real (kind=kind_phys), dimension( 1: 2) :: solai !incoming diffuse solar rad (w/m2) + real (kind=kind_phys) :: qprecc !convective precipitation (mm/s) + real (kind=kind_phys) :: qprecl !large-scale precipitation (mm/s) + real (kind=kind_phys) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys) :: elai !leaf area index, after burying by snow + real (kind=kind_phys) :: esai !stem area index, after burying by snow + real (kind=kind_phys) :: bevap !soil water evaporation factor (0 - 1) + real (kind=kind_phys), dimension( 1:nsoil) :: btrani !soil water transpiration factor (0 - 1) + real (kind=kind_phys) :: btran !soil water transpiration factor (0 - 1) + real (kind=kind_phys) :: qin !groundwater recharge [mm/s] + real (kind=kind_phys) :: qdis !groundwater discharge [mm/s] + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice content (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snicev !partial volume ice of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snliqv !partial volume liq of snow [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) :: totsc !total soil carbon (g/m2) + real (kind=kind_phys) :: totlb !total living carbon (g/m2) + real (kind=kind_phys) :: t2m !2-meter air temperature (k) + real (kind=kind_phys) :: qdew !ground surface dew rate [mm/s] + real (kind=kind_phys) :: qvap !ground surface evap. rate [mm/s] + real (kind=kind_phys) :: lathea !latent heat [j/kg] + real (kind=kind_phys) :: swdown !downward solar [w/m2] + real (kind=kind_phys) :: qmelt !snowmelt [mm/s] + real (kind=kind_phys) :: beg_wb !water storage at begin of a step [mm] + real (kind=kind_phys),intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shb !sensible heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evb !evaporation heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: tr !transpiration heat [w/m2] [+ to atm] + real (kind=kind_phys), intent(out) :: fpice !snow fraction in precipitation + real (kind=kind_phys), intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) + real (kind=kind_phys), intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) + real (kind=kind_phys), intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) + real (kind=kind_phys), intent(out) :: pah !precipitation advected heat - total (w/m2) !jref:start - real :: fsrv - real :: fsrg - real,intent(out) :: q2v - real,intent(out) :: q2b - real :: q2e - real :: qfx - real,intent(out) :: chv !sensible heat exchange coefficient over vegetated fraction - real,intent(out) :: chb !sensible heat exchange coefficient over bare-ground - real,intent(out) :: chleaf !leaf exchange coefficient - real,intent(out) :: chuc !under canopy exchange coefficient - real,intent(out) :: chv2 !sensible heat exchange coefficient over vegetated fraction - real,intent(out) :: chb2 !sensible heat exchange coefficient over bare-ground + real (kind=kind_phys) :: fsrv + real (kind=kind_phys) :: fsrg + real (kind=kind_phys),intent(out) :: q2v + real (kind=kind_phys),intent(out) :: q2b + real (kind=kind_phys) :: q2e + real (kind=kind_phys) :: qfx + real (kind=kind_phys),intent(out) :: chv !sensible heat exchange coefficient over vegetated fraction + real (kind=kind_phys),intent(out) :: chb !sensible heat exchange coefficient over bare-ground + real (kind=kind_phys),intent(out) :: chleaf !leaf exchange coefficient + real (kind=kind_phys),intent(out) :: chuc !under canopy exchange coefficient + real (kind=kind_phys),intent(out) :: chv2 !sensible heat exchange coefficient over vegetated fraction + real (kind=kind_phys),intent(out) :: chb2 !sensible heat exchange coefficient over bare-ground !jref:end ! carbon ! inputs - real , intent(in) :: co2air !atmospheric co2 concentration (pa) - real , intent(in) :: o2air !atmospheric o2 concentration (pa) + real (kind=kind_phys) , intent(in) :: co2air !atmospheric co2 concentration (pa) + real (kind=kind_phys) , intent(in) :: o2air !atmospheric o2 concentration (pa) ! inputs and outputs : prognostic variables - real , intent(inout) :: lfmass !leaf mass [g/m2] - real , intent(inout) :: rtmass !mass of fine roots [g/m2] - real , intent(inout) :: stmass !stem mass [g/m2] - real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] - real , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] - real , intent(inout) :: fastcp !short-lived carbon, shallow soil [g/m2] - real , intent(inout) :: lai !leaf area index [-] - real , intent(inout) :: sai !stem area index [-] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short-lived carbon, shallow soil [g/m2] + real (kind=kind_phys) , intent(inout) :: lai !leaf area index [-] + real (kind=kind_phys) , intent(inout) :: sai !stem area index [-] + real (kind=kind_phys) , intent(inout) :: grain !grain mass [g/m2] + real (kind=kind_phys) , intent(inout) :: gdd !growing degree days + integer , intent(inout) :: pgs !plant growing stage [-] ! outputs - real , intent(out) :: nee !net ecosys exchange (g/m2/s co2) - real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] - real , intent(out) :: npp !net primary productivity [g/m2/s c] - real :: autors !net ecosystem respiration (g/m2/s c) - real :: heters !organic respiration (g/m2/s c) - real :: troot !root-zone averaged temperature (k) - real :: bdfall !bulk density of new snow (kg/m3) ! mb/an: v3.7 - real :: rain !rain rate (mm/s) ! mb/an: v3.7 - real :: snow !liquid equivalent snow rate (mm/s) ! mb/an: v3.7 - real :: fp ! mb/an: v3.7 - real :: prcp ! mb/an: v3.7 + real (kind=kind_phys) , intent(out) :: nee !net ecosys exchange (g/m2/s co2) + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2/s c] + real (kind=kind_phys) :: autors !net ecosystem respiration (g/m2/s c) + real (kind=kind_phys) :: heters !organic respiration (g/m2/s c) + real (kind=kind_phys) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) :: bdfall !bulk density of new snow (kg/m3) ! mb/an: v3.7 + real (kind=kind_phys) :: rain !rain rate (mm/s) ! mb/an: v3.7 + real (kind=kind_phys) :: snow !liquid equivalent snow rate (mm/s) ! mb/an: v3.7 + real (kind=kind_phys) :: fp ! mb/an: v3.7 + real (kind=kind_phys) :: prcp ! mb/an: v3.7 !more local variables for precip heat mb - real :: qintr !interception rate for rain (mm/s) - real :: qdripr !drip rate for rain (mm/s) - real :: qthror !throughfall for rain (mm/s) - real :: qints !interception (loading) rate for snowfall (mm/s) - real :: qdrips !drip (unloading) rate for intercepted snow (mm/s) - real :: qthros !throughfall of snowfall (mm/s) - real :: qrain !rain at ground srf (mm/s) [+] - real :: snowhin !snow depth increasing rate (m/s) - real :: latheav !latent heat vap./sublimation (j/kg) - real :: latheag !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) :: qintr !interception rate for rain (mm/s) + real (kind=kind_phys) :: qdripr !drip rate for rain (mm/s) + real (kind=kind_phys) :: qthror !throughfall for rain (mm/s) + real (kind=kind_phys) :: qints !interception (loading) rate for snowfall (mm/s) + real (kind=kind_phys) :: qdrips !drip (unloading) rate for intercepted snow (mm/s) + real (kind=kind_phys) :: qthros !throughfall of snowfall (mm/s) + real (kind=kind_phys) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys) :: latheav !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) :: latheag !latent heat vap./sublimation (j/kg) logical :: frozen_ground ! used to define latent heat pathway logical :: frozen_canopy ! used to define latent heat pathway + LOGICAL :: dveg_active ! flag to run dynamic vegetation + LOGICAL :: crop_active ! flag to run crop model ! intent (out) variables need to be assigned a value. these normally get assigned values ! only if dveg == 2. @@ -607,17 +713,17 @@ subroutine noahmp_sflx (parameters, & ! vegetation phenology - call phenology (parameters,vegtyp , snowh , tv , lat , yearlen , julian , & !in - lai , sai , troot , elai , esai ,igs) + call phenology (parameters,vegtyp ,croptype, snowh , tv , lat , yearlen , julian , & !in + lai , sai , troot , elai , esai ,igs, pgs) !input gvf should be consistent with lai - if(dveg == 1) then + if(dveg == 1 .or. dveg == 6 .or. dveg == 7) then fveg = shdfac if(fveg <= 0.05) fveg = 0.05 - else if (dveg == 2 .or. dveg == 3) then + else if (dveg == 2 .or. dveg == 3 .or. dveg == 8) then fveg = 1.-exp(-0.52*(lai+sai)) if(fveg <= 0.05) fveg = 0.05 - else if (dveg == 4 .or. dveg == 5) then + else if (dveg == 4 .or. dveg == 5 .or. dveg == 9) then fveg = shdmax if(fveg <= 0.05) fveg = 0.05 else @@ -630,6 +736,10 @@ subroutine noahmp_sflx (parameters, & call wrf_error_fatal("namelist parameter dveg unknown") #endif endif + if(opt_crop > 0 .and. croptype > 0) then + fveg = shdmax + if(fveg <= 0.05) fveg = 0.05 + endif if(parameters%urban_flag .or. vegtyp == parameters%isbarren) fveg = 0.0 if(elai+esai == 0.0) fveg = 0.0 @@ -651,7 +761,7 @@ subroutine noahmp_sflx (parameters, & elai ,esai ,fwet ,foln , & !in fveg ,pahv ,pahg ,pahb , & !in qsnow ,dzsnso ,lat ,canliq ,canice ,iloc, jloc , & !in - z0wrf , & + z0wrf , & imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out @@ -661,17 +771,17 @@ subroutine noahmp_sflx (parameters, & sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,errmsg ,errflg , & !inout + tauss ,laisun ,laisha ,rb , errmsg ,errflg , & !inout #else - tauss , & !inout + tauss ,laisun ,laisha ,rb , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in t2mv ,t2mb ,fsrv , & - fsrg ,rssun ,rssha ,bgap ,wgap, tgv,tgb,& + fsrg ,rssun ,rssha ,albd ,albi ,albsnd,albsni, bgap ,wgap, tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb , & !out emissi ,pah , & - shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out + shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out !jref:end #ifdef CCPP if (errflg /= 0) return @@ -703,8 +813,16 @@ subroutine noahmp_sflx (parameters, & ! compute carbon budgets (carbon storages and co2 & bvoc fluxes) - if (dveg == 2 .or. dveg == 5) then - call carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in + crop_active = .false. + dveg_active = .false. + if (dveg == 2 .or. dveg == 5 .or. dveg == 6) dveg_active = .true. + if (opt_crop > 0 .and. croptype > 0) then + crop_active = .true. + dveg_active = .false. + endif + + IF (dveg_active) THEN + call carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in dzsnso ,stc ,smc ,tv ,tg ,psn , & !in foln ,btran ,apar ,fveg ,igs , & !in troot ,ist ,lat ,iloc ,jloc , & !in @@ -713,9 +831,18 @@ subroutine noahmp_sflx (parameters, & totlb ,lai ,sai ) !out end if + if (opt_crop == 1 .and. crop_active) then + call carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julian , & !in + dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in + soldn ,t2m , & !in + lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout + lai ,sai ,gdd , & !inout + gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out + end if + ! water and energy balance check - call error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & !in + call error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & !in fgev ,fctr ,ssoil ,beg_wb ,canliq ,canice , & !in sneqv ,wa ,smc ,dzsnso ,prcp ,ecan , & !in etran ,edir ,runsrf ,runsub ,dt ,nsoil , & !in @@ -734,7 +861,7 @@ subroutine noahmp_sflx (parameters, & ! urban - jref qfx = etran + ecan + edir if ( parameters%urban_flag ) then - qsfc = (qfx/rhoair*ch) + qair + qsfc = qfx/(rhoair*ch) + qair q2b = qsfc end if @@ -768,42 +895,42 @@ subroutine atm (parameters,sfcprs ,sfctmp ,q2 , ! inputs type (noahmp_parameters), intent(in) :: parameters - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: sfctmp !surface air temperature [k] - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 - real , intent(in) :: soldn !downward shortwave radiation (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle [0-1] + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: prcpconv ! convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpnonc ! non-convective precipitation entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpshcv ! shallow convective precip entering [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpsnow ! snow entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcpgrpl ! graupel entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: prcphail ! hail entering land model [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(in) :: soldn !downward shortwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle [0-1] ! outputs - real , intent(out) :: thair !potential temperature (k) - real , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) - real , intent(out) :: eair !vapor pressure air (pa) - real , intent(out) :: rhoair !density air (kg/m3) - real , intent(out) :: qprecc !convective precipitation (mm/s) - real , intent(out) :: qprecl !large-scale precipitation (mm/s) - real, dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) - real, dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) - real , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] - real , intent(out) :: bdfall !!bulk density of snowfall (kg/m3) ajn - real , intent(out) :: rain !rainfall (mm/s) ajn - real , intent(out) :: snow !liquid equivalent snowfall (mm/s) ajn - real , intent(out) :: fp !fraction of area receiving precipitation ajn - real , intent(out) :: fpice !fraction of ice ajn - real , intent(out) :: prcp !total precipitation [mm/s] ! mb/an : v3.7 + real (kind=kind_phys) , intent(out) :: thair !potential temperature (k) + real (kind=kind_phys) , intent(out) :: qair !specific humidity (kg/kg) (q2/(1+q2)) + real (kind=kind_phys) , intent(out) :: eair !vapor pressure air (pa) + real (kind=kind_phys) , intent(out) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(out) :: qprecc !convective precipitation (mm/s) + real (kind=kind_phys) , intent(out) :: qprecl !large-scale precipitation (mm/s) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension( 1: 2), intent(out) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(out) :: bdfall !!bulk density of snowfall (kg/m3) ajn + real (kind=kind_phys) , intent(out) :: rain !rainfall (mm/s) ajn + real (kind=kind_phys) , intent(out) :: snow !liquid equivalent snowfall (mm/s) ajn + real (kind=kind_phys) , intent(out) :: fp !fraction of area receiving precipitation ajn + real (kind=kind_phys) , intent(out) :: fpice !fraction of ice ajn + real (kind=kind_phys) , intent(out) :: prcp !total precipitation [mm/s] ! mb/an : v3.7 !locals - real :: pair !atm bottom level pressure (pa) - real :: prcp_frozen !total frozen precipitation [mm/s] ! mb/an : v3.7 - real, parameter :: rho_grpl = 500.0 ! graupel bulk density [kg/m3] ! mb/an : v3.7 - real, parameter :: rho_hail = 917.0 ! hail bulk density [kg/m3] ! mb/an : v3.7 + real (kind=kind_phys) :: pair !atm bottom level pressure (pa) + real (kind=kind_phys) :: prcp_frozen !total frozen precipitation [mm/s] ! mb/an : v3.7 + real (kind=kind_phys), parameter :: rho_grpl = 500.0 ! graupel bulk density [kg/m3] ! mb/an : v3.7 + real (kind=kind_phys), parameter :: rho_hail = 917.0 ! hail bulk density [kg/m3] ! mb/an : v3.7 ! -------------------------------------------------------------------------------------------------- !jref: seems like pair should be p1000mb?? @@ -828,13 +955,13 @@ subroutine atm (parameters,sfcprs ,sfctmp ,q2 , prcp = prcpconv + prcpnonc + prcpshcv -! if(opt_snf == 4) then + if(opt_snf == 4) then qprecc = prcpconv + prcpshcv qprecl = prcpnonc -! else -! qprecc = 0.10 * prcp ! should be from the atmospheric model -! qprecl = 0.90 * prcp ! should be from the atmospheric model -! end if + else + qprecc = 0.10 * prcp ! should be from the atmospheric model + qprecl = 0.90 * prcp ! should be from the atmospheric model + end if ! fractional area that receives precipitation (see, niu et al. 2005) @@ -883,7 +1010,7 @@ subroutine atm (parameters,sfcprs ,sfctmp ,q2 , if(opt_snf == 4) then prcp_frozen = prcpsnow + prcpgrpl + prcphail if(prcpnonc > 0. .and. prcp_frozen > 0.) then - fpice = min(1.0,prcp_frozen/prcp) + fpice = min(1.0,prcp_frozen/prcpnonc) fpice = max(0.0,fpice) bdfall = bdfall*(prcpsnow/prcp_frozen) + rho_grpl*(prcpgrpl/prcp_frozen) + & rho_hail*(prcphail/prcp_frozen) @@ -902,8 +1029,8 @@ end subroutine atm !== begin phenology ================================================================================ !>\ingroup NoahMP_LSM - subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , julian , & !in - lai , sai , troot , elai , esai , igs) + subroutine phenology (parameters,vegtyp ,croptype, snowh , tv , lat , yearlen , julian , & !in + lai , sai , troot , elai , esai , igs, pgs) ! -------------------------------------------------------------------------------------------------- ! vegetation phenology considering vegeation canopy being buries by snow and evolution in time @@ -913,34 +1040,38 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju ! inputs type (noahmp_parameters), intent(in) :: parameters integer , intent(in ) :: vegtyp !vegetation type - real , intent(in ) :: snowh !snow height [m] - real , intent(in ) :: tv !vegetation temperature (k) - real , intent(in ) :: lat !latitude (radians) + integer , intent(in ) :: croptype !vegetation type + real (kind=kind_phys) , intent(in ) :: snowh !snow height [m] + real (kind=kind_phys) , intent(in ) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(in ) :: lat !latitude (radians) integer , intent(in ) :: yearlen!number of days in the particular year - real , intent(in ) :: julian !julian day of year (fractional) ( 0 <= julian < yearlen ) - real , intent(in ) :: troot !root-zone averaged temperature (k) - real , intent(inout) :: lai !lai, unadjusted for burying by snow - real , intent(inout) :: sai !sai, unadjusted for burying by snow + real (kind=kind_phys) , intent(in ) :: julian !julian day of year (fractional) ( 0 <= julian < yearlen ) + real (kind=kind_phys) , intent(in ) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) , intent(inout) :: lai !lai, unadjusted for burying by snow + real (kind=kind_phys) , intent(inout) :: sai !sai, unadjusted for burying by snow ! outputs - real , intent(out ) :: elai !leaf area index, after burying by snow - real , intent(out ) :: esai !stem area index, after burying by snow - real , intent(out ) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys) , intent(out ) :: elai !leaf area index, after burying by snow + real (kind=kind_phys) , intent(out ) :: esai !stem area index, after burying by snow + real (kind=kind_phys) , intent(out ) :: igs !growing season index (0=off, 1=on) + integer , intent(in ) :: pgs !plant growing stage ! locals - real :: db !thickness of canopy buried by snow (m) - real :: fb !fraction of canopy buried by snow - real :: snowhc !critical snow depth at which short vege + real (kind=kind_phys) :: db !thickness of canopy buried by snow (m) + real (kind=kind_phys) :: fb !fraction of canopy buried by snow + real (kind=kind_phys) :: snowhc !critical snow depth at which short vege !is fully covered by snow integer :: k !index integer :: it1,it2 !interpolation months - real :: day !current day of year ( 0 <= day < yearlen ) - real :: wt1,wt2 !interpolation weights - real :: t !current month (1.00, ..., 12.00) + real (kind=kind_phys) :: day !current day of year ( 0 <= day < yearlen ) + real (kind=kind_phys) :: wt1,wt2 !interpolation weights + real (kind=kind_phys) :: t !current month (1.00, ..., 12.00) ! -------------------------------------------------------------------------------------------------- +if (croptype == 0) then + if ( dveg == 1 .or. dveg == 3 .or. dveg == 4 ) then if (lat >= 0.) then @@ -962,7 +1093,13 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju lai = wt1*parameters%laim(it1) + wt2*parameters%laim(it2) sai = wt1*parameters%saim(it1) + wt2*parameters%saim(it2) endif - if (sai < 0.05) sai = 0.0 ! mb: sai check, change to 0.05 v3.6 + + if(dveg == 7 .or. dveg == 8 .or. dveg == 9) then + sai = max(0.05,0.1 * lai) ! when reading lai, set sai to 10% lai, but not below 0.05 mb: v3.8 + if (lai < 0.05) sai = 0.0 ! if lai below minimum, make sure sai = 0 + endif + + if (sai < 0.05) sai = 0.0 ! mb: sai check, change to 0.05 v3.6 if (lai < 0.05 .or. sai == 0.0) lai = 0.0 ! mb: lai check if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & @@ -971,6 +1108,8 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju sai = 0. endif +endif ! croptype == 0 + !buried by snow db = min( max(snowh - parameters%hvb,0.), parameters%hvt-parameters%hvb ) @@ -978,15 +1117,22 @@ subroutine phenology (parameters,vegtyp , snowh , tv , lat , yearlen , ju if(parameters%hvt> 0. .and. parameters%hvt <= 1.0) then !mb: change to 1.0 and 0.2 to reflect snowhc = parameters%hvt*exp(-snowh/0.2) ! changes to hvt in mptable - fb = min(snowh,snowhc)/snowhc +! fb = min(snowh,snowhc)/snowhc + if (snowh < snowhc) then + fb = snowh/snowhc + else + fb = 1.0 + endif endif elai = lai*(1.-fb) esai = sai*(1.-fb) - if (esai < 0.05) esai = 0.0 ! mb: esai check, change to 0.05 v3.6 - if (elai < 0.05 .or. esai == 0.0) elai = 0.0 ! mb: lai check + if (esai < 0.05 .and. croptype == 0) esai = 0.0 ! mb: esai check, change to 0.05 v3.6 + if ((elai < 0.05 .or. esai == 0.0) .and. croptype == 0) elai = 0.0 ! mb: lai check - if (tv .gt. parameters%tmin) then +! set growing season flag + + if ((tv .gt. parameters%tmin .and. croptype == 0).or.(pgs > 2 .and. pgs < 7 .and. croptype > 0)) then igs = 1. else igs = 0. @@ -1017,50 +1163,50 @@ subroutine precip_heat (parameters,iloc ,jloc ,vegtyp ,dt ,uu ,vv integer,intent(in) :: jloc !grid index integer,intent(in) :: vegtyp !vegetation type integer,intent(in) :: ist !surface type 1-soil; 2-lake - real, intent(in) :: dt !main time step (s) - real, intent(in) :: uu !u-direction wind speed [m/s] - real, intent(in) :: vv !v-direction wind speed [m/s] - real, intent(in) :: elai !leaf area index, after burying by snow - real, intent(in) :: esai !stem area index, after burying by snow - real, intent(in) :: fveg !greeness vegetation fraction (-) - real, intent(in) :: bdfall !bulk density of snowfall (kg/m3) - real, intent(in) :: rain !rainfall (mm/s) - real, intent(in) :: snow !snowfall (mm/s) - real, intent(in) :: fp !fraction of the gridcell that receives precipitation - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: sfctmp !model-level temperature (k) - real, intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: uu !u-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: vv !v-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: elai !leaf area index, after burying by snow + real (kind=kind_phys), intent(in) :: esai !stem area index, after burying by snow + real (kind=kind_phys), intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys), intent(in) :: bdfall !bulk density of snowfall (kg/m3) + real (kind=kind_phys), intent(in) :: rain !rainfall (mm/s) + real (kind=kind_phys), intent(in) :: snow !snowfall (mm/s) + real (kind=kind_phys), intent(in) :: fp !fraction of the gridcell that receives precipitation + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: sfctmp !model-level temperature (k) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) ! input & output - real, intent(inout) :: canliq !intercepted liquid water (mm) - real, intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(inout) :: canice !intercepted ice mass (mm) ! output - real, intent(out) :: qintr !interception rate for rain (mm/s) - real, intent(out) :: qdripr !drip rate for rain (mm/s) - real, intent(out) :: qthror !throughfall for rain (mm/s) - real, intent(out) :: qints !interception (loading) rate for snowfall (mm/s) - real, intent(out) :: qdrips !drip (unloading) rate for intercepted snow (mm/s) - real, intent(out) :: qthros !throughfall of snowfall (mm/s) - real, intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) - real, intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) - real, intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) - real, intent(out) :: qrain !rain at ground srf (mm/s) [+] - real, intent(out) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(out) :: snowhin !snow depth increasing rate (m/s) - real, intent(out) :: fwet !wetted or snowed fraction of the canopy (-) - real, intent(out) :: cmc !intercepted water (mm) + real (kind=kind_phys), intent(out) :: qintr !interception rate for rain (mm/s) + real (kind=kind_phys), intent(out) :: qdripr !drip rate for rain (mm/s) + real (kind=kind_phys), intent(out) :: qthror !throughfall for rain (mm/s) + real (kind=kind_phys), intent(out) :: qints !interception (loading) rate for snowfall (mm/s) + real (kind=kind_phys), intent(out) :: qdrips !drip (unloading) rate for intercepted snow (mm/s) + real (kind=kind_phys), intent(out) :: qthros !throughfall of snowfall (mm/s) + real (kind=kind_phys), intent(out) :: pahv !precipitation advected heat - vegetation net (w/m2) + real (kind=kind_phys), intent(out) :: pahg !precipitation advected heat - under canopy net (w/m2) + real (kind=kind_phys), intent(out) :: pahb !precipitation advected heat - bare ground net (w/m2) + real (kind=kind_phys), intent(out) :: qrain !rain at ground srf (mm/s) [+] + real (kind=kind_phys), intent(out) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(out) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys), intent(out) :: fwet !wetted or snowed fraction of the canopy (-) + real (kind=kind_phys), intent(out) :: cmc !intercepted water (mm) ! -------------------------------------------------------------------- ! ------------------------ local variables --------------------------- - real :: maxsno !canopy capacity for snow interception (mm) - real :: maxliq !canopy capacity for rain interception (mm) - real :: ft !temperature factor for unloading rate - real :: fv !wind factor for unloading rate - real :: pah_ac !precipitation advected heat - air to canopy (w/m2) - real :: pah_cg !precipitation advected heat - canopy to ground (w/m2) - real :: pah_ag !precipitation advected heat - air to ground (w/m2) - real :: icedrip !canice unloading + real (kind=kind_phys) :: maxsno !canopy capacity for snow interception (mm) + real (kind=kind_phys) :: maxliq !canopy capacity for rain interception (mm) + real (kind=kind_phys) :: ft !temperature factor for unloading rate + real (kind=kind_phys) :: fv !wind factor for unloading rate + real (kind=kind_phys) :: pah_ac !precipitation advected heat - air to canopy (w/m2) + real (kind=kind_phys) :: pah_cg !precipitation advected heat - canopy to ground (w/m2) + real (kind=kind_phys) :: pah_ag !precipitation advected heat - air to ground (w/m2) + real (kind=kind_phys) :: icedrip !canice unloading ! -------------------------------------------------------------------- ! initialization @@ -1250,41 +1396,41 @@ subroutine error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & integer , intent(in) :: ist !surface type 1->soil; 2->lake integer , intent(in) :: iloc !grid index integer , intent(in) :: jloc !grid index - real , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] - real , intent(in) :: fsa !total absorbed solar radiation (w/m2) - real , intent(in) :: fsr !total reflected solar radiation (w/m2) - real , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] - real , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(in) :: fcev !canopy evaporation heat (w/m2) [+ to atm] - real , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] - real , intent(in) :: fctr !transpiration heat flux (w/m2) [+ to atm] - real , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , intent(in) :: fveg - real , intent(in) :: sav - real , intent(in) :: sag - real , intent(in) :: fsrv - real , intent(in) :: fsrg - real , intent(in) :: zwt - - real , intent(in) :: prcp !precipitation rate (kg m-2 s-1) - real , intent(in) :: ecan !evaporation of intercepted water (mm/s) - real , intent(in) :: etran !transpiration rate (mm/s) - real , intent(in) :: edir !soil surface evaporation rate[mm/s] - real , intent(in) :: runsrf !surface runoff [mm/s] - real , intent(in) :: runsub !baseflow (saturation excess) [mm/s] - real , intent(in) :: canliq !intercepted liquid water (mm) - real , intent(in) :: canice !intercepted ice mass (mm) - real , intent(in) :: sneqv !snow water eqv. [mm] - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real , intent(in) :: wa !water storage in aquifer [mm] - real , intent(in) :: dt !time step [sec] - real , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] - real , intent(out) :: errwat !error in water balance [mm/timestep] - real, intent(in) :: pah !precipitation advected heat - total (w/m2) - real, intent(in) :: pahv !precipitation advected heat - total (w/m2) - real, intent(in) :: pahg !precipitation advected heat - total (w/m2) - real, intent(in) :: pahb !precipitation advected heat - total (w/m2) + real (kind=kind_phys) , intent(in) :: swdown !downward solar filtered by sun angle [w/m2] + real (kind=kind_phys) , intent(in) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(in) :: fira !total net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fcev !canopy evaporation heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fgev !ground evaporation heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: fctr !transpiration heat flux (w/m2) [+ to atm] + real (kind=kind_phys) , intent(in) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , intent(in) :: fveg + real (kind=kind_phys) , intent(in) :: sav + real (kind=kind_phys) , intent(in) :: sag + real (kind=kind_phys) , intent(in) :: fsrv + real (kind=kind_phys) , intent(in) :: fsrg + real (kind=kind_phys) , intent(in) :: zwt + + real (kind=kind_phys) , intent(in) :: prcp !precipitation rate (kg m-2 s-1) + real (kind=kind_phys) , intent(in) :: ecan !evaporation of intercepted water (mm/s) + real (kind=kind_phys) , intent(in) :: etran !transpiration rate (mm/s) + real (kind=kind_phys) , intent(in) :: edir !soil surface evaporation rate[mm/s] + real (kind=kind_phys) , intent(in) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys) , intent(in) :: runsub !baseflow (saturation excess) [mm/s] + real (kind=kind_phys) , intent(in) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys) , intent(in) :: canice !intercepted ice mass (mm) + real (kind=kind_phys) , intent(in) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys) , intent(in) :: wa !water storage in aquifer [mm] + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: beg_wb !water storage at begin of a timesetp [mm] + real (kind=kind_phys) , intent(out) :: errwat !error in water balance [mm/timestep] + real (kind=kind_phys), intent(in) :: pah !precipitation advected heat - total (w/m2) + real (kind=kind_phys), intent(in) :: pahv !precipitation advected heat - total (w/m2) + real (kind=kind_phys), intent(in) :: pahg !precipitation advected heat - total (w/m2) + real (kind=kind_phys), intent(in) :: pahb !precipitation advected heat - total (w/m2) #ifdef CCPP character(len=*) , intent(inout) :: errmsg @@ -1292,11 +1438,11 @@ subroutine error (parameters,swdown ,fsa ,fsr ,fira ,fsh ,fcev , & #endif integer :: iz !do-loop index - real :: end_wb !water storage at end of a timestep [mm] - !kwm real :: errwat !error in water balance [mm/timestep] - real :: erreng !error in surface energy balance [w/m2] - real :: errsw !error in shortwave radiation balance [w/m2] - real :: fsrvg + real (kind=kind_phys) :: end_wb !water storage at end of a timestep [mm] + !kwm real (kind=kind_phys) :: errwat !error in water balance [mm/timestep] + real (kind=kind_phys) :: erreng !error in surface energy balance [w/m2] + real (kind=kind_phys) :: errsw !error in shortwave radiation balance [w/m2] + real (kind=kind_phys) :: fsrvg character(len=256) :: message ! -------------------------------------------------------------------------------------------------- !jref:start @@ -1439,14 +1585,14 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,errmsg ,errflg, & !inout + tauss ,laisun ,laisha ,rb ,errmsg ,errflg, & !inout #else - tauss , & !inout + tauss ,laisun ,laisha ,rb , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in t2mv ,t2mb ,fsrv , & - fsrg ,rssun ,rssha ,bgap ,wgap,tgv,tgb,& + fsrg ,rssun ,rssha ,albd ,albi,albsnd ,albsni,bgap ,wgap,tgv,tgb,& q1 ,q2v ,q2b ,q2e ,chv ,chb, emissi,pah ,& shg,shc,shb,evg,evb,ghv,ghb,irg,irc,irb,tr,evc,chleaf,chuc,chv2,chb2 ) !out !jref:end @@ -1496,214 +1642,218 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers integer , intent(in) :: isnow !actual no. of snow layers - real , intent(in) :: dt !time step [sec] - real , intent(in) :: qsnow !snowfall on the ground (mm/s) - real , intent(in) :: rhoair !density air (kg/m3) - real , intent(in) :: eair !vapor pressure air (pa) - real , intent(in) :: sfcprs !pressure (pa) - real , intent(in) :: qair !specific humidity (kg/kg) - real , intent(in) :: sfctmp !air temperature (k) - real , intent(in) :: thair !potential temperature (k) - real , intent(in) :: lwdn !downward longwave radiation (w/m2) - real , intent(in) :: uu !wind speed in e-w dir (m/s) - real , intent(in) :: vv !wind speed in n-s dir (m/s) - real , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) - real , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) - real , intent(in) :: cosz !cosine solar zenith angle (0-1) - real , intent(in) :: elai !lai adjusted for burying by snow - real , intent(in) :: esai !lai adjusted for burying by snow - real , intent(in) :: fwet !fraction of canopy that is wet [-] - real , intent(in) :: fveg !greeness vegetation fraction (-) - real , intent(in) :: lat !latitude (radians) - real , intent(in) :: canliq !canopy-intercepted liquid water (mm) - real , intent(in) :: canice !canopy-intercepted ice mass (mm) - real , intent(in) :: foln !foliage nitrogen (%) - real , intent(in) :: co2air !atmospheric co2 concentration (pa) - real , intent(in) :: o2air !atmospheric o2 concentration (pa) - real , intent(in) :: igs !growing season index (0=off, 1=on) - - real , intent(in) :: zref !reference height (m) - real , intent(in) :: tbot !bottom condition for soil temp. (k) - real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] - real , dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf [m] - real , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] - real, intent(in) :: pahv !precipitation advected heat - vegetation net (w/m2) - real, intent(in) :: pahg !precipitation advected heat - under canopy net (w/m2) - real, intent(in) :: pahb !precipitation advected heat - bare ground net (w/m2) + real (kind=kind_phys) , intent(in) :: dt !time step [sec] + real (kind=kind_phys) , intent(in) :: qsnow !snowfall on the ground (mm/s) + real (kind=kind_phys) , intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys) , intent(in) :: eair !vapor pressure air (pa) + real (kind=kind_phys) , intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys) , intent(in) :: qair !specific humidity (kg/kg) + real (kind=kind_phys) , intent(in) :: sfctmp !air temperature (k) + real (kind=kind_phys) , intent(in) :: thair !potential temperature (k) + real (kind=kind_phys) , intent(in) :: lwdn !downward longwave radiation (w/m2) + real (kind=kind_phys) , intent(in) :: uu !wind speed in e-w dir (m/s) + real (kind=kind_phys) , intent(in) :: vv !wind speed in n-s dir (m/s) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solad !incoming direct solar rad. (w/m2) + real (kind=kind_phys) , dimension( 1: 2), intent(in) :: solai !incoming diffuse solar rad. (w/m2) + real (kind=kind_phys) , intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys) , intent(in) :: elai !lai adjusted for burying by snow + real (kind=kind_phys) , intent(in) :: esai !lai adjusted for burying by snow + real (kind=kind_phys) , intent(in) :: fwet !fraction of canopy that is wet [-] + real (kind=kind_phys) , intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys) , intent(in) :: canliq !canopy-intercepted liquid water (mm) + real (kind=kind_phys) , intent(in) :: canice !canopy-intercepted ice mass (mm) + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: co2air !atmospheric co2 concentration (pa) + real (kind=kind_phys) , intent(in) :: o2air !atmospheric o2 concentration (pa) + real (kind=kind_phys) , intent(in) :: igs !growing season index (0=off, 1=on) + + real (kind=kind_phys) , intent(in) :: zref !reference height (m) + real (kind=kind_phys) , intent(in) :: tbot !bottom condition for soil temp. (k) + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] + real (kind=kind_phys) , dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf [m] + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !depth of snow & soil layer-bottom [m] + real (kind=kind_phys), intent(in) :: pahv !precipitation advected heat - vegetation net (w/m2) + real (kind=kind_phys), intent(in) :: pahg !precipitation advected heat - under canopy net (w/m2) + real (kind=kind_phys), intent(in) :: pahb !precipitation advected heat - bare ground net (w/m2) !jref:start; in - real , intent(in) :: qc !cloud water mixing ratio - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: dx !horisontal resolution - real , intent(in) :: dz8w !thickness of lowest layer - real , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dx !horisontal resolution + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) !jref:end ! outputs - real , intent(out) :: z0wrf !combined z0 sent to coupled model + real (kind=kind_phys) , intent(out) :: z0wrf !combined z0 sent to coupled model integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index [1-melt; 2-freeze] - real , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] - real , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real , intent(out) :: fsno !snow cover fraction (-) - real , intent(out) :: qmelt !snowmelt [mm/s] - real , intent(out) :: ponding!pounding at ground [mm] - real , intent(out) :: sav !solar rad. absorbed by veg. (w/m2) - real , intent(out) :: sag !solar rad. absorbed by ground (w/m2) - real , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) - real , intent(out) :: fsr !tot. reflected solar radiation (w/m2) - real , intent(out) :: taux !wind stress: e-w (n/m2) - real , intent(out) :: tauy !wind stress: n-s (n/m2) - real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] - real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fcev !canopy evaporation (w/m2) [+ to atm] - real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] - real , intent(out) :: fctr !transpiration (w/m2) [+ to atm] - real , intent(out) :: trad !radiative temperature (k) - real , intent(out) :: t2m !2 m height air temperature (k) - real , intent(out) :: psn !total photosyn. (umolco2/m2/s) [+] - real , intent(out) :: apar !total photosyn. active energy (w/m2) - real , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] - real , dimension( 1:nsoil), intent(out) :: btrani !soil water transpiration factor (0-1) - real , intent(out) :: btran !soil water transpiration factor (0-1) -! real , intent(out) :: lathea !latent heat vap./sublimation (j/kg) - real , intent(out) :: latheav !latent heat vap./sublimation (j/kg) - real , intent(out) :: latheag !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume ice [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume liq. water [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys) , intent(out) :: fsno !snow cover fraction (-) + real (kind=kind_phys) , intent(out) :: qmelt !snowmelt [mm/s] + real (kind=kind_phys) , intent(out) :: ponding!pounding at ground [mm] + real (kind=kind_phys) , intent(out) :: sav !solar rad. absorbed by veg. (w/m2) + real (kind=kind_phys) , intent(out) :: sag !solar rad. absorbed by ground (w/m2) + real (kind=kind_phys) , intent(out) :: fsa !tot. absorbed solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsr !tot. reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: taux !wind stress: e-w (n/m2) + real (kind=kind_phys) , intent(out) :: tauy !wind stress: n-s (n/m2) + real (kind=kind_phys) , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fcev !canopy evaporation (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: fctr !transpiration (w/m2) [+ to atm] + real (kind=kind_phys) , intent(out) :: trad !radiative temperature (k) + real (kind=kind_phys) , intent(out) :: t2m !2 m height air temperature (k) + real (kind=kind_phys) , intent(out) :: psn !total photosyn. (umolco2/m2/s) [+] + real (kind=kind_phys) , intent(out) :: apar !total photosyn. active energy (w/m2) + real (kind=kind_phys) , intent(out) :: ssoil !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys) , dimension( 1:nsoil), intent(out) :: btrani !soil water transpiration factor (0-1) + real (kind=kind_phys) , intent(out) :: btran !soil water transpiration factor (0-1) +! real (kind=kind_phys) , intent(out) :: lathea !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(out) :: latheav !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(out) :: latheag !latent heat vap./sublimation (j/kg) logical , intent(out) :: frozen_ground ! used to define latent heat pathway logical , intent(out) :: frozen_canopy ! used to define latent heat pathway !jref:start - real , intent(out) :: fsrv !veg. reflected solar radiation (w/m2) - real , intent(out) :: fsrg !ground reflected solar radiation (w/m2) - real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) - real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + real (kind=kind_phys) , intent(out) :: fsrv !veg. reflected solar radiation (w/m2) + real (kind=kind_phys) , intent(out) :: fsrg !ground reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: rssha !shaded leaf stomatal resistance (s/m) !jref:end - out for debug !jref:start; output - real , intent(out) :: t2mv !2-m air temperature over vegetated part [k] - real , intent(out) :: t2mb !2-m air temperature over bare ground part [k] - real , intent(out) :: bgap - real , intent(out) :: wgap + real (kind=kind_phys) , intent(out) :: t2mv !2-m air temperature over vegetated part [k] + real (kind=kind_phys) , intent(out) :: t2mb !2-m air temperature over bare ground part [k] + real (kind=kind_phys) , intent(out) :: bgap + real (kind=kind_phys) , intent(out) :: wgap + real (kind=kind_phys), dimension(1:2) , intent(out) :: albd !albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albi !albedo (diffuse) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) , intent(out) :: albsni !snow albedo (diffuse) !jref:end ! input & output - real , intent(inout) :: ts !surface temperature (k) - real , intent(inout) :: tv !vegetation temperature (k) - real , intent(inout) :: tg !ground temperature (k) - real , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] - real , intent(inout) :: snowh !snow height [m] - real , intent(inout) :: sneqv !snow mass (mm) - real , intent(inout) :: sneqvo !snow mass at last time step (mm) - real , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] - real , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] - real , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) - real , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) - real , intent(inout) :: eah !canopy air vapor pressure (pa) - real , intent(inout) :: tah !canopy air temperature (k) - real , intent(inout) :: albold !snow albedo at last time step(class type) - real , intent(inout) :: tauss !non-dimensional snow age - real , intent(inout) :: cm !momentum drag coefficient - real , intent(inout) :: ch !sensible heat exchange coefficient - real , intent(inout) :: q1 + real (kind=kind_phys) , intent(inout) :: ts !surface temperature (k) + real (kind=kind_phys) , intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys) , dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil temperature [k] + real (kind=kind_phys) , intent(inout) :: snowh !snow height [m] + real (kind=kind_phys) , intent(inout) :: sneqv !snow mass (mm) + real (kind=kind_phys) , intent(inout) :: sneqvo !snow mass at last time step (mm) + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , dimension( 1:nsoil), intent(inout) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys) , dimension(-nsnow+1: 0), intent(inout) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys) , intent(inout) :: eah !canopy air vapor pressure (pa) + real (kind=kind_phys) , intent(inout) :: tah !canopy air temperature (k) + real (kind=kind_phys) , intent(inout) :: albold !snow albedo at last time step(class type) + real (kind=kind_phys) , intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys) , intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys) , intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys) , intent(inout) :: q1 + real , intent(inout) :: rb !leaf boundary layer resistance (s/m) + real , intent(inout) :: laisun !sunlit leaf area index (m2/m2) + real , intent(inout) :: laisha !shaded leaf area index (m2/m2) #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg #endif -! real :: q2e - real, intent(out) :: emissi - real, intent(out) :: pah !precipitation advected heat - total (w/m2) +! real (kind=kind_phys) :: q2e + real (kind=kind_phys), intent(out) :: emissi + real (kind=kind_phys), intent(out) :: pah !precipitation advected heat - total (w/m2) ! local integer :: iz !do-loop index logical :: veg !true if vegetated surface - real :: ur !wind speed at height zlvl (m/s) - real :: zlvl !reference height (m) - real :: fsun !sunlit fraction of canopy [-] - real :: rb !leaf boundary layer resistance (s/m) - real :: rsurf !ground surface resistance (s/m) - real :: l_rsurf!dry-layer thickness for computing rsurf (sakaguchi and zeng, 2009) - real :: d_rsurf!reduced vapor diffusivity in soil for computing rsurf (sz09) - real :: bevap !soil water evaporation factor (0- 1) - real :: mol !monin-obukhov length (m) - real :: vai !sum of lai + stem area index [m2/m2] - real :: cwp !canopy wind extinction parameter - real :: zpd !zero plane displacement (m) - real :: z0m !z0 momentum (m) - real :: zpdg !zero plane displacement (m) - real :: z0mg !z0 momentum, ground (m) - real :: emv !vegetation emissivity - real :: emg !ground emissivity - real :: fire !emitted ir (w/m2) - - real :: laisun !sunlit leaf area index (m2/m2) - real :: laisha !shaded leaf area index (m2/m2) - real :: psnsun !sunlit photosynthesis (umolco2/m2/s) - real :: psnsha !shaded photosynthesis (umolco2/m2/s) + real (kind=kind_phys) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys) :: zlvl !reference height (m) + real (kind=kind_phys) :: fsun !sunlit fraction of canopy [-] + real (kind=kind_phys) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys) :: l_rsurf!dry-layer thickness for computing rsurf (sakaguchi and zeng, 2009) + real (kind=kind_phys) :: d_rsurf!reduced vapor diffusivity in soil for computing rsurf (sz09) + real (kind=kind_phys) :: bevap !soil water evaporation factor (0- 1) + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: vai !sum of lai + stem area index [m2/m2] + real (kind=kind_phys) :: cwp !canopy wind extinction parameter + real (kind=kind_phys) :: zpd !zero plane displacement (m) + real (kind=kind_phys) :: z0m !z0 momentum (m) + real (kind=kind_phys) :: zpdg !zero plane displacement (m) + real (kind=kind_phys) :: z0mg !z0 momentum, ground (m) + real (kind=kind_phys) :: emv !vegetation emissivity + real (kind=kind_phys) :: emg !ground emissivity + real (kind=kind_phys) :: fire !emitted ir (w/m2) + + real (kind=kind_phys) :: psnsun !sunlit photosynthesis (umolco2/m2/s) + real (kind=kind_phys) :: psnsha !shaded photosynthesis (umolco2/m2/s) !jref:start - for debug -! real :: rssun !sunlit stomatal resistance (s/m) -! real :: rssha !shaded stomatal resistance (s/m) +! real (kind=kind_phys) :: rssun !sunlit stomatal resistance (s/m) +! real (kind=kind_phys) :: rssha !shaded stomatal resistance (s/m) !jref:end - for debug - real :: parsun !par absorbed per sunlit lai (w/m2) - real :: parsha !par absorbed per shaded lai (w/m2) - - real, dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change - real, dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] - real :: bdsno !bulk density of snow (kg/m3) - real :: fmelt !melting factor for snow cover frac - real :: gx !temporary variable - real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) -! real :: gamma !psychrometric constant (pa/k) - real :: gammav !psychrometric constant (pa/k) - real :: gammag !psychrometric constant (pa/k) - real :: psi !surface layer soil matrix potential (m) - real :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys) :: parsun !par absorbed per sunlit lai (w/m2) + real (kind=kind_phys) :: parsha !par absorbed per shaded lai (w/m2) + + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: fact !temporary used in phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys) :: bdsno !bulk density of snow (kg/m3) + real (kind=kind_phys) :: fmelt !melting factor for snow cover frac + real (kind=kind_phys) :: gx !temporary variable + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) +! real (kind=kind_phys) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys) :: gammav !psychrometric constant (pa/k) + real (kind=kind_phys) :: gammag !psychrometric constant (pa/k) + real (kind=kind_phys) :: psi !surface layer soil matrix potential (m) + real (kind=kind_phys) :: rhsur !raltive humidity in surface soil/snow air space (-) ! temperature and fluxes over vegetated fraction - real :: tauxv !wind stress: e-w dir [n/m2] - real :: tauyv !wind stress: n-s dir [n/m2] - real,intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] - real,intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] - real,intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] - real,intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] + real (kind=kind_phys) :: tauxv !wind stress: e-w dir [n/m2] + real (kind=kind_phys) :: tauyv !wind stress: n-s dir [n/m2] + real (kind=kind_phys),intent(out) :: irc !canopy net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: irg !ground net lw rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shc !canopy sen. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shg !ground sen. heat [w/m2] [+ to atm] !jref:start - real,intent(out) :: q2v - real,intent(out) :: q2b - real,intent(out) :: q2e + real (kind=kind_phys),intent(out) :: q2v + real (kind=kind_phys),intent(out) :: q2b + real (kind=kind_phys),intent(out) :: q2e !jref:end - real,intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] - real,intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] - real,intent(out) :: tr !transpiration heat [w/m2] [+ to atm] - real,intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: tgv !ground surface temp. [k] - real :: cmv !momentum drag coefficient - real,intent(out) :: chv !sensible heat exchange coefficient + real (kind=kind_phys),intent(out) :: evc !canopy evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evg !ground evap. heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: tr !transpiration heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghv !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: tgv !ground surface temp. [k] + real (kind=kind_phys) :: cmv !momentum drag coefficient + real (kind=kind_phys),intent(out) :: chv !sensible heat exchange coefficient ! temperature and fluxes over bare soil fraction - real :: tauxb !wind stress: e-w dir [n/m2] - real :: tauyb !wind stress: n-s dir [n/m2] - real,intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] - real,intent(out) :: shb !sensible heat [w/m2] [+ to atm] - real,intent(out) :: evb !evaporation heat [w/m2] [+ to atm] - real,intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] - real,intent(out) :: tgb !ground surface temp. [k] - real :: cmb !momentum drag coefficient - real,intent(out) :: chb !sensible heat exchange coefficient - real,intent(out) :: chleaf !leaf exchange coefficient - real,intent(out) :: chuc !under canopy exchange coefficient + real (kind=kind_phys) :: tauxb !wind stress: e-w dir [n/m2] + real (kind=kind_phys) :: tauyb !wind stress: n-s dir [n/m2] + real (kind=kind_phys),intent(out) :: irb !net longwave rad. [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: shb !sensible heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: evb !evaporation heat [w/m2] [+ to atm] + real (kind=kind_phys),intent(out) :: ghb !ground heat flux [w/m2] [+ to soil] + real (kind=kind_phys),intent(out) :: tgb !ground surface temp. [k] + real (kind=kind_phys) :: cmb !momentum drag coefficient + real (kind=kind_phys),intent(out) :: chb !sensible heat exchange coefficient + real (kind=kind_phys),intent(out) :: chleaf !leaf exchange coefficient + real (kind=kind_phys),intent(out) :: chuc !under canopy exchange coefficient !jref:start - real,intent(out) :: chv2 !sensible heat conductance, canopy air to zlvl air (m/s) - real,intent(out) :: chb2 !sensible heat conductance, canopy air to zlvl air (m/s) - real :: noahmpres + real (kind=kind_phys),intent(out) :: chv2 !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys),intent(out) :: chb2 !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys) :: noahmpres !jref:end - real, parameter :: mpe = 1.e-6 - real, parameter :: psiwlt = -150. !metric potential for wilting point (m) - real, parameter :: z0 = 0.01 ! bare-soil roughness length (m) (i.e., under the canopy) + real (kind=kind_phys), parameter :: mpe = 1.e-6 + real (kind=kind_phys), parameter :: psiwlt = -150. !metric potential for wilting point (m) + real (kind=kind_phys), parameter :: z0 = 0.002 ! bare-soil roughness length (m) (i.e., under the canopy) ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction @@ -1726,6 +1876,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in chleaf = 0. chuc = 0. chv2 = 0. + rb = 0. ! wind speed at reference height: ur >= 1 @@ -1743,7 +1894,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in if(snowh.gt.0.) then bdsno = sneqv / snowh fmelt = (bdsno/100.)**parameters%mfsno - fsno = tanh( snowh /(2.5* z0 * fmelt)) + fsno = tanh( snowh /(parameters%scffac * fmelt)) endif ! ground roughness length @@ -1770,6 +1921,15 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in zpd = zpdg end if +! special case for urban + + IF (parameters%urban_flag) THEN + Z0MG = parameters%Z0MVT + ZPDG = 0.65 * parameters%HVT + Z0M = Z0MG + ZPD = ZPDG + END IF + zlvl = max(zpd,parameters%hvt) + zref if(zpdg >= zlvl) zlvl = zpdg + zref ! ur = ur*log(zlvl/z0m)/log(10./z0m) !input ur is at 10m @@ -1797,15 +1957,15 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in albold ,tauss , & !inout fsun ,laisun ,laisha ,parsun ,parsha , & !out sav ,sag ,fsr ,fsa ,fsrv , & - fsrg ,bgap ,wgap ) !out + fsrg ,albd ,albi ,albsnd ,albsni ,bgap ,wgap ) ! out ! vegetation and ground emissivity emv = 1. - exp(-(elai+esai)/1.0) if (ice == 1) then - emg = 0.98*(1.-fsno) + 1.0*fsno + emg = 0.98*(1.-fsno) + parameters%snow_emis*fsno else - emg = parameters%eg(ist)*(1.-fsno) + 1.0*fsno + emg = parameters%eg(ist)*(1.-fsno) + parameters%snow_emis*fsno end if ! soil moisture factor controlling stomatal resistance @@ -1815,14 +1975,14 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in if(ist ==1 ) then do iz = 1, parameters%nroot if(opt_btr == 1) then ! noah - gx = (sh2o(iz)-parameters%smcwlt) / (parameters%smcref-parameters%smcwlt) + gx = (sh2o(iz)-parameters%smcwlt(iz)) / (parameters%smcref(iz)-parameters%smcwlt(iz)) end if if(opt_btr == 2) then ! clm - psi = max(psiwlt,-parameters%psisat*(max(0.01,sh2o(iz))/parameters%smcmax)**(-parameters%bexp) ) - gx = (1.-psi/psiwlt)/(1.+parameters%psisat/psiwlt) + psi = max(psiwlt,-parameters%psisat(iz)*(max(0.01,sh2o(iz))/parameters%smcmax(iz))**(-parameters%bexp(iz)) ) + gx = (1.-psi/psiwlt)/(1.+parameters%psisat(iz)/psiwlt) end if if(opt_btr == 3) then ! ssib - psi = max(psiwlt,-parameters%psisat*(max(0.01,sh2o(iz))/parameters%smcmax)**(-parameters%bexp) ) + psi = max(psiwlt,-parameters%psisat(iz)*(max(0.01,sh2o(iz))/parameters%smcmax(iz))**(-parameters%bexp(iz)) ) gx = 1.-exp(-5.8*(log(psiwlt/psi))) end if @@ -1837,25 +1997,31 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in ! soil surface resistance for ground evap. - bevap = max(0.0,sh2o(1)/parameters%smcmax) + bevap = max(0.0,sh2o(1)/parameters%smcmax(1)) if(ist == 2) then rsurf = 1. ! avoid being divided by 0 rhsur = 1.0 else - ! rsurf based on sakaguchi and zeng, 2009 - ! taking the "residual water content" to be the wilting point, - ! and correcting the exponent on the d term (typo in sz09 ?) - l_rsurf = (-zsoil(1)) * ( exp ( (1.0 - min(1.0,sh2o(1)/parameters%smcmax)) ** 5 ) - 1.0 ) / ( 2.71828 - 1.0 ) - d_rsurf = 2.2e-5 * parameters%smcmax * parameters%smcmax * ( 1.0 - parameters%smcwlt / parameters%smcmax ) ** (2.0+3.0/parameters%bexp) - rsurf = l_rsurf / d_rsurf + if(opt_rsf == 1 .or. opt_rsf == 4) then + ! rsurf based on sakaguchi and zeng, 2009 + ! taking the "residual water content" to be the wilting point, + ! and correcting the exponent on the d term (typo in sz09 ?) + l_rsurf = (-zsoil(1)) * ( exp ( (1.0 - min(1.0,sh2o(1)/parameters%smcmax(1))) ** parameters%rsurf_exp ) - 1.0 ) / ( 2.71828 - 1.0 ) + d_rsurf = 2.2e-5 * parameters%smcmax(1) * parameters%smcmax(1) * ( 1.0 - parameters%smcwlt(1) / parameters%smcmax(1) ) ** (2.0+3.0/parameters%bexp(1)) + rsurf = l_rsurf / d_rsurf + elseif(opt_rsf == 2) then + rsurf = fsno * 1. + (1.-fsno)* exp(8.25-4.225*bevap) !sellers (1992) ! older rsurf computations + elseif(opt_rsf == 3) then + rsurf = fsno * 1. + (1.-fsno)* exp(8.25-6.0 *bevap) !adjusted to decrease rsurf for wet soil + endif - ! older rsurf computations: - ! rsurf = fsno * 1. + (1.-fsno)* exp(8.25-4.225*bevap) !sellers (1992) - ! rsurf = fsno * 1. + (1.-fsno)* exp(8.25-6.0 *bevap) !adjusted to decrease rsurf for wet soil + if(opt_rsf == 4) then ! ad: fsno weighted; snow rsurf set in mptable v3.8 + rsurf = 1. / (fsno * (1./parameters%rsurf_snow) + (1.-fsno) * (1./max(rsurf, 0.001))) + endif if(sh2o(1) < 0.01 .and. snowh == 0.) rsurf = 1.e6 - psi = -parameters%psisat*(max(0.01,sh2o(1))/parameters%smcmax)**(-parameters%bexp) + psi = -parameters%psisat(1)*(max(0.01,sh2o(1))/parameters%smcmax(1))**(-parameters%bexp(1)) rhsur = fsno + (1.-fsno) * exp(psi*grav/(rw*tg)) end if @@ -1897,14 +2063,12 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in tgv = tg cmv = cm chv = ch -! YRQ -! write(*,*) 'cm,ch,tv,tgv, YRQ', cm,ch,tv,tgv call vege_flux (parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & !in dt ,sav ,sag ,lwdn ,ur , & !in uu ,vv ,sfctmp ,thair ,qair , & !in - eair ,rhoair ,snowh ,vai ,gammav ,gammag , & !in + eair ,rhoair ,snowh ,vai ,gammav ,gammag , & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -1934,7 +2098,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in call bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & !in lwdn ,ur ,uu ,vv ,sfctmp , & !in thair ,qair ,eair ,rhoair ,snowh , & !in - dzsnso ,zlvl ,zpdg ,z0mg ,fsno, & !in + dzsnso ,zlvl ,zpdg ,z0mg ,fsno, & !in emg ,stc ,df ,rsurf ,latheag , & !in gammag ,rhsur ,iloc ,jloc ,q2 ,pahb , & !in #ifdef CCPP @@ -2096,35 +2260,35 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: isnow !actual no. of snow layers integer , intent(in) :: ist !surface type - real , intent(in) :: dt !time step [s] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] - real, dimension( 1:nsoil), intent(in) :: sh2o !liquid soil moisture [m3/m3] - real , intent(in) :: snowh !snow height [m] - real, intent(in) :: tg !surface temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil/lake temp. (k) - real, intent(in) :: ur !wind speed at zlvl (m/s) - real, intent(in) :: lat !latitude (radians) - real, intent(in) :: z0m !roughness length (m) - real, intent(in) :: zlvl !reference height (m) + real (kind=kind_phys) , intent(in) :: dt !time step [s] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sh2o !liquid soil moisture [m3/m3] + real (kind=kind_phys) , intent(in) :: snowh !snow height [m] + real (kind=kind_phys), intent(in) :: tg !surface temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil/lake temp. (k) + real (kind=kind_phys), intent(in) :: ur !wind speed at zlvl (m/s) + real (kind=kind_phys), intent(in) :: lat !latitude (radians) + real (kind=kind_phys), intent(in) :: z0m !roughness length (m) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) integer , intent(in) :: vegtyp !vegtyp type ! outputs - real, dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] - real, dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: fact !computing energy for phase change ! -------------------------------------------------------------------------------------------------- ! locals integer :: iz - real, dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) - real, dimension( 1:nsoil) :: sice !soil ice content + real (kind=kind_phys), dimension(-nsnow+1: 0) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: tksno !snow thermal conductivity (j/m3/k) + real (kind=kind_phys), dimension( 1:nsoil) :: sice !soil ice content ! -------------------------------------------------------------------------------------------------- ! compute snow thermal conductivity and heat capacity @@ -2141,9 +2305,9 @@ subroutine thermoprop (parameters,nsoil ,nsnow ,isnow ,ist ,dzsnso , do iz = 1, nsoil sice(iz) = smc(iz) - sh2o(iz) - hcpct(iz) = sh2o(iz)*cwat + (1.0-parameters%smcmax)*parameters%csoil & - + (parameters%smcmax-smc(iz))*cpair + sice(iz)*cice - call tdfcnd (parameters,df(iz), smc(iz), sh2o(iz)) + hcpct(iz) = sh2o(iz)*cwat + (1.0-parameters%smcmax(iz))*parameters%csoil & + + (parameters%smcmax(iz)-smc(iz))*cpair + sice(iz)*cice + call tdfcnd (parameters,iz,df(iz), smc(iz), sh2o(iz)) end do if ( parameters%urban_flag ) then @@ -2206,22 +2370,22 @@ subroutine csnow (parameters,isnow ,nsnow ,nsoil ,snice ,snliq ,dzsnso integer, intent(in) :: isnow !number of snow layers (-) integer , intent(in) :: nsnow !maximum no. of snow layers integer , intent(in) :: nsoil !number of soil layers - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow ice mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow liq mass (kg/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] ! outputs - real, dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) - real, dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) - real, dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] - real, dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: cvsno !volumetric specific heat (j/m3/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: tksno !thermal conductivity (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snicev !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: snliqv !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(out) :: epore !effective porosity [m3/m3] ! locals integer :: iz - real, dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) + real (kind=kind_phys), dimension(-nsnow+1: 0) :: bdsnoi !bulk density of snow(kg/m3) !--------------------------------------------------------------------------------------------------- ! thermal capacity of snow @@ -2253,7 +2417,7 @@ end subroutine csnow !== begin tdfcnd =================================================================================== !>\ingroup NoahMP_LSM - subroutine tdfcnd (parameters, df, smc, sh2o) + subroutine tdfcnd (parameters, isoil, df, smc, sh2o) ! -------------------------------------------------------------------------------------------------- ! calculate thermal diffusivity and conductivity of the soil. ! peters-lidard approach (peters-lidard et al., 1998) @@ -2263,22 +2427,23 @@ subroutine tdfcnd (parameters, df, smc, sh2o) ! -------------------------------------------------------------------------------------------------- implicit none type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: smc ! total soil water - real, intent(in) :: sh2o ! liq. soil water - real, intent(out) :: df ! thermal diffusivity + integer, intent(in) :: isoil ! soil layer + real (kind=kind_phys), intent(in) :: smc ! total soil water + real (kind=kind_phys), intent(in) :: sh2o ! liq. soil water + real (kind=kind_phys), intent(out) :: df ! thermal diffusivity ! local variables - real :: ake - real :: gammd - real :: thkdry - real :: thko ! thermal conductivity for other soil components - real :: thkqtz ! thermal conductivity for quartz - real :: thksat ! - real :: thks ! thermal conductivity for the solids - real :: thkw ! water thermal conductivity - real :: satratio - real :: xu - real :: xunfroz + real (kind=kind_phys) :: ake + real (kind=kind_phys) :: gammd + real (kind=kind_phys) :: thkdry + real (kind=kind_phys) :: thko ! thermal conductivity for other soil components + real (kind=kind_phys) :: thkqtz ! thermal conductivity for quartz + real (kind=kind_phys) :: thksat ! + real (kind=kind_phys) :: thks ! thermal conductivity for the solids + real (kind=kind_phys) :: thkw ! water thermal conductivity + real (kind=kind_phys) :: satratio + real (kind=kind_phys) :: xu + real (kind=kind_phys) :: xunfroz ! -------------------------------------------------------------------------------------------------- ! we now get quartz as an input argument (set in routine redprm): ! data quartz /0.82, 0.10, 0.25, 0.60, 0.52, @@ -2307,7 +2472,7 @@ subroutine tdfcnd (parameters, df, smc, sh2o) ! poros = smcmax ! saturation ratio: ! parameters w/(m.k) - satratio = smc / parameters%smcmax + satratio = smc / parameters%smcmax(isoil) thkw = 0.57 ! if (quartz .le. 0.2) thko = 3.0 thko = 2.0 @@ -2316,19 +2481,20 @@ subroutine tdfcnd (parameters, df, smc, sh2o) thkqtz = 7.7 ! unfrozen fraction (from 1., i.e., 100%liquid, to 0. (100% frozen)) - thks = (thkqtz ** parameters%quartz)* (thko ** (1. - parameters%quartz)) + thks = (thkqtz ** parameters%quartz(isoil))* (thko ** (1. - parameters%quartz(isoil))) ! unfrozen volume for saturation (porosity*xunfroz) - xunfroz = sh2o / smc + xunfroz = 1.0 ! prevent divide by zero (suggested by d. mocko) + if(smc > 0.) xunfroz = sh2o / smc ! saturated thermal conductivity - xu = xunfroz * parameters%smcmax + xu = xunfroz * parameters%smcmax(isoil) ! dry density in kg/m3 - thksat = thks ** (1. - parameters%smcmax)* tkice ** (parameters%smcmax - xu)* thkw ** & + thksat = thks ** (1. - parameters%smcmax(isoil))* tkice ** (parameters%smcmax(isoil) - xu)* thkw ** & (xu) ! dry thermal conductivity in w.m-1.k-1 - gammd = (1. - parameters%smcmax)*2700. + gammd = (1. - parameters%smcmax(isoil))*2700. thkdry = (0.135* gammd+ 64.7)/ (2700. - 0.947* gammd) ! frozen @@ -2371,7 +2537,7 @@ subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in albold ,tauss , & !inout fsun ,laisun ,laisha ,parsun ,parsha , & !out sav ,sag ,fsr ,fsa ,fsrv , & - fsrg ,bgap ,wgap) !out + fsrg ,albd ,albi ,albsnd ,albsni ,bgap ,wgap) !out ! -------------------------------------------------------------------------------------------------- implicit none ! -------------------------------------------------------------------------------------------------- @@ -2384,67 +2550,69 @@ subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in integer, intent(in) :: ice !ice (ice = 1) integer, intent(in) :: nsoil !number of soil layers - real, intent(in) :: dt !time step [s] - real, intent(in) :: qsnow !snowfall (mm/s) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow mass (mm) - real, intent(in) :: snowh !snow height (mm) - real, intent(in) :: cosz !cosine solar zenith angle (0-1) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: elai !lai, one-sided, adjusted for burying by snow - real, intent(in) :: esai !sai, one-sided, adjusted for burying by snow - real, intent(in) :: fwet !fraction of canopy that is wet - real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water [m3/m3] - real, dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) - real, dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) - real, intent(in) :: fsno !snow cover fraction (-) - real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys), intent(in) :: dt !time step [s] + real (kind=kind_phys), intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow mass (mm) + real (kind=kind_phys), intent(in) :: snowh !snow height (mm) + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: elai !lai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: esai !sai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: fwet !fraction of canopy that is wet + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc !volumetric soil water [m3/m3] + real (kind=kind_phys), dimension(1:2) , intent(in) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2) , intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys), intent(in) :: fsno !snow cover fraction (-) + real (kind=kind_phys), intent(in) :: fveg !green vegetation fraction [0.0-1.0] ! inout - real, intent(inout) :: albold !snow albedo at last time step (class type) - real, intent(inout) :: tauss !non-dimensional snow age. + real (kind=kind_phys), intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age. ! output - real, intent(out) :: fsun !sunlit fraction of canopy (-) - real, intent(out) :: laisun !sunlit leaf area (-) - real, intent(out) :: laisha !shaded leaf area (-) - real, intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) - real, intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) - real, intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) - real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(out) :: fsa !total absorbed solar radiation (w/m2) - real, intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsun !sunlit fraction of canopy (-) + real (kind=kind_phys), intent(out) :: laisun !sunlit leaf area (-) + real (kind=kind_phys), intent(out) :: laisha !shaded leaf area (-) + real (kind=kind_phys), intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) + real (kind=kind_phys), intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) + real (kind=kind_phys), intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) + real (kind=kind_phys), intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsr !total reflected solar radiation (w/m2) !jref:start - real, intent(out) :: fsrv !veg. reflected solar radiation (w/m2) - real, intent(out) :: fsrg !ground reflected solar radiation (w/m2) - real, intent(out) :: bgap - real, intent(out) :: wgap + real (kind=kind_phys), intent(out) :: fsrv !veg. reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsrg !ground reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: bgap + real (kind=kind_phys), intent(out) :: wgap + real (kind=kind_phys), dimension(1:2), intent(out) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2), intent(out) :: albsni !snow albedo (diffuse) !jref:end ! local - real :: fage !snow age function (0 - new snow) - real, dimension(1:2) :: albgrd !ground albedo (direct) - real, dimension(1:2) :: albgri !ground albedo (diffuse) - real, dimension(1:2) :: albd !surface albedo (direct) - real, dimension(1:2) :: albi !surface albedo (diffuse) - real, dimension(1:2) :: fabd !flux abs by veg (per unit direct flux) - real, dimension(1:2) :: fabi !flux abs by veg (per unit diffuse flux) - real, dimension(1:2) :: ftdd !down direct flux below veg (per unit dir flux) - real, dimension(1:2) :: ftid !down diffuse flux below veg (per unit dir flux) - real, dimension(1:2) :: ftii !down diffuse flux below veg (per unit dif flux) + real (kind=kind_phys) :: fage !snow age function (0 - new snow) + real (kind=kind_phys), dimension(1:2) :: albgrd !ground albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albgri !ground albedo (diffuse) + real (kind=kind_phys), dimension(1:2) :: albd !surface albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albi !surface albedo (diffuse) + real (kind=kind_phys), dimension(1:2) :: fabd !flux abs by veg (per unit direct flux) + real (kind=kind_phys), dimension(1:2) :: fabi !flux abs by veg (per unit diffuse flux) + real (kind=kind_phys), dimension(1:2) :: ftdd !down direct flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1:2) :: ftid !down diffuse flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1:2) :: ftii !down diffuse flux below veg (per unit dif flux) !jref:start - real, dimension(1:2) :: frevi - real, dimension(1:2) :: frevd - real, dimension(1:2) :: fregi - real, dimension(1:2) :: fregd + real (kind=kind_phys), dimension(1:2) :: frevi + real (kind=kind_phys), dimension(1:2) :: frevd + real (kind=kind_phys), dimension(1:2) :: fregi + real (kind=kind_phys), dimension(1:2) :: fregd !jref:end - real :: fsha !shaded fraction of canopy - real :: vai !total lai + stem area index, one sided + real (kind=kind_phys) :: fsha !shaded fraction of canopy + real (kind=kind_phys) :: vai !total lai + stem area index, one sided - real,parameter :: mpe = 1.e-6 + real (kind=kind_phys),parameter :: mpe = 1.e-6 logical veg !true: vegetated for surface temperature calculation ! -------------------------------------------------------------------------------------------------- @@ -2460,7 +2628,7 @@ subroutine radiation (parameters,vegtyp ,ist ,ice ,nsoil , & !in albgrd ,albgri ,albd ,albi ,fabd , & !out fabi ,ftdd ,ftid ,ftii ,fsun , & !) !out frevi ,frevd ,fregd ,fregi ,bgap , & !inout - wgap) + wgap ,albsnd ,albsni ) ! surface radiation @@ -2497,7 +2665,7 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in albgrd ,albgri ,albd ,albi ,fabd , & !out fabi ,ftdd ,ftid ,ftii ,fsun , & !out frevi ,frevd ,fregd ,fregi ,bgap , & !out - wgap) + wgap ,albsnd ,albsni ) ! -------------------------------------------------------------------------------------------------- ! surface albedos. also fluxes (per unit incoming direct and diffuse @@ -2515,67 +2683,67 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in integer, intent(in) :: ist !surface type integer, intent(in) :: ice !ice (ice = 1) - real, intent(in) :: dt !time step [sec] - real, intent(in) :: qsnow !snowfall - real, intent(in) :: cosz !cosine solar zenith angle for next time step - real, intent(in) :: snowh !snow height (mm) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: elai !lai, one-sided, adjusted for burying by snow - real, intent(in) :: esai !sai, one-sided, adjusted for burying by snow - real, intent(in) :: fsno !fraction of grid covered by snow - real, intent(in) :: fwet !fraction of canopy that is wet - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow mass (mm) - real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] - real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water (m3/m3) + real (kind=kind_phys), intent(in) :: dt !time step [sec] + real (kind=kind_phys), intent(in) :: qsnow !snowfall + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle for next time step + real (kind=kind_phys), intent(in) :: snowh !snow height (mm) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: elai !lai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: esai !sai, one-sided, adjusted for burying by snow + real (kind=kind_phys), intent(in) :: fsno !fraction of grid covered by snow + real (kind=kind_phys), intent(in) :: fwet !fraction of canopy that is wet + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow mass (mm) + real (kind=kind_phys), intent(in) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc !volumetric soil water (m3/m3) ! inout - real, intent(inout) :: albold !snow albedo at last time step (class type) - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: albold !snow albedo at last time step (class type) + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age ! output - real, dimension(1: 2), intent(out) :: albgrd !ground albedo (direct) - real, dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse) - real, dimension(1: 2), intent(out) :: albd !surface albedo (direct) - real, dimension(1: 2), intent(out) :: albi !surface albedo (diffuse) - real, dimension(1: 2), intent(out) :: fabd !flux abs by veg (per unit direct flux) - real, dimension(1: 2), intent(out) :: fabi !flux abs by veg (per unit diffuse flux) - real, dimension(1: 2), intent(out) :: ftdd !down direct flux below veg (per unit dir flux) - real, dimension(1: 2), intent(out) :: ftid !down diffuse flux below veg (per unit dir flux) - real, dimension(1: 2), intent(out) :: ftii !down diffuse flux below veg (per unit dif flux) - real, intent(out) :: fsun !sunlit fraction of canopy (-) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgrd !ground albedo (direct) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albd !surface albedo (direct) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albi !surface albedo (diffuse) + real (kind=kind_phys), dimension(1: 2), intent(out) :: fabd !flux abs by veg (per unit direct flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: fabi !flux abs by veg (per unit diffuse flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: ftdd !down direct flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: ftid !down diffuse flux below veg (per unit dir flux) + real (kind=kind_phys), dimension(1: 2), intent(out) :: ftii !down diffuse flux below veg (per unit dif flux) + real (kind=kind_phys), intent(out) :: fsun !sunlit fraction of canopy (-) !jref:start - real, dimension(1: 2), intent(out) :: frevd - real, dimension(1: 2), intent(out) :: frevi - real, dimension(1: 2), intent(out) :: fregd - real, dimension(1: 2), intent(out) :: fregi - real, intent(out) :: bgap - real, intent(out) :: wgap + real (kind=kind_phys), dimension(1: 2), intent(out) :: frevd + real (kind=kind_phys), dimension(1: 2), intent(out) :: frevi + real (kind=kind_phys), dimension(1: 2), intent(out) :: fregd + real (kind=kind_phys), dimension(1: 2), intent(out) :: fregi + real (kind=kind_phys), intent(out) :: bgap + real (kind=kind_phys), intent(out) :: wgap !jref:end ! ------------------------------------------------------------------------ ! ------------------------ local variables ------------------------------- ! local - real :: fage !snow age function - real :: alb + real (kind=kind_phys) :: fage !snow age function + real (kind=kind_phys) :: alb integer :: ib !indices integer :: nband !number of solar radiation wave bands integer :: ic !direct beam: ic=0; diffuse: ic=1 - real :: wl !fraction of lai+sai that is lai - real :: ws !fraction of lai+sai that is sai - real :: mpe !prevents overflow for division by zero + real (kind=kind_phys) :: wl !fraction of lai+sai that is lai + real (kind=kind_phys) :: ws !fraction of lai+sai that is sai + real (kind=kind_phys) :: mpe !prevents overflow for division by zero - real, dimension(1:2) :: rho !leaf/stem reflectance weighted by fraction lai and sai - real, dimension(1:2) :: tau !leaf/stem transmittance weighted by fraction lai and sai - real, dimension(1:2) :: ftdi !down direct flux below veg per unit dif flux = 0 - real, dimension(1:2) :: albsnd !snow albedo (direct) - real, dimension(1:2) :: albsni !snow albedo (diffuse) + real (kind=kind_phys), dimension(1:2) :: rho !leaf/stem reflectance weighted by fraction lai and sai + real (kind=kind_phys), dimension(1:2) :: tau !leaf/stem transmittance weighted by fraction lai and sai + real (kind=kind_phys), dimension(1:2) :: ftdi !down direct flux below veg per unit dif flux = 0 + real (kind=kind_phys), dimension(1:2) :: albsnd !snow albedo (direct) + real (kind=kind_phys), dimension(1:2) :: albsni !snow albedo (diffuse) - real :: vai !elai+esai - real :: gdir !average projected leaf/stem area in solar direction - real :: ext !optical depth direct beam per unit leaf + stem area + real (kind=kind_phys) :: vai !elai+esai + real (kind=kind_phys) :: gdir !average projected leaf/stem area in solar direction + real (kind=kind_phys) :: ext !optical depth direct beam per unit leaf + stem area ! -------------------------------------------------------------------------------------------------- @@ -2591,6 +2759,8 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in albi(ib) = 0. albgrd(ib) = 0. albgri(ib) = 0. + albsnd(ib) = 0. + albsni(ib) = 0. fabd(ib) = 0. fabi(ib) = 0. ftdd(ib) = 0. @@ -2688,55 +2858,55 @@ subroutine surrad (parameters,mpe ,fsun ,fsha ,elai ,vai , & !i type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: iloc integer, intent(in) :: jloc - real, intent(in) :: mpe !prevents underflow errors if division by zero - - real, intent(in) :: fsun !sunlit fraction of canopy - real, intent(in) :: fsha !shaded fraction of canopy - real, intent(in) :: elai !leaf area, one-sided - real, intent(in) :: vai !leaf + stem area, one-sided - real, intent(in) :: laisun !sunlit leaf area index, one-sided - real, intent(in) :: laisha !shaded leaf area index, one-sided - - real, dimension(1:2), intent(in) :: solad !incoming direct solar radiation (w/m2) - real, dimension(1:2), intent(in) :: solai !incoming diffuse solar radiation (w/m2) - real, dimension(1:2), intent(in) :: fabd !flux abs by veg (per unit incoming direct flux) - real, dimension(1:2), intent(in) :: fabi !flux abs by veg (per unit incoming diffuse flux) - real, dimension(1:2), intent(in) :: ftdd !down dir flux below veg (per incoming dir flux) - real, dimension(1:2), intent(in) :: ftid !down dif flux below veg (per incoming dir flux) - real, dimension(1:2), intent(in) :: ftii !down dif flux below veg (per incoming dif flux) - real, dimension(1:2), intent(in) :: albgrd !ground albedo (direct) - real, dimension(1:2), intent(in) :: albgri !ground albedo (diffuse) - real, dimension(1:2), intent(in) :: albd !overall surface albedo (direct) - real, dimension(1:2), intent(in) :: albi !overall surface albedo (diffuse) - - real, dimension(1:2), intent(in) :: frevd !overall surface albedo veg (direct) - real, dimension(1:2), intent(in) :: frevi !overall surface albedo veg (diffuse) - real, dimension(1:2), intent(in) :: fregd !overall surface albedo grd (direct) - real, dimension(1:2), intent(in) :: fregi !overall surface albedo grd (diffuse) + real (kind=kind_phys), intent(in) :: mpe !prevents underflow errors if division by zero + + real (kind=kind_phys), intent(in) :: fsun !sunlit fraction of canopy + real (kind=kind_phys), intent(in) :: fsha !shaded fraction of canopy + real (kind=kind_phys), intent(in) :: elai !leaf area, one-sided + real (kind=kind_phys), intent(in) :: vai !leaf + stem area, one-sided + real (kind=kind_phys), intent(in) :: laisun !sunlit leaf area index, one-sided + real (kind=kind_phys), intent(in) :: laisha !shaded leaf area index, one-sided + + real (kind=kind_phys), dimension(1:2), intent(in) :: solad !incoming direct solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2), intent(in) :: solai !incoming diffuse solar radiation (w/m2) + real (kind=kind_phys), dimension(1:2), intent(in) :: fabd !flux abs by veg (per unit incoming direct flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: fabi !flux abs by veg (per unit incoming diffuse flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: ftdd !down dir flux below veg (per incoming dir flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: ftid !down dif flux below veg (per incoming dir flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: ftii !down dif flux below veg (per incoming dif flux) + real (kind=kind_phys), dimension(1:2), intent(in) :: albgrd !ground albedo (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: albgri !ground albedo (diffuse) + real (kind=kind_phys), dimension(1:2), intent(in) :: albd !overall surface albedo (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: albi !overall surface albedo (diffuse) + + real (kind=kind_phys), dimension(1:2), intent(in) :: frevd !overall surface albedo veg (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: frevi !overall surface albedo veg (diffuse) + real (kind=kind_phys), dimension(1:2), intent(in) :: fregd !overall surface albedo grd (direct) + real (kind=kind_phys), dimension(1:2), intent(in) :: fregi !overall surface albedo grd (diffuse) ! output - real, intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) - real, intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) - real, intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) - real, intent(out) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(out) :: fsa !total absorbed solar radiation (w/m2) - real, intent(out) :: fsr !total reflected solar radiation (w/m2) - real, intent(out) :: fsrv !reflected solar radiation by vegetation - real, intent(out) :: fsrg !reflected solar radiation by ground + real (kind=kind_phys), intent(out) :: parsun !average absorbed par for sunlit leaves (w/m2) + real (kind=kind_phys), intent(out) :: parsha !average absorbed par for shaded leaves (w/m2) + real (kind=kind_phys), intent(out) :: sav !solar radiation absorbed by vegetation (w/m2) + real (kind=kind_phys), intent(out) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(out) :: fsa !total absorbed solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsr !total reflected solar radiation (w/m2) + real (kind=kind_phys), intent(out) :: fsrv !reflected solar radiation by vegetation + real (kind=kind_phys), intent(out) :: fsrg !reflected solar radiation by ground ! ------------------------ local variables ---------------------------------------------------- integer :: ib !waveband number (1=vis, 2=nir) integer :: nband !number of solar radiation waveband classes - real :: abs !absorbed solar radiation (w/m2) - real :: rnir !reflected solar radiation [nir] (w/m2) - real :: rvis !reflected solar radiation [vis] (w/m2) - real :: laifra !leaf area fraction of canopy - real :: trd !transmitted solar radiation: direct (w/m2) - real :: tri !transmitted solar radiation: diffuse (w/m2) - real, dimension(1:2) :: cad !direct beam absorbed by canopy (w/m2) - real, dimension(1:2) :: cai !diffuse radiation absorbed by canopy (w/m2) + real (kind=kind_phys) :: abs !absorbed solar radiation (w/m2) + real (kind=kind_phys) :: rnir !reflected solar radiation [nir] (w/m2) + real (kind=kind_phys) :: rvis !reflected solar radiation [vis] (w/m2) + real (kind=kind_phys) :: laifra !leaf area fraction of canopy + real (kind=kind_phys) :: trd !transmitted solar radiation: direct (w/m2) + real (kind=kind_phys) :: tri !transmitted solar radiation: diffuse (w/m2) + real (kind=kind_phys), dimension(1:2) :: cad !direct beam absorbed by canopy (w/m2) + real (kind=kind_phys), dimension(1:2) :: cai !diffuse radiation absorbed by canopy (w/m2) ! --------------------------------------------------------------------------------------------- nband = 2 @@ -2805,39 +2975,37 @@ subroutine snow_age (parameters,dt,tg,sneqvo,sneqv,tauss,fage) ! ------------------------ input/output variables -------------------------------------------------- !input type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: dt !main time step (s) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: sneqvo !snow mass at last time step(mm) - real, intent(in) :: sneqv !snow water per unit ground area (mm) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: sneqvo !snow mass at last time step(mm) + real (kind=kind_phys), intent(in) :: sneqv !snow water per unit ground area (mm) !output - real, intent(out) :: fage !snow age + real (kind=kind_phys), intent(out) :: fage !snow age !input/output - real, intent(inout) :: tauss !non-dimensional snow age + real (kind=kind_phys), intent(inout) :: tauss !non-dimensional snow age !local - real :: tage !total aging effects - real :: age1 !effects of grain growth due to vapor diffusion - real :: age2 !effects of grain growth at freezing of melt water - real :: age3 !effects of soot - real :: dela !temporary variable - real :: sge !temporary variable - real :: dels !temporary variable - real :: dela0 !temporary variable - real :: arg !temporary variable + real (kind=kind_phys) :: tage !total aging effects + real (kind=kind_phys) :: age1 !effects of grain growth due to vapor diffusion + real (kind=kind_phys) :: age2 !effects of grain growth at freezing of melt water + real (kind=kind_phys) :: age3 !effects of soot + real (kind=kind_phys) :: dela !temporary variable + real (kind=kind_phys) :: sge !temporary variable + real (kind=kind_phys) :: dels !temporary variable + real (kind=kind_phys) :: dela0 !temporary variable + real (kind=kind_phys) :: arg !temporary variable ! see yang et al. (1997) j.of climate for detail. !--------------------------------------------------------------------------------------------------- if(sneqv.le.0.0) then tauss = 0. - else if (sneqv.gt.800.) then - tauss = 0. else - dela0 = 1.e-6*dt - arg = 5.e3*(1./tfrz-1./tg) + dela0 = dt/parameters%tau0 + arg = parameters%grain_growth*(1./tfrz-1./tg) age1 = exp(arg) - age2 = exp(amin1(0.,10.*arg)) - age3 = 0.3 + age2 = exp(amin1(0.,parameters%extra_growth*arg)) + age3 = parameters%dirt_soot tage = age1+age2+age3 dela = dela0*tage dels = amax1(0.0,sneqv-sneqvo) / parameters%swemx @@ -2861,28 +3029,28 @@ subroutine snowalb_bats (parameters,nband,fsno,cosz,fage,albsnd,albsni) type (noahmp_parameters), intent(in) :: parameters integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: cosz !cosine solar zenith angle - real,intent(in) :: fsno !snow cover fraction (-) - real,intent(in) :: fage !snow age correction + real (kind=kind_phys),intent(in) :: cosz !cosine solar zenith angle + real (kind=kind_phys),intent(in) :: fsno !snow cover fraction (-) + real (kind=kind_phys),intent(in) :: fage !snow age correction ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- ! ------------------------ local variables ---------------------------------------------------- integer :: ib !waveband class - real :: fzen !zenith angle correction - real :: cf1 !temperary variable - real :: sl2 !2.*sl - real :: sl1 !1/sl - real :: sl !adjustable parameter - real, parameter :: c1 = 0.2 !default in bats - real, parameter :: c2 = 0.5 !default in bats -! real, parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's -! real, parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) + real (kind=kind_phys) :: fzen !zenith angle correction + real (kind=kind_phys) :: cf1 !temperary variable + real (kind=kind_phys) :: sl2 !2.*sl + real (kind=kind_phys) :: sl1 !1/sl + real (kind=kind_phys) :: sl !adjustable parameter +! real (kind=kind_phys), parameter :: c1 = 0.2 !default in bats +! real (kind=kind_phys), parameter :: c2 = 0.5 !default in bats +! real (kind=kind_phys), parameter :: c1 = 0.2 * 2. ! double the default to match sleepers river's +! real (kind=kind_phys), parameter :: c2 = 0.5 * 2. ! snow surface albedo (double aging effects) ! --------------------------------------------------------------------------------------------- ! zero albedos for all points @@ -2891,17 +3059,17 @@ subroutine snowalb_bats (parameters,nband,fsno,cosz,fage,albsnd,albsni) ! when cosz > 0 - sl=2.0 + sl=parameters%bats_cosz sl1=1./sl sl2=2.*sl cf1=((1.+sl1)/(1.+sl2*cosz)-sl1) fzen=amax1(cf1,0.) - albsni(1)=0.95*(1.-c1*fage) - albsni(2)=0.65*(1.-c2*fage) + albsni(1)=parameters%bats_vis_new*(1.-parameters%bats_vis_age*fage) + albsni(2)=parameters%bats_nir_new*(1.-parameters%bats_nir_age*fage) - albsnd(1)=albsni(1)+0.4*fzen*(1.-albsni(1)) ! vis direct - albsnd(2)=albsni(2)+0.4*fzen*(1.-albsni(2)) ! nir direct + albsnd(1)=albsni(1)+parameters%bats_vis_dir*fzen*(1.-albsni(1)) ! vis direct + albsnd(2)=albsni(2)+parameters%bats_vis_dir*fzen*(1.-albsni(2)) ! nir direct end subroutine snowalb_bats @@ -2919,17 +3087,17 @@ subroutine snowalb_class (parameters,nband,qsnow,dt,alb,albold,albsnd,albsni,ilo integer,intent(in) :: jloc !grid index integer,intent(in) :: nband !number of waveband classes - real,intent(in) :: qsnow !snowfall (mm/s) - real,intent(in) :: dt !time step (sec) - real,intent(in) :: albold !snow albedo at last time step + real (kind=kind_phys),intent(in) :: qsnow !snowfall (mm/s) + real (kind=kind_phys),intent(in) :: dt !time step (sec) + real (kind=kind_phys),intent(in) :: albold !snow albedo at last time step ! in & out - real, intent(inout) :: alb ! + real (kind=kind_phys), intent(inout) :: alb ! ! output - real, dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) - real, dimension(1:2),intent(out) :: albsni !snow albedo for diffuse + real (kind=kind_phys), dimension(1:2),intent(out) :: albsnd !snow albedo for direct(1=vis, 2=nir) + real (kind=kind_phys), dimension(1:2),intent(out) :: albsni !snow albedo for diffuse ! --------------------------------------------------------------------------------------------- ! ------------------------ local variables ---------------------------------------------------- @@ -2978,24 +3146,24 @@ subroutine groundalb (parameters,nsoil ,nband ,ice ,ist , & !in integer, intent(in) :: nband !number of solar radiation waveband classes integer, intent(in) :: ice !value of ist for land ice integer, intent(in) :: ist !surface type - real, intent(in) :: fsno !fraction of surface covered with snow (-) - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: cosz !cosine solar zenith angle (0-1) - real, dimension(1:nsoil), intent(in) :: smc !volumetric soil water content (m3/m3) - real, dimension(1: 2), intent(in) :: albsnd !direct beam snow albedo (vis, nir) - real, dimension(1: 2), intent(in) :: albsni !diffuse snow albedo (vis, nir) + real (kind=kind_phys), intent(in) :: fsno !fraction of surface covered with snow (-) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: cosz !cosine solar zenith angle (0-1) + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc !volumetric soil water content (m3/m3) + real (kind=kind_phys), dimension(1: 2), intent(in) :: albsnd !direct beam snow albedo (vis, nir) + real (kind=kind_phys), dimension(1: 2), intent(in) :: albsni !diffuse snow albedo (vis, nir) !output - real, dimension(1: 2), intent(out) :: albgrd !ground albedo (direct beam: vis, nir) - real, dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse: vis, nir) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgrd !ground albedo (direct beam: vis, nir) + real (kind=kind_phys), dimension(1: 2), intent(out) :: albgri !ground albedo (diffuse: vis, nir) !local integer :: ib !waveband number (1=vis, 2=nir) - real :: inc !soil water correction factor for soil albedo - real :: albsod !soil albedo (direct) - real :: albsoi !soil albedo (diffuse) + real (kind=kind_phys) :: inc !soil water correction factor for soil albedo + real (kind=kind_phys) :: albsod !soil albedo (direct) + real (kind=kind_phys) :: albsoi !soil albedo (diffuse) ! -------------------------------------------------------------------------------------------------- do ib = 1, nband @@ -3052,68 +3220,68 @@ subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & ! integer, intent(in) :: ic !0=unit incoming direct; 1=unit incoming diffuse integer, intent(in) :: vegtyp !vegetation type - real, intent(in) :: cosz !cosine of direct zenith angle (0-1) - real, intent(in) :: vai !one-sided leaf+stem area index (m2/m2) - real, intent(in) :: fwet !fraction of lai, sai that is wetted (-) - real, intent(in) :: t !surface temperature (k) + real (kind=kind_phys), intent(in) :: cosz !cosine of direct zenith angle (0-1) + real (kind=kind_phys), intent(in) :: vai !one-sided leaf+stem area index (m2/m2) + real (kind=kind_phys), intent(in) :: fwet !fraction of lai, sai that is wetted (-) + real (kind=kind_phys), intent(in) :: t !surface temperature (k) - real, dimension(1:2), intent(in) :: albgrd !direct albedo of underlying surface (-) - real, dimension(1:2), intent(in) :: albgri !diffuse albedo of underlying surface (-) - real, dimension(1:2), intent(in) :: rho !leaf+stem reflectance - real, dimension(1:2), intent(in) :: tau !leaf+stem transmittance - real, intent(in) :: fveg !green vegetation fraction [0.0-1.0] + real (kind=kind_phys), dimension(1:2), intent(in) :: albgrd !direct albedo of underlying surface (-) + real (kind=kind_phys), dimension(1:2), intent(in) :: albgri !diffuse albedo of underlying surface (-) + real (kind=kind_phys), dimension(1:2), intent(in) :: rho !leaf+stem reflectance + real (kind=kind_phys), dimension(1:2), intent(in) :: tau !leaf+stem transmittance + real (kind=kind_phys), intent(in) :: fveg !green vegetation fraction [0.0-1.0] ! output - real, dimension(1:2), intent(out) :: fab !flux abs by veg layer (per unit incoming flux) - real, dimension(1:2), intent(out) :: fre !flux refl above veg layer (per unit incoming flux) - real, dimension(1:2), intent(out) :: ftd !down dir flux below veg layer (per unit in flux) - real, dimension(1:2), intent(out) :: fti !down dif flux below veg layer (per unit in flux) - real, intent(out) :: gdir !projected leaf+stem area in solar direction - real, dimension(1:2), intent(out) :: frev !flux reflected by veg layer (per unit incoming flux) - real, dimension(1:2), intent(out) :: freg !flux reflected by ground (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: fab !flux abs by veg layer (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: fre !flux refl above veg layer (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: ftd !down dir flux below veg layer (per unit in flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: fti !down dif flux below veg layer (per unit in flux) + real (kind=kind_phys), intent(out) :: gdir !projected leaf+stem area in solar direction + real (kind=kind_phys), dimension(1:2), intent(out) :: frev !flux reflected by veg layer (per unit incoming flux) + real (kind=kind_phys), dimension(1:2), intent(out) :: freg !flux reflected by ground (per unit incoming flux) ! local - real :: omega !fraction of intercepted radiation that is scattered - real :: omegal !omega for leaves - real :: betai !upscatter parameter for diffuse radiation - real :: betail !betai for leaves - real :: betad !upscatter parameter for direct beam radiation - real :: betadl !betad for leaves - real :: ext !optical depth of direct beam per unit leaf area - real :: avmu !average diffuse optical depth - - real :: coszi !0.001 <= cosz <= 1.000 - real :: asu !single scattering albedo - real :: chil ! -0.4 <= xl <= 0.6 - - real :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 - real :: p1,p2,p3,p4,s1,s2,u1,u2,u3 - real :: b,c,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 - real :: phi1,phi2,sigma - real :: ftds,ftis,fres - real :: denfveg - real :: vai_spread + real (kind=kind_phys) :: omega !fraction of intercepted radiation that is scattered + real (kind=kind_phys) :: omegal !omega for leaves + real (kind=kind_phys) :: betai !upscatter parameter for diffuse radiation + real (kind=kind_phys) :: betail !betai for leaves + real (kind=kind_phys) :: betad !upscatter parameter for direct beam radiation + real (kind=kind_phys) :: betadl !betad for leaves + real (kind=kind_phys) :: ext !optical depth of direct beam per unit leaf area + real (kind=kind_phys) :: avmu !average diffuse optical depth + + real (kind=kind_phys) :: coszi !0.001 <= cosz <= 1.000 + real (kind=kind_phys) :: asu !single scattering albedo + real (kind=kind_phys) :: chil ! -0.4 <= xl <= 0.6 + + real (kind=kind_phys) :: tmp0,tmp1,tmp2,tmp3,tmp4,tmp5,tmp6,tmp7,tmp8,tmp9 + real (kind=kind_phys) :: p1,p2,p3,p4,s1,s2,u1,u2,u3 + real (kind=kind_phys) :: b,c,d,d1,d2,f,h,h1,h2,h3,h4,h5,h6,h7,h8,h9,h10 + real (kind=kind_phys) :: phi1,phi2,sigma + real (kind=kind_phys) :: ftds,ftis,fres + real (kind=kind_phys) :: denfveg + real (kind=kind_phys) :: vai_spread !jref:start - real :: freveg,frebar,ftdveg,ftiveg,ftdbar,ftibar - real :: thetaz + real (kind=kind_phys) :: freveg,frebar,ftdveg,ftiveg,ftdbar,ftibar + real (kind=kind_phys) :: thetaz !jref:end ! variables for the modified two-stream scheme ! niu and yang (2004), jgr - real, parameter :: pai = 3.14159265 - real :: hd !crown depth (m) - real :: bb !vertical crown radius (m) - real :: thetap !angle conversion from sza - real :: fa !foliage volume density (m-1) - real :: newvai !effective lsai (-) + real (kind=kind_phys), parameter :: pai = 3.14159265 + real (kind=kind_phys) :: hd !crown depth (m) + real (kind=kind_phys) :: bb !vertical crown radius (m) + real (kind=kind_phys) :: thetap !angle conversion from sza + real (kind=kind_phys) :: fa !foliage volume density (m-1) + real (kind=kind_phys) :: newvai !effective lsai (-) - real,intent(inout) :: bgap !between canopy gap fraction for beam (-) - real,intent(inout) :: wgap !within canopy gap fraction for beam (-) + real (kind=kind_phys),intent(inout) :: bgap !between canopy gap fraction for beam (-) + real (kind=kind_phys),intent(inout) :: wgap !within canopy gap fraction for beam (-) - real :: kopen !gap fraction for diffue light (-) - real :: gap !total gap fraction for beam ( <=1-shafac ) + real (kind=kind_phys) :: kopen !gap fraction for diffue light (-) + real (kind=kind_phys) :: gap !total gap fraction for beam ( <=1-shafac ) ! ----------------------------------------------------------------- ! compute within and between gaps @@ -3283,7 +3451,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & uu ,vv ,sfctmp ,thair ,qair , & !in eair ,rhoair ,snowh ,vai ,gammav ,gammag, & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -3320,74 +3488,73 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & integer, intent(in) :: nsoil !number of soil layers integer, intent(in) :: isnow !actual no. of snow layers integer, intent(in) :: vegtyp !vegetation physiology type - real, intent(in) :: fveg !greeness vegetation fraction (-) - real, intent(in) :: sav !solar rad absorbed by veg (w/m2) - real, intent(in) :: sag !solar rad absorbed by ground (w/m2) - real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) - real, intent(in) :: ur !wind speed at height zlvl (m/s) - real, intent(in) :: uu !wind speed in eastward dir (m/s) - real, intent(in) :: vv !wind speed in northward dir (m/s) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: thair !potential temp at reference height (k) - real, intent(in) :: eair !vapor pressure air at zlvl (pa) - real, intent(in) :: qair !specific humidity at zlvl (kg/kg) - real, intent(in) :: rhoair !density air (kg/m**3) - real, intent(in) :: dt !time step (s) - real, intent(in) :: fsno !snow fraction - - real, intent(in) :: snowh !actual snow depth [m] - real, intent(in) :: fwet !wetted fraction of canopy - real, intent(in) :: cwp !canopy wind parameter - - real, intent(in) :: vai !total leaf area index + stem area index - real, intent(in) :: laisun !sunlit leaf area index, one-sided (m2/m2) - real, intent(in) :: laisha !shaded leaf area index, one-sided (m2/m2) - real, intent(in) :: zlvl !reference height (m) - - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0m !roughness length, momentum (m) - real, intent(in) :: z0mg !roughness length, momentum, ground (m) - real, intent(in) :: emv !vegetation emissivity - real, intent(in) :: emg !ground emissivity - - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thinkness of snow/soil layers (m) - real, intent(in) :: canliq !intercepted liquid water (mm) - real, intent(in) :: canice !intercepted ice mass (mm) - real, intent(in) :: rsurf !ground surface resistance (s/m) -! real, intent(in) :: gamma !psychrometric constant (pa/k) -! real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) - real, intent(in) :: gammav !psychrometric constant (pa/k) - real, intent(in) :: latheav !latent heat of vaporization/subli (j/kg) - real, intent(in) :: gammag !psychrometric constant (pa/k) - real, intent(in) :: latheag !latent heat of vaporization/subli (j/kg) - real, intent(in) :: parsun !par absorbed per unit sunlit lai (w/m2) - real, intent(in) :: parsha !par absorbed per unit shaded lai (w/m2) - real, intent(in) :: foln !foliage nitrogen (%) - real, intent(in) :: co2air !atmospheric co2 concentration (pa) - real, intent(in) :: o2air !atmospheric o2 concentration (pa) - real, intent(in) :: igs !growing season index (0=off, 1=on) - real, intent(in) :: sfcprs !pressure (pa) - real, intent(in) :: btran !soil water transpiration factor (0 to 1) - real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) - - real , intent(in) :: qc !cloud water mixing ratio - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: dx !grid spacing - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: dz8w !thickness of lowest layer - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real, intent(in) :: pahv !precipitation advected heat - canopy net in (w/m2) - real, intent(in) :: pahg !precipitation advected heat - ground net in (w/m2) + real (kind=kind_phys), intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys), intent(in) :: sav !solar rad absorbed by veg (w/m2) + real (kind=kind_phys), intent(in) :: sag !solar rad absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real (kind=kind_phys), intent(in) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys), intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys), intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: thair !potential temp at reference height (k) + real (kind=kind_phys), intent(in) :: eair !vapor pressure air at zlvl (pa) + real (kind=kind_phys), intent(in) :: qair !specific humidity at zlvl (kg/kg) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m**3) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: fsno !snow fraction + + real (kind=kind_phys), intent(in) :: snowh !actual snow depth [m] + real (kind=kind_phys), intent(in) :: fwet !wetted fraction of canopy + real (kind=kind_phys), intent(in) :: cwp !canopy wind parameter + + real (kind=kind_phys), intent(in) :: vai !total leaf area index + stem area index + real (kind=kind_phys), intent(in) :: laisun !sunlit leaf area index, one-sided (m2/m2) + real (kind=kind_phys), intent(in) :: laisha !shaded leaf area index, one-sided (m2/m2) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum (m) + real (kind=kind_phys), intent(in) :: z0mg !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: emv !vegetation emissivity + real (kind=kind_phys), intent(in) :: emg !ground emissivity + + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thinkness of snow/soil layers (m) + real (kind=kind_phys), intent(in) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(in) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(in) :: rsurf !ground surface resistance (s/m) +! real (kind=kind_phys), intent(in) :: gamma !psychrometric constant (pa/k) +! real (kind=kind_phys), intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: gammav !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: latheav !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: gammag !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: latheag !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: parsun !par absorbed per unit sunlit lai (w/m2) + real (kind=kind_phys), intent(in) :: parsha !par absorbed per unit shaded lai (w/m2) + real (kind=kind_phys), intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys), intent(in) :: co2air !atmospheric co2 concentration (pa) + real (kind=kind_phys), intent(in) :: o2air !atmospheric o2 concentration (pa) + real (kind=kind_phys), intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys), intent(in) :: sfcprs !pressure (pa) + real (kind=kind_phys), intent(in) :: btran !soil water transpiration factor (0 to 1) + real (kind=kind_phys), intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dx !grid spacing + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys), intent(in) :: pahv !precipitation advected heat - canopy net in (w/m2) + real (kind=kind_phys), intent(in) :: pahg !precipitation advected heat - ground net in (w/m2) ! input/output - real, intent(inout) :: eah !canopy air vapor pressure (pa) - real, intent(inout) :: tah !canopy air temperature (k) - real, intent(inout) :: tv !vegetation temperature (k) - real, intent(inout) :: tg !ground temperature (k) - real, intent(inout) :: cm !momentum drag coefficient - real, intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: eah !canopy air vapor pressure (pa) + real (kind=kind_phys), intent(inout) :: tah !canopy air temperature (k) + real (kind=kind_phys), intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(inout) :: tg !ground temperature (k) + real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient #ifdef CCPP character(len=*), intent(inout) :: errmsg @@ -3396,107 +3563,106 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! output ! -fsa + fira + fsh + (fcev + fctr + fgev) + fcst + ssoil = 0 - real, intent(out) :: tauxv !wind stress: e-w (n/m2) - real, intent(out) :: tauyv !wind stress: n-s (n/m2) - real, intent(out) :: irc !net longwave radiation (w/m2) [+= to atm] - real, intent(out) :: shc !sensible heat flux (w/m2) [+= to atm] - real, intent(out) :: evc !evaporation heat flux (w/m2) [+= to atm] - real, intent(out) :: irg !net longwave radiation (w/m2) [+= to atm] - real, intent(out) :: shg !sensible heat flux (w/m2) [+= to atm] - real, intent(out) :: evg !evaporation heat flux (w/m2) [+= to atm] - real, intent(out) :: tr !transpiration heat flux (w/m2)[+= to atm] - real, intent(out) :: gh !ground heat (w/m2) [+ = to soil] - real, intent(out) :: t2mv !2 m height air temperature (k) - real, intent(out) :: psnsun !sunlit leaf photosynthesis (umolco2/m2/s) - real, intent(out) :: psnsha !shaded leaf photosynthesis (umolco2/m2/s) - real, intent(out) :: chleaf !leaf exchange coefficient - real, intent(out) :: chuc !under canopy exchange coefficient - - real, intent(out) :: q2v - real :: cah !sensible heat conductance, canopy air to zlvl air (m/s) - real :: u10v !10 m wind speed in eastward dir (m/s) - real :: v10v !10 m wind speed in eastward dir (m/s) - real :: wspd + real (kind=kind_phys), intent(out) :: tauxv !wind stress: e-w (n/m2) + real (kind=kind_phys), intent(out) :: tauyv !wind stress: n-s (n/m2) + real (kind=kind_phys), intent(out) :: irc !net longwave radiation (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: shc !sensible heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: evc !evaporation heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: irg !net longwave radiation (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: shg !sensible heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: evg !evaporation heat flux (w/m2) [+= to atm] + real (kind=kind_phys), intent(out) :: tr !transpiration heat flux (w/m2)[+= to atm] + real (kind=kind_phys), intent(out) :: gh !ground heat (w/m2) [+ = to soil] + real (kind=kind_phys), intent(out) :: t2mv !2 m height air temperature (k) + real (kind=kind_phys), intent(out) :: psnsun !sunlit leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys), intent(out) :: psnsha !shaded leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys), intent(out) :: chleaf !leaf exchange coefficient + real (kind=kind_phys), intent(out) :: chuc !under canopy exchange coefficient + + real (kind=kind_phys), intent(out) :: q2v + real (kind=kind_phys) :: cah !sensible heat conductance, canopy air to zlvl air (m/s) + real (kind=kind_phys) :: u10v !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: v10v !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: wspd ! ------------------------ local variables ---------------------------------------------------- - real :: cw !water vapor exchange coefficient - real :: fv !friction velocity (m/s) - real :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) - real :: z0h !roughness length, sensible heat (m) - real :: z0hg !roughness length, sensible heat (m) - real :: rb !bulk leaf boundary layer resistance (s/m) - real :: ramc !aerodynamic resistance for momentum (s/m) - real :: rahc !aerodynamic resistance for sensible heat (s/m) - real :: rawc !aerodynamic resistance for water vapor (s/m) - real :: ramg !aerodynamic resistance for momentum (s/m) - real :: rahg !aerodynamic resistance for sensible heat (s/m) - real :: rawg !aerodynamic resistance for water vapor (s/m) - - real, intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) - real, intent(out) :: rssha !shaded leaf stomatal resistance (s/m) - - real :: mol !monin-obukhov length (m) - real :: dtv !change in tv, last iteration (k) - real :: dtg !change in tg, last iteration (k) - - real :: air,cir !coefficients for ir as function of ts**4 - real :: csh !coefficients for sh as function of ts - real :: cev !coefficients for ev as function of esat[ts] - real :: cgh !coefficients for st as function of ts - real :: atr,ctr !coefficients for tr as function of esat[ts] - real :: ata,bta !coefficients for tah as function of ts - real :: aea,bea !coefficients for eah as function of esat[ts] - - real :: estv !saturation vapor pressure at tv (pa) - real :: estg !saturation vapor pressure at tg (pa) - real :: destv !d(es)/dt at ts (pa/k) - real :: destg !d(es)/dt at tg (pa/k) - real :: esatw !es for water - real :: esati !es for ice - real :: dsatw !d(es)/dt at tg (pa/k) for water - real :: dsati !d(es)/dt at tg (pa/k) for ice - - real :: fm !momentum stability correction, weighted by prior iters - real :: fh !sen heat stability correction, weighted by prior iters - real :: fhg !sen heat stability correction, ground - real :: hcan !canopy height (m) [note: hcan >= z0mg] - - real :: a !temporary calculation - real :: b !temporary calculation - real :: cvh !sensible heat conductance, leaf surface to canopy air (m/s) - real :: caw !latent heat conductance, canopy air zlvl air (m/s) - real :: ctw !transpiration conductance, leaf to canopy air (m/s) - real :: cew !evaporation conductance, leaf to canopy air (m/s) - real :: cgw !latent heat conductance, ground to canopy air (m/s) - real :: cond !sum of conductances (s/m) - real :: uc !wind speed at top of canopy (m/s) - real :: kh !turbulent transfer coefficient, sensible heat, (m2/s) - real :: h !temporary sensible heat flux (w/m2) - real :: hg !temporary sensible heat flux (w/m2) - - real :: moz !monin-obukhov stability parameter - real :: mozg !monin-obukhov stability parameter - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: fm2 !monin-obukhov momentum adjustment at 2m - real :: fh2 !monin-obukhov heat adjustment at 2m - real :: ch2 !surface exchange at 2m - real :: thstar !surface exchange at 2m - - real :: thvair - real :: thah - real :: rahc2 !aerodynamic resistance for sensible heat (s/m) - real :: rawc2 !aerodynamic resistance for water vapor (s/m) - real, intent(out):: cah2 !sensible heat conductance for diagnostics - real :: ch2v !exchange coefficient for 2m over vegetation. - real :: cq2v !exchange coefficient for 2m over vegetation. - real :: eah2 !2m vapor pressure over canopy - real :: qfx !moisture flux - real :: e1 - - - real :: vaie !total leaf area index + stem area index,effective - real :: laisune !sunlit leaf area index, one-sided (m2/m2),effective - real :: laishae !shaded leaf area index, one-sided (m2/m2),effective + real (kind=kind_phys) :: cw !water vapor exchange coefficient + real (kind=kind_phys) :: fv !friction velocity (m/s) + real (kind=kind_phys) :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) + real (kind=kind_phys) :: z0h !roughness length, sensible heat (m) + real (kind=kind_phys) :: z0hg !roughness length, sensible heat (m) + real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) + real (kind=kind_phys) :: ramc !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahc !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawc !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: ramg !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahg !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawg !aerodynamic resistance for water vapor (s/m) + + real (kind=kind_phys), intent(out) :: rssun !sunlit leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: rssha !shaded leaf stomatal resistance (s/m) + + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: dtv !change in tv, last iteration (k) + real (kind=kind_phys) :: dtg !change in tg, last iteration (k) + + real (kind=kind_phys) :: air,cir !coefficients for ir as function of ts**4 + real (kind=kind_phys) :: csh !coefficients for sh as function of ts + real (kind=kind_phys) :: cev !coefficients for ev as function of esat[ts] + real (kind=kind_phys) :: cgh !coefficients for st as function of ts + real (kind=kind_phys) :: atr,ctr !coefficients for tr as function of esat[ts] + real (kind=kind_phys) :: ata,bta !coefficients for tah as function of ts + real (kind=kind_phys) :: aea,bea !coefficients for eah as function of esat[ts] + + real (kind=kind_phys) :: estv !saturation vapor pressure at tv (pa) + real (kind=kind_phys) :: estg !saturation vapor pressure at tg (pa) + real (kind=kind_phys) :: destv !d(es)/dt at ts (pa/k) + real (kind=kind_phys) :: destg !d(es)/dt at tg (pa/k) + real (kind=kind_phys) :: esatw !es for water + real (kind=kind_phys) :: esati !es for ice + real (kind=kind_phys) :: dsatw !d(es)/dt at tg (pa/k) for water + real (kind=kind_phys) :: dsati !d(es)/dt at tg (pa/k) for ice + + real (kind=kind_phys) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys) :: fhg !sen heat stability correction, ground + real (kind=kind_phys) :: hcan !canopy height (m) [note: hcan >= z0mg] + + real (kind=kind_phys) :: a !temporary calculation + real (kind=kind_phys) :: b !temporary calculation + real (kind=kind_phys) :: cvh !sensible heat conductance, leaf surface to canopy air (m/s) + real (kind=kind_phys) :: caw !latent heat conductance, canopy air zlvl air (m/s) + real (kind=kind_phys) :: ctw !transpiration conductance, leaf to canopy air (m/s) + real (kind=kind_phys) :: cew !evaporation conductance, leaf to canopy air (m/s) + real (kind=kind_phys) :: cgw !latent heat conductance, ground to canopy air (m/s) + real (kind=kind_phys) :: cond !sum of conductances (s/m) + real (kind=kind_phys) :: uc !wind speed at top of canopy (m/s) + real (kind=kind_phys) :: kh !turbulent transfer coefficient, sensible heat, (m2/s) + real (kind=kind_phys) :: h !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: hg !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: moz !monin-obukhov stability parameter + real (kind=kind_phys) :: mozg !monin-obukhov stability parameter + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: fm2 !monin-obukhov momentum adjustment at 2m + real (kind=kind_phys) :: fh2 !monin-obukhov heat adjustment at 2m + real (kind=kind_phys) :: ch2 !surface exchange at 2m + real (kind=kind_phys) :: thstar !surface exchange at 2m + + real (kind=kind_phys) :: thvair + real (kind=kind_phys) :: thah + real (kind=kind_phys) :: rahc2 !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawc2 !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys), intent(out):: cah2 !sensible heat conductance for diagnostics + real (kind=kind_phys) :: ch2v !exchange coefficient for 2m over vegetation. + real (kind=kind_phys) :: cq2v !exchange coefficient for 2m over vegetation. + real (kind=kind_phys) :: eah2 !2m vapor pressure over canopy + real (kind=kind_phys) :: qfx !moisture flux + real (kind=kind_phys) :: e1 + + + real (kind=kind_phys) :: vaie !total leaf area index + stem area index,effective + real (kind=kind_phys) :: laisune !sunlit leaf area index, one-sided (m2/m2),effective + real (kind=kind_phys) :: laishae !shaded leaf area index, one-sided (m2/m2),effective integer :: k !index integer :: iter !iteration index @@ -3506,12 +3672,12 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & !jref - niterg test from 3-5 integer, parameter :: niterg = 5 !number of iterations for ground temperature integer :: mozsgn !number of times moz changes sign - real :: mpe !prevents overflow error if division by zero + real (kind=kind_phys) :: mpe !prevents overflow error if division by zero integer :: liter !last iteration - real :: t, tdc !kelvin to degree celsius with limit -50 to +50 + real (kind=kind_phys) :: t, tdc !kelvin to degree celsius with limit -50 to +50 character(len=80) :: message @@ -3530,18 +3696,16 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & moz = 0. mozsgn = 0 mozold = 0. + fh2 = 0. hg = 0. h = 0. qfx = 0. -! YRQ -! write(*,*) 'tv,tg,stc in input:YRQ', tv,tg,stc +! limit lai -! convert grid-cell lai to the fractional vegetated area (fveg) - - vaie = min(6.,vai / fveg) - laisune = min(6.,laisun / fveg) - laishae = min(6.,laisha / fveg) + vaie = min(6.,vai ) + laisune = min(6.,laisun) + laishae = min(6.,laisha) ! saturation vapor pressure at ground temperature @@ -3603,7 +3767,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & air = -emv*(1.+(1.-emv)*(1.-emg))*lwdn - emv*emg*sb*tg**4 cir = (2.-emv*(1.-emg))*emv*sb - ! --------------------------------------------------------------------------------------------- loop1: do iter = 1, niterc ! begin stability iteration @@ -3624,7 +3787,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & #ifdef CCPP moz ,mozsgn ,fm ,fh ,fm2 ,fh2 ,errmsg ,errflg ,& !inout #else - moz ,mozsgn ,fm ,fh ,fm2 ,fh2 , & !inout + moz ,mozsgn ,fm ,fh ,fm2,fh2, & !inout #endif cm ,ch ,fv ,ch2 ) !out #ifdef CCPP @@ -3765,7 +3928,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & csh = rhoair*cpair/rahg cev = rhoair*cpair / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 cgh = 2.*df(isnow+1)/dzsnso(isnow+1) -! write(*,*)'inside tg=',tg,'stc(1)=',stc(1) loop2: do iter = 1, niterg @@ -3802,7 +3964,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & if(opt_stc == 1 .or. opt_stc == 3) then if (snowh > 0.05 .and. tg > tfrz) then - tg = tfrz + if(opt_stc == 1) tg = tfrz if(opt_stc == 3) tg = (1.-fsno)*tg + fsno*tfrz ! mb: allow tg>0c during melt v3.7 irg = cir*tg**4 - emg*(1.-emv)*lwdn - emg*emv*sb*tv**4 shg = csh * (tg - tah) @@ -3882,47 +4044,47 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !number of soil layers integer, intent(in) :: isnow !actual no. of snow layers - real, intent(in) :: dt !time step (s) - real, intent(in) :: sag !solar radiation absorbed by ground (w/m2) - real, intent(in) :: lwdn !atmospheric longwave radiation (w/m2) - real, intent(in) :: ur !wind speed at height zlvl (m/s) - real, intent(in) :: uu !wind speed in eastward dir (m/s) - real, intent(in) :: vv !wind speed in northward dir (m/s) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: thair !potential temperature at height zlvl (k) - real, intent(in) :: qair !specific humidity at height zlvl (kg/kg) - real, intent(in) :: eair !vapor pressure air at height (pa) - real, intent(in) :: rhoair !density air (kg/m3) - real, intent(in) :: snowh !actual snow depth [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: emg !ground emissivity - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) - real, intent(in) :: rsurf !ground surface resistance (s/m) - real, intent(in) :: lathea !latent heat of vaporization/subli (j/kg) - real, intent(in) :: gamma !psychrometric constant (pa/k) - real, intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) - real, intent(in) :: fsno !snow fraction + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: sag !solar radiation absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: lwdn !atmospheric longwave radiation (w/m2) + real (kind=kind_phys), intent(in) :: ur !wind speed at height zlvl (m/s) + real (kind=kind_phys), intent(in) :: uu !wind speed in eastward dir (m/s) + real (kind=kind_phys), intent(in) :: vv !wind speed in northward dir (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: thair !potential temperature at height zlvl (k) + real (kind=kind_phys), intent(in) :: qair !specific humidity at height zlvl (kg/kg) + real (kind=kind_phys), intent(in) :: eair !vapor pressure air at height (pa) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys), intent(in) :: snowh !actual snow depth [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: emg !ground emissivity + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !soil/snow temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity of snow/soil (w/m/k) + real (kind=kind_phys), intent(in) :: rsurf !ground surface resistance (s/m) + real (kind=kind_phys), intent(in) :: lathea !latent heat of vaporization/subli (j/kg) + real (kind=kind_phys), intent(in) :: gamma !psychrometric constant (pa/k) + real (kind=kind_phys), intent(in) :: rhsur !raltive humidity in surface soil/snow air space (-) + real (kind=kind_phys), intent(in) :: fsno !snow fraction !jref:start; in integer , intent(in) :: ivgtyp - real , intent(in) :: qc !cloud water mixing ratio - real , intent(inout) :: qsfc !mixing ratio at lowest model layer - real , intent(in) :: psfc !pressure at lowest model layer - real , intent(in) :: sfcprs !pressure at lowest model layer - real , intent(in) :: dx !horisontal grid spacing - real , intent(in) :: q2 !mixing ratio (kg/kg) - real , intent(in) :: dz8w !thickness of lowest layer + real (kind=kind_phys) , intent(in) :: qc !cloud water mixing ratio + real (kind=kind_phys) , intent(inout) :: qsfc !mixing ratio at lowest model layer + real (kind=kind_phys) , intent(in) :: psfc !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: sfcprs !pressure at lowest model layer + real (kind=kind_phys) , intent(in) :: dx !horisontal grid spacing + real (kind=kind_phys) , intent(in) :: q2 !mixing ratio (kg/kg) + real (kind=kind_phys) , intent(in) :: dz8w !thickness of lowest layer !jref:end - real, intent(in) :: pahb !precipitation advected heat - ground net in (w/m2) + real (kind=kind_phys), intent(in) :: pahb !precipitation advected heat - ground net in (w/m2) ! input/output - real, intent(inout) :: tgb !ground temperature (k) - real, intent(inout) :: cm !momentum drag coefficient - real, intent(inout) :: ch !sensible heat exchange coefficient + real (kind=kind_phys), intent(inout) :: tgb !ground temperature (k) + real (kind=kind_phys), intent(inout) :: cm !momentum drag coefficient + real (kind=kind_phys), intent(inout) :: ch !sensible heat exchange coefficient #ifdef CCPP character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -3931,91 +4093,91 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & ! output ! -sab + irb[tg] + shb[tg] + evb[tg] + ghb[tg] = 0 - real, intent(out) :: tauxb !wind stress: e-w (n/m2) - real, intent(out) :: tauyb !wind stress: n-s (n/m2) - real, intent(out) :: irb !net longwave rad (w/m2) [+ to atm] - real, intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] - real, intent(out) :: evb !latent heat flux (w/m2) [+ to atm] - real, intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] - real, intent(out) :: t2mb !2 m height air temperature (k) + real (kind=kind_phys), intent(out) :: tauxb !wind stress: e-w (n/m2) + real (kind=kind_phys), intent(out) :: tauyb !wind stress: n-s (n/m2) + real (kind=kind_phys), intent(out) :: irb !net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: shb !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: evb !latent heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(out) :: ghb !ground heat flux (w/m2) [+ to soil] + real (kind=kind_phys), intent(out) :: t2mb !2 m height air temperature (k) !jref:start - real, intent(out) :: q2b !bare ground heat conductance - real :: ehb !bare ground heat conductance - real :: u10b !10 m wind speed in eastward dir (m/s) - real :: v10b !10 m wind speed in eastward dir (m/s) - real :: wspd + real (kind=kind_phys), intent(out) :: q2b !bare ground heat conductance + real (kind=kind_phys) :: ehb !bare ground heat conductance + real (kind=kind_phys) :: u10b !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: v10b !10 m wind speed in eastward dir (m/s) + real (kind=kind_phys) :: wspd !jref:end ! local variables - real :: taux !wind stress: e-w (n/m2) - real :: tauy !wind stress: n-s (n/m2) - real :: fira !total net longwave rad (w/m2) [+ to atm] - real :: fsh !total sensible heat flux (w/m2) [+ to atm] - real :: fgev !ground evaporation heat flux (w/m2)[+ to atm] - real :: ssoil !soil heat flux (w/m2) [+ to soil] - real :: fire !emitted ir (w/m2) - real :: trad !radiative temperature (k) - real :: tah !"surface" temperature at height z0h+zpd (k) - - real :: cw !water vapor exchange coefficient - real :: fv !friction velocity (m/s) - real :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) - real :: z0h !roughness length, sensible heat, ground (m) - real :: rb !bulk leaf boundary layer resistance (s/m) - real :: ramb !aerodynamic resistance for momentum (s/m) - real :: rahb !aerodynamic resistance for sensible heat (s/m) - real :: rawb !aerodynamic resistance for water vapor (s/m) - real :: mol !monin-obukhov length (m) - real :: dtg !change in tg, last iteration (k) - - real :: cir !coefficients for ir as function of ts**4 - real :: csh !coefficients for sh as function of ts - real :: cev !coefficients for ev as function of esat[ts] - real :: cgh !coefficients for st as function of ts + real (kind=kind_phys) :: taux !wind stress: e-w (n/m2) + real (kind=kind_phys) :: tauy !wind stress: n-s (n/m2) + real (kind=kind_phys) :: fira !total net longwave rad (w/m2) [+ to atm] + real (kind=kind_phys) :: fsh !total sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys) :: fgev !ground evaporation heat flux (w/m2)[+ to atm] + real (kind=kind_phys) :: ssoil !soil heat flux (w/m2) [+ to soil] + real (kind=kind_phys) :: fire !emitted ir (w/m2) + real (kind=kind_phys) :: trad !radiative temperature (k) + real (kind=kind_phys) :: tah !"surface" temperature at height z0h+zpd (k) + + real (kind=kind_phys) :: cw !water vapor exchange coefficient + real (kind=kind_phys) :: fv !friction velocity (m/s) + real (kind=kind_phys) :: wstar !friction velocity n vertical direction (m/s) (only for sfcdif2) + real (kind=kind_phys) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) + real (kind=kind_phys) :: ramb !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahb !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawb !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: dtg !change in tg, last iteration (k) + + real (kind=kind_phys) :: cir !coefficients for ir as function of ts**4 + real (kind=kind_phys) :: csh !coefficients for sh as function of ts + real (kind=kind_phys) :: cev !coefficients for ev as function of esat[ts] + real (kind=kind_phys) :: cgh !coefficients for st as function of ts !jref:start - real :: rahb2 !aerodynamic resistance for sensible heat 2m (s/m) - real :: rawb2 !aerodynamic resistance for water vapor 2m (s/m) - real,intent(out) :: ehb2 !sensible heat conductance for diagnostics - real :: ch2b !exchange coefficient for 2m temp. - real :: cq2b !exchange coefficient for 2m temp. - real :: thvair !virtual potential air temp - real :: thgh !potential ground temp - real :: emb !momentum conductance - real :: qfx !moisture flux - real :: estg2 !saturation vapor pressure at 2m (pa) + real (kind=kind_phys) :: rahb2 !aerodynamic resistance for sensible heat 2m (s/m) + real (kind=kind_phys) :: rawb2 !aerodynamic resistance for water vapor 2m (s/m) + real (kind=kind_phys),intent(out) :: ehb2 !sensible heat conductance for diagnostics + real (kind=kind_phys) :: ch2b !exchange coefficient for 2m temp. + real (kind=kind_phys) :: cq2b !exchange coefficient for 2m temp. + real (kind=kind_phys) :: thvair !virtual potential air temp + real (kind=kind_phys) :: thgh !potential ground temp + real (kind=kind_phys) :: emb !momentum conductance + real (kind=kind_phys) :: qfx !moisture flux + real (kind=kind_phys) :: estg2 !saturation vapor pressure at 2m (pa) integer :: vegtyp !vegetation type set to isbarren - real :: e1 + real (kind=kind_phys) :: e1 !jref:end - real :: estg !saturation vapor pressure at tg (pa) - real :: destg !d(es)/dt at tg (pa/k) - real :: esatw !es for water - real :: esati !es for ice - real :: dsatw !d(es)/dt at tg (pa/k) for water - real :: dsati !d(es)/dt at tg (pa/k) for ice - - real :: a !temporary calculation - real :: b !temporary calculation - real :: h !temporary sensible heat flux (w/m2) - real :: moz !monin-obukhov stability parameter - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: fm !momentum stability correction, weighted by prior iters - real :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys) :: estg !saturation vapor pressure at tg (pa) + real (kind=kind_phys) :: destg !d(es)/dt at tg (pa/k) + real (kind=kind_phys) :: esatw !es for water + real (kind=kind_phys) :: esati !es for ice + real (kind=kind_phys) :: dsatw !d(es)/dt at tg (pa/k) for water + real (kind=kind_phys) :: dsati !d(es)/dt at tg (pa/k) for ice + + real (kind=kind_phys) :: a !temporary calculation + real (kind=kind_phys) :: b !temporary calculation + real (kind=kind_phys) :: h !temporary sensible heat flux (w/m2) + real (kind=kind_phys) :: moz !monin-obukhov stability parameter + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys) :: fh !sen heat stability correction, weighted by prior iters integer :: mozsgn !number of times moz changes sign - real :: fm2 !monin-obukhov momentum adjustment at 2m - real :: fh2 !monin-obukhov heat adjustment at 2m - real :: ch2 !surface exchange at 2m + real (kind=kind_phys) :: fm2 !monin-obukhov momentum adjustment at 2m + real (kind=kind_phys) :: fh2 !monin-obukhov heat adjustment at 2m + real (kind=kind_phys) :: ch2 !surface exchange at 2m integer :: iter !iteration index integer :: niterb !number of iterations for surface temperature - real :: mpe !prevents overflow error if division by zero + real (kind=kind_phys) :: mpe !prevents overflow error if division by zero !jref:start ! data niterb /3/ data niterb /5/ save niterb - real :: t, tdc !kelvin to degree celsius with limit -50 to +50 + real (kind=kind_phys) :: t, tdc !kelvin to degree celsius with limit -50 to +50 tdc(t) = min( 50., max(-50.,(t-tfrz)) ) ! ----------------------------------------------------------------- @@ -4026,6 +4188,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & moz = 0. mozsgn = 0 mozold = 0. + fh2 = 0. h = 0. qfx = 0. fv = 0.1 @@ -4136,7 +4299,7 @@ subroutine bare_flux (parameters,nsnow ,nsoil ,isnow ,dt ,sag , & if(opt_stc == 1 .or. opt_stc == 3) then if (snowh > 0.05 .and. tgb > tfrz) then - tgb = tfrz + if(opt_stc == 1) tgb = tfrz if(opt_stc == 3) tgb = (1.-fsno)*tgb + fsno*tfrz ! mb: allow tg>0c during melt v3.7 irb = cir * tgb**4 - emg*lwdn shb = csh * (tgb - sfctmp) @@ -4192,39 +4355,39 @@ subroutine ragrb(parameters,iter ,vai ,rhoair ,hg ,tah , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: iter !iteration index integer, intent(in) :: vegtyp !vegetation physiology type - real, intent(in) :: vai !total lai + stem area index, one sided - real, intent(in) :: rhoair !density air (kg/m3) - real, intent(in) :: hg !ground sensible heat flux (w/m2) - real, intent(in) :: tv !vegetation temperature (k) - real, intent(in) :: tah !air temperature at height z0h+zpd (k) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0mg !roughness length, momentum, ground (m) - real, intent(in) :: hcan !canopy height (m) [note: hcan >= z0mg] - real, intent(in) :: uc !wind speed at top of canopy (m/s) - real, intent(in) :: z0h !roughness length, sensible heat (m) - real, intent(in) :: z0hg !roughness length, sensible heat, ground (m) - real, intent(in) :: fv !friction velocity (m/s) - real, intent(in) :: cwp !canopy wind parameter - real, intent(in) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys), intent(in) :: vai !total lai + stem area index, one sided + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m3) + real (kind=kind_phys), intent(in) :: hg !ground sensible heat flux (w/m2) + real (kind=kind_phys), intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(in) :: tah !air temperature at height z0h+zpd (k) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0mg !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: hcan !canopy height (m) [note: hcan >= z0mg] + real (kind=kind_phys), intent(in) :: uc !wind speed at top of canopy (m/s) + real (kind=kind_phys), intent(in) :: z0h !roughness length, sensible heat (m) + real (kind=kind_phys), intent(in) :: z0hg !roughness length, sensible heat, ground (m) + real (kind=kind_phys), intent(in) :: fv !friction velocity (m/s) + real (kind=kind_phys), intent(in) :: cwp !canopy wind parameter + real (kind=kind_phys), intent(in) :: mpe !prevents overflow error if division by zero ! in & out - real, intent(inout) :: mozg !monin-obukhov stability parameter - real, intent(inout) :: fhg !stability correction + real (kind=kind_phys), intent(inout) :: mozg !monin-obukhov stability parameter + real (kind=kind_phys), intent(inout) :: fhg !stability correction ! outputs - real :: ramg !aerodynamic resistance for momentum (s/m) - real :: rahg !aerodynamic resistance for sensible heat (s/m) - real :: rawg !aerodynamic resistance for water vapor (s/m) - real :: rb !bulk leaf boundary layer resistance (s/m) - - - real :: kh !turbulent transfer coefficient, sensible heat, (m2/s) - real :: tmp1 !temporary calculation - real :: tmp2 !temporary calculation - real :: tmprah2 !temporary calculation for aerodynamic resistances - real :: tmprb !temporary calculation for rb - real :: molg,fhgnew,cwpc + real (kind=kind_phys) :: ramg !aerodynamic resistance for momentum (s/m) + real (kind=kind_phys) :: rahg !aerodynamic resistance for sensible heat (s/m) + real (kind=kind_phys) :: rawg !aerodynamic resistance for water vapor (s/m) + real (kind=kind_phys) :: rb !bulk leaf boundary layer resistance (s/m) + + + real (kind=kind_phys) :: kh !turbulent transfer coefficient, sensible heat, (m2/s) + real (kind=kind_phys) :: tmp1 !temporary calculation + real (kind=kind_phys) :: tmp2 !temporary calculation + real (kind=kind_phys) :: tmprah2 !temporary calculation for aerodynamic resistances + real (kind=kind_phys) :: tmprb !temporary calculation for rb + real (kind=kind_phys) :: molg,fhgnew,cwpc ! -------------------------------------------------------------------------------------------------- ! stability correction to below canopy resistance @@ -4268,6 +4431,7 @@ subroutine ragrb(parameters,iter ,vai ,rhoair ,hg ,tah , & !in tmprb = cwpc*50. / (1. - exp(-cwpc/2.)) rb = tmprb * sqrt(parameters%dleaf/uc) + rb = max(rb,20.0) ! rb = 200 end subroutine ragrb @@ -4295,24 +4459,24 @@ subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in integer, intent(in) :: iloc !grid index integer, intent(in) :: jloc !grid index integer, intent(in) :: iter !iteration index - real, intent(in) :: sfctmp !temperature at reference height (k) - real, intent(in) :: rhoair !density air (kg/m**3) - real, intent(in) :: h !sensible heat flux (w/m2) [+ to atm] - real, intent(in) :: qair !specific humidity at reference height (kg/kg) - real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: zpd !zero plane displacement (m) - real, intent(in) :: z0h !roughness length, sensible heat, ground (m) - real, intent(in) :: z0m !roughness length, momentum, ground (m) - real, intent(in) :: ur !wind speed (m/s) - real, intent(in) :: mpe !prevents overflow error if division by zero + real (kind=kind_phys), intent(in) :: sfctmp !temperature at reference height (k) + real (kind=kind_phys), intent(in) :: rhoair !density air (kg/m**3) + real (kind=kind_phys), intent(in) :: h !sensible heat flux (w/m2) [+ to atm] + real (kind=kind_phys), intent(in) :: qair !specific humidity at reference height (kg/kg) + real (kind=kind_phys), intent(in) :: zlvl !reference height (m) + real (kind=kind_phys), intent(in) :: zpd !zero plane displacement (m) + real (kind=kind_phys), intent(in) :: z0h !roughness length, sensible heat, ground (m) + real (kind=kind_phys), intent(in) :: z0m !roughness length, momentum, ground (m) + real (kind=kind_phys), intent(in) :: ur !wind speed (m/s) + real (kind=kind_phys), intent(in) :: mpe !prevents overflow error if division by zero ! in & out integer, intent(inout) :: mozsgn !number of times moz changes sign - real, intent(inout) :: moz !monin-obukhov stability (z/l) - real, intent(inout) :: fm !momentum stability correction, weighted by prior iters - real, intent(inout) :: fh !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters - real, intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: moz !monin-obukhov stability (z/l) + real (kind=kind_phys), intent(inout) :: fm !momentum stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fm2 !sen heat stability correction, weighted by prior iters + real (kind=kind_phys), intent(inout) :: fh2 !sen heat stability correction, weighted by prior iters #ifdef CCPP character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg @@ -4320,28 +4484,28 @@ subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in ! outputs - real, intent(out) :: cm !drag coefficient for momentum - real, intent(out) :: ch !drag coefficient for heat - real, intent(out) :: fv !friction velocity (m/s) - real, intent(out) :: ch2 !drag coefficient for heat + real (kind=kind_phys), intent(out) :: cm !drag coefficient for momentum + real (kind=kind_phys), intent(out) :: ch !drag coefficient for heat + real (kind=kind_phys), intent(out) :: fv !friction velocity (m/s) + real (kind=kind_phys), intent(out) :: ch2 !drag coefficient for heat ! locals - real :: mol !monin-obukhov length (m) - real :: tmpcm !temporary calculation for cm - real :: tmpch !temporary calculation for ch - real :: fmnew !stability correction factor, momentum, for current moz - real :: fhnew !stability correction factor, sen heat, for current moz - real :: mozold !monin-obukhov stability parameter from prior iteration - real :: tmp1,tmp2,tmp3,tmp4,tmp5 !temporary calculation - real :: tvir !temporary virtual temperature (k) - real :: moz2 !2/l - real :: tmpcm2 !temporary calculation for cm2 - real :: tmpch2 !temporary calculation for ch2 - real :: fm2new !stability correction factor, momentum, for current moz - real :: fh2new !stability correction factor, sen heat, for current moz - real :: tmp12,tmp22,tmp32 !temporary calculation - - real :: cmfm, chfh, cm2fm2, ch2fh2 + real (kind=kind_phys) :: mol !monin-obukhov length (m) + real (kind=kind_phys) :: tmpcm !temporary calculation for cm + real (kind=kind_phys) :: tmpch !temporary calculation for ch + real (kind=kind_phys) :: fmnew !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fhnew !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: mozold !monin-obukhov stability parameter from prior iteration + real (kind=kind_phys) :: tmp1,tmp2,tmp3,tmp4,tmp5 !temporary calculation + real (kind=kind_phys) :: tvir !temporary virtual temperature (k) + real (kind=kind_phys) :: moz2 !2/l + real (kind=kind_phys) :: tmpcm2 !temporary calculation for cm2 + real (kind=kind_phys) :: tmpch2 !temporary calculation for ch2 + real (kind=kind_phys) :: fm2new !stability correction factor, momentum, for current moz + real (kind=kind_phys) :: fh2new !stability correction factor, sen heat, for current moz + real (kind=kind_phys) :: tmp12,tmp22,tmp32 !temporary calculation + + real (kind=kind_phys) :: cmfm, chfh, cm2fm2, ch2fh2 ! ------------------------------------------------------------------------------------------------- ! monin-obukhov stability parameter moz for next iteration @@ -4364,7 +4528,7 @@ subroutine sfcdif1(parameters,iter ,sfctmp ,rhoair ,h ,qair , & !in tmpch2 = log((2.0 + z0h) / z0h) if(iter == 1) then - fv = 0.0 + fv = 0.1 moz = 0.0 mol = 0.0 moz2 = 0.0 @@ -4470,48 +4634,48 @@ subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in integer, intent(in) :: iloc integer, intent(in) :: jloc integer, intent(in) :: iter - real, intent(in) :: zlm, z0, thz0, thlm, sfcspd - real, intent(inout) :: akms - real, intent(inout) :: akhs - real, intent(inout) :: rlmo - real, intent(inout) :: wstar2 - real, intent(out) :: ustar - - real zz, pslmu, pslms, pslhu, pslhs - real xx, pspmu, yy, pspms, psphu, psphs - real zilfc, zu, zt, rdz, cxch - real dthv, du2, btgh, zslu, zslt, rlogu, rlogt - real zetalt, zetalu, zetau, zetat, xlu4, xlt4, xu4, xt4 - - real xlu, xlt, xu, xt, psmz, simm, pshz, simh, ustark, rlmn, & + real (kind=kind_phys), intent(in) :: zlm, z0, thz0, thlm, sfcspd + real (kind=kind_phys), intent(inout) :: akms + real (kind=kind_phys), intent(inout) :: akhs + real (kind=kind_phys), intent(inout) :: rlmo + real (kind=kind_phys), intent(inout) :: wstar2 + real (kind=kind_phys), intent(out) :: ustar + + real (kind=kind_phys) zz, pslmu, pslms, pslhu, pslhs + real (kind=kind_phys) xx, pspmu, yy, pspms, psphu, psphs + real (kind=kind_phys) zilfc, zu, zt, rdz, cxch + real (kind=kind_phys) dthv, du2, btgh, zslu, zslt, rlogu, rlogt + real (kind=kind_phys) zetalt, zetalu, zetau, zetat, xlu4, xlt4, xu4, xt4 + + real (kind=kind_phys) xlu, xlt, xu, xt, psmz, simm, pshz, simh, ustark, rlmn, & & rlma integer ilech, itr integer, parameter :: itrmx = 5 - real, parameter :: wwst = 1.2 - real, parameter :: wwst2 = wwst * wwst - real, parameter :: vkrm = 0.40 - real, parameter :: excm = 0.001 - real, parameter :: beta = 1.0 / 270.0 - real, parameter :: btg = beta * grav - real, parameter :: elfc = vkrm * btg - real, parameter :: wold = 0.15 - real, parameter :: wnew = 1.0 - wold - real, parameter :: pihf = 3.14159265 / 2. - real, parameter :: epsu2 = 1.e-4 - real, parameter :: epsust = 0.07 - real, parameter :: epsit = 1.e-4 - real, parameter :: epsa = 1.e-8 - real, parameter :: ztmin = -5.0 - real, parameter :: ztmax = 1.0 - real, parameter :: hpbl = 1000.0 - real, parameter :: sqvisc = 258.2 - real, parameter :: ric = 0.183 - real, parameter :: rric = 1.0 / ric - real, parameter :: fhneu = 0.8 - real, parameter :: rfc = 0.191 - real, parameter :: rfac = ric / ( fhneu * rfc * rfc ) + real (kind=kind_phys), parameter :: wwst = 1.2 + real (kind=kind_phys), parameter :: wwst2 = wwst * wwst + real (kind=kind_phys), parameter :: vkrm = 0.40 + real (kind=kind_phys), parameter :: excm = 0.001 + real (kind=kind_phys), parameter :: beta = 1.0 / 270.0 + real (kind=kind_phys), parameter :: btg = beta * grav + real (kind=kind_phys), parameter :: elfc = vkrm * btg + real (kind=kind_phys), parameter :: wold = 0.15 + real (kind=kind_phys), parameter :: wnew = 1.0 - wold + real (kind=kind_phys), parameter :: pihf = 3.14159265 / 2. + real (kind=kind_phys), parameter :: epsu2 = 1.e-4 + real (kind=kind_phys), parameter :: epsust = 0.07 + real (kind=kind_phys), parameter :: epsit = 1.e-4 + real (kind=kind_phys), parameter :: epsa = 1.e-8 + real (kind=kind_phys), parameter :: ztmin = -5.0 + real (kind=kind_phys), parameter :: ztmax = 1.0 + real (kind=kind_phys), parameter :: hpbl = 1000.0 + real (kind=kind_phys), parameter :: sqvisc = 258.2 + real (kind=kind_phys), parameter :: ric = 0.183 + real (kind=kind_phys), parameter :: rric = 1.0 / ric + real (kind=kind_phys), parameter :: fhneu = 0.8 + real (kind=kind_phys), parameter :: rfc = 0.191 + real (kind=kind_phys), parameter :: rfac = ric / ( fhneu * rfc * rfc ) ! ---------------------------------------------------------------------- ! note: the two code blocks below define functions @@ -4593,6 +4757,8 @@ subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in else zetalu = min (zetalu,ztmax) zetalt = min (zetalt,ztmax) + zetau = min (zetau,ztmax/(zslu/zu)) ! barlage: add limit on zetau/zetat + zetat = min (zetat,ztmax/(zslt/zt)) ! barlage: prevent simm/simh < 0 psmz = pspms (zetau) simm = pspms (zetalu) - psmz + rlogu pshz = psphs (zetat) @@ -4629,10 +4795,12 @@ subroutine sfcdif2(parameters,iter ,z0 ,thz0 ,thlm ,sfcspd , & !in !----------------------------------------------------------------------- rlogt = log (zslt / zt) ustark = ustar * vkrm + if(simm < 1.e-6) simm = 1.e-6 ! limit stability function akms = max (ustark / simm,cxch) !----------------------------------------------------------------------- ! if statements to avoid tangent linear problems near zero !----------------------------------------------------------------------- + if(simh < 1.e-6) simh = 1.e-6 ! limit stability function akhs = max (ustark / simh,cxch) if (btgh * akhs * dthv .ne. 0.0) then @@ -4665,21 +4833,21 @@ subroutine esat(t, esw, esi, desw, desi) !--------------------------------------------------------------------------------------------------- ! in - real, intent(in) :: t !temperature + real (kind=kind_phys), intent(in) :: t !temperature !out - real, intent(out) :: esw !saturation vapor pressure over water (pa) - real, intent(out) :: esi !saturation vapor pressure over ice (pa) - real, intent(out) :: desw !d(esat)/dt over water (pa/k) - real, intent(out) :: desi !d(esat)/dt over ice (pa/k) + real (kind=kind_phys), intent(out) :: esw !saturation vapor pressure over water (pa) + real (kind=kind_phys), intent(out) :: esi !saturation vapor pressure over ice (pa) + real (kind=kind_phys), intent(out) :: desw !d(esat)/dt over water (pa/k) + real (kind=kind_phys), intent(out) :: desi !d(esat)/dt over ice (pa/k) ! local - real :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water - real :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice - real :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water - real :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice + real (kind=kind_phys) :: a0,a1,a2,a3,a4,a5,a6 !coefficients for esat over water + real (kind=kind_phys) :: b0,b1,b2,b3,b4,b5,b6 !coefficients for esat over ice + real (kind=kind_phys) :: c0,c1,c2,c3,c4,c5,c6 !coefficients for dsat over water + real (kind=kind_phys) :: d0,d1,d2,d3,d4,d5,d6 !coefficients for dsat over ice parameter (a0=6.107799961 , a1=4.436518521e-01, & a2=1.428945805e-02, a3=2.650648471e-04, & @@ -4724,27 +4892,27 @@ subroutine stomata (parameters,vegtyp ,mpe ,apar ,foln ,iloc , jlo integer,intent(in) :: jloc !grid index integer,intent(in) :: vegtyp !vegetation physiology type - real, intent(in) :: igs !growing season index (0=off, 1=on) - real, intent(in) :: mpe !prevents division by zero errors - - real, intent(in) :: tv !foliage temperature (k) - real, intent(in) :: ei !vapor pressure inside leaf (sat vapor press at tv) (pa) - real, intent(in) :: ea !vapor pressure of canopy air (pa) - real, intent(in) :: apar !par absorbed per unit lai (w/m2) - real, intent(in) :: o2 !atmospheric o2 concentration (pa) - real, intent(in) :: co2 !atmospheric co2 concentration (pa) - real, intent(in) :: sfcprs !air pressure at reference height (pa) - real, intent(in) :: sfctmp !air temperature at reference height (k) - real, intent(in) :: btran !soil water transpiration factor (0 to 1) - real, intent(in) :: foln !foliage nitrogen concentration (%) - real, intent(in) :: rb !boundary layer resistance (s/m) + real (kind=kind_phys), intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys), intent(in) :: mpe !prevents division by zero errors + + real (kind=kind_phys), intent(in) :: tv !foliage temperature (k) + real (kind=kind_phys), intent(in) :: ei !vapor pressure inside leaf (sat vapor press at tv) (pa) + real (kind=kind_phys), intent(in) :: ea !vapor pressure of canopy air (pa) + real (kind=kind_phys), intent(in) :: apar !par absorbed per unit lai (w/m2) + real (kind=kind_phys), intent(in) :: o2 !atmospheric o2 concentration (pa) + real (kind=kind_phys), intent(in) :: co2 !atmospheric co2 concentration (pa) + real (kind=kind_phys), intent(in) :: sfcprs !air pressure at reference height (pa) + real (kind=kind_phys), intent(in) :: sfctmp !air temperature at reference height (k) + real (kind=kind_phys), intent(in) :: btran !soil water transpiration factor (0 to 1) + real (kind=kind_phys), intent(in) :: foln !foliage nitrogen concentration (%) + real (kind=kind_phys), intent(in) :: rb !boundary layer resistance (s/m) ! output - real, intent(out) :: rs !leaf stomatal resistance (s/m) - real, intent(out) :: psn !foliage photosynthesis (umol co2 /m2/ s) [always +] + real (kind=kind_phys), intent(out) :: rs !leaf stomatal resistance (s/m) + real (kind=kind_phys), intent(out) :: psn !foliage photosynthesis (umol co2 /m2/ s) [always +] ! in&out - real :: rlb !boundary layer resistance (s m2 / umol) + real (kind=kind_phys) :: rlb !boundary layer resistance (s m2 / umol) ! --------------------------------------------------------------------------------------------- ! ------------------------ local variables ---------------------------------------------------- @@ -4754,32 +4922,32 @@ subroutine stomata (parameters,vegtyp ,mpe ,apar ,foln ,iloc , jlo data niter /3/ save niter - real :: ab !used in statement functions - real :: bc !used in statement functions - real :: f1 !generic temperature response (statement function) - real :: f2 !generic temperature inhibition (statement function) - real :: tc !foliage temperature (degree celsius) - real :: cs !co2 concentration at leaf surface (pa) - real :: kc !co2 michaelis-menten constant (pa) - real :: ko !o2 michaelis-menten constant (pa) - real :: a,b,c,q !intermediate calculations for rs - real :: r1,r2 !roots for rs - real :: fnf !foliage nitrogen adjustment factor (0 to 1) - real :: ppf !absorb photosynthetic photon flux (umol photons/m2/s) - real :: wc !rubisco limited photosynthesis (umol co2/m2/s) - real :: wj !light limited photosynthesis (umol co2/m2/s) - real :: we !export limited photosynthesis (umol co2/m2/s) - real :: cp !co2 compensation point (pa) - real :: ci !internal co2 (pa) - real :: awc !intermediate calculation for wc - real :: vcmx !maximum rate of carbonylation (umol co2/m2/s) - real :: j !electron transport (umol co2/m2/s) - real :: cea !constrain ea or else model blows up - real :: cf !s m2/umol -> s/m + real (kind=kind_phys) :: ab !used in statement functions + real (kind=kind_phys) :: bc !used in statement functions + real (kind=kind_phys) :: f1 !generic temperature response (statement function) + real (kind=kind_phys) :: f2 !generic temperature inhibition (statement function) + real (kind=kind_phys) :: tc !foliage temperature (degree celsius) + real (kind=kind_phys) :: cs !co2 concentration at leaf surface (pa) + real (kind=kind_phys) :: kc !co2 michaelis-menten constant (pa) + real (kind=kind_phys) :: ko !o2 michaelis-menten constant (pa) + real (kind=kind_phys) :: a,b,c,q !intermediate calculations for rs + real (kind=kind_phys) :: r1,r2 !roots for rs + real (kind=kind_phys) :: fnf !foliage nitrogen adjustment factor (0 to 1) + real (kind=kind_phys) :: ppf !absorb photosynthetic photon flux (umol photons/m2/s) + real (kind=kind_phys) :: wc !rubisco limited photosynthesis (umol co2/m2/s) + real (kind=kind_phys) :: wj !light limited photosynthesis (umol co2/m2/s) + real (kind=kind_phys) :: we !export limited photosynthesis (umol co2/m2/s) + real (kind=kind_phys) :: cp !co2 compensation point (pa) + real (kind=kind_phys) :: ci !internal co2 (pa) + real (kind=kind_phys) :: awc !intermediate calculation for wc + real (kind=kind_phys) :: vcmx !maximum rate of carbonylation (umol co2/m2/s) + real (kind=kind_phys) :: j !electron transport (umol co2/m2/s) + real (kind=kind_phys) :: cea !constrain ea or else model blows up + real (kind=kind_phys) :: cf !s m2/umol -> s/m f1(ab,bc) = ab**((bc-25.)/10.) f2(ab) = 1. + exp((-2.2e05+710.*(ab+273.16))/(8.314*(ab+273.16))) - real :: t + real (kind=kind_phys) :: t ! --------------------------------------------------------------------------------------------- ! initialize rs=rsmax and psn=0 because will only do calculations @@ -4867,26 +5035,26 @@ subroutine canres (parameters,par ,sfctmp,rcsoil ,eah ,sfcprs , & !in type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: iloc !grid index integer, intent(in) :: jloc !grid index - real, intent(in) :: par !par absorbed per unit sunlit lai (w/m2) - real, intent(in) :: sfctmp !canopy air temperature - real, intent(in) :: sfcprs !surface pressure (pa) - real, intent(in) :: eah !water vapor pressure (pa) - real, intent(in) :: rcsoil !soil moisture stress factor + real (kind=kind_phys), intent(in) :: par !par absorbed per unit sunlit lai (w/m2) + real (kind=kind_phys), intent(in) :: sfctmp !canopy air temperature + real (kind=kind_phys), intent(in) :: sfcprs !surface pressure (pa) + real (kind=kind_phys), intent(in) :: eah !water vapor pressure (pa) + real (kind=kind_phys), intent(in) :: rcsoil !soil moisture stress factor !outputs - real, intent(out) :: rc !canopy resistance per unit lai - real, intent(out) :: psn !foliage photosynthesis (umolco2/m2/s) + real (kind=kind_phys), intent(out) :: rc !canopy resistance per unit lai + real (kind=kind_phys), intent(out) :: psn !foliage photosynthesis (umolco2/m2/s) !local - real :: rcq - real :: rcs - real :: rct - real :: ff - real :: q2 !water vapor mixing ratio (kg/kg) - real :: q2sat !saturation q2 - real :: dqsdt2 !d(q2sat)/d(t) + real (kind=kind_phys) :: rcq + real (kind=kind_phys) :: rcs + real (kind=kind_phys) :: rct + real (kind=kind_phys) :: ff + real (kind=kind_phys) :: q2 !water vapor mixing ratio (kg/kg) + real (kind=kind_phys) :: q2sat !saturation q2 + real (kind=kind_phys) :: dqsdt2 !d(q2sat)/d(t) ! rsmin, rsmax, topt, rgl, hs are canopy stress parameters set in redprm ! ---------------------------------------------------------------------- @@ -4935,12 +5103,12 @@ subroutine calhum(parameters,sfctmp, sfcprs, q2sat, dqsdt2) implicit none type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: sfctmp, sfcprs - real, intent(out) :: q2sat, dqsdt2 - real, parameter :: a2=17.67,a3=273.15,a4=29.65, elwv=2.501e6, & + real (kind=kind_phys), intent(in) :: sfctmp, sfcprs + real (kind=kind_phys), intent(out) :: q2sat, dqsdt2 + real (kind=kind_phys), parameter :: a2=17.67,a3=273.15,a4=29.65, elwv=2.501e6, & a23m4=a2*(a3-a4), e0=0.611, rv=461.0, & epsilon=0.622 - real :: es, sfcprsx + real (kind=kind_phys) :: es, sfcprsx ! q2sat: saturated mixing ratio es = e0 * exp ( elwv/rv*(1./a3 - 1./sfctmp) ) @@ -4989,20 +5157,20 @@ subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & ! integer, intent(in) :: isnow !actual no of snow layers integer, intent(in) :: ist !surface type - real, intent(in) :: dt !time step (s) - real, intent(in) :: tbot ! - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, intent(in) :: sag !solar rad. absorbed by ground (w/m2) - real, intent(in) :: snowh !snow depth (m) - real, intent(in) :: tg !ground temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: tbot ! + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), intent(in) :: sag !solar rad. absorbed by ground (w/m2) + real (kind=kind_phys), intent(in) :: snowh !snow depth (m) + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bot. depth from snow surf.(m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) !input and output - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg @@ -5011,15 +5179,15 @@ subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & ! !local integer :: iz - real :: zbotsno !zbot from snow surface - real, dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts - real :: eflxb !energy influx from soil bottom (w/m2) - real, dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) - - real, dimension(-nsnow+1:nsoil) :: tbeg - real :: err_est !heat storage error (w/m2) - real :: ssoil2 !ground heat flux (w/m2) (for energy check) - real :: eflxb2 !heat flux from the bottom (w/m2) (for energy check) + real (kind=kind_phys) :: zbotsno !zbot from snow surface + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ai, bi, ci, rhsts + real (kind=kind_phys) :: eflxb !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: phi !light through water (w/m2) + + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: tbeg + real (kind=kind_phys) :: err_est !heat storage error (w/m2) + real (kind=kind_phys) :: ssoil2 !ground heat flux (w/m2) (for energy check) + real (kind=kind_phys) :: eflxb2 !heat flux from the bottom (w/m2) (for energy check) character(len=256) :: message ! ---------------------------------------------------------------------- ! compute solar penetration through water, needs more work @@ -5069,7 +5237,7 @@ subroutine tsnosoi (parameters,ice ,nsoil ,nsnow ,isnow ,ist , & ! err_est = err_est + (stc(iz)-tbeg(iz)) * dzsnso(iz) * hcpct(iz) / dt enddo - if (opt_stc == 1) then ! semi-implicit + if (opt_stc == 1 .or. opt_stc == 3) then ! semi-implicit err_est = err_est - (ssoil +eflxb) else ! full-implicit ssoil2 = df(isnow+1)*(tg-stc(isnow+1))/(0.5*dzsnso(isnow+1)) !m. barlage @@ -5117,34 +5285,34 @@ subroutine hrt (parameters,nsnow ,nsoil ,isnow ,zsnso , & integer, intent(in) :: nsoil !no of soil layers (4) integer, intent(in) :: nsnow !maximum no of snow layers (3) integer, intent(in) :: isnow !actual no of snow layers - real, intent(in) :: tbot !bottom soil temp. at zbot (k) - real, intent(in) :: zbot !depth of lower boundary condition (m) + real (kind=kind_phys), intent(in) :: tbot !bottom soil temp. at zbot (k) + real (kind=kind_phys), intent(in) :: zbot !depth of lower boundary condition (m) !from soil surface not snow surface - real, intent(in) :: dt !time step (s) - real, intent(in) :: ssoil !ground heat flux (w/m2) - real, dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) - real, dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] - real, dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), intent(in) :: ssoil !ground heat flux (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: zsnso !depth of layer-bottom of snow/soil (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: df !thermal conductivity [w/m/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity [j/m3/k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: phi !light through water (w/m2) ! output - real, dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix - real, dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient - real, dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient - real, intent(out) :: botflx !energy influx from soil bottom (w/m2) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: rhsts !right-hand side of the matrix + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ai !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: bi !left-hand side coefficient + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(out) :: ci !left-hand side coefficient + real (kind=kind_phys), intent(out) :: botflx !energy influx from soil bottom (w/m2) ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: ddz - real, dimension(-nsnow+1:nsoil) :: dz - real, dimension(-nsnow+1:nsoil) :: denom - real, dimension(-nsnow+1:nsoil) :: dtsdz - real, dimension(-nsnow+1:nsoil) :: eflux - real :: temp1 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ddz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: denom + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: dtsdz + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: eflux + real (kind=kind_phys) :: temp1 ! ---------------------------------------------------------------------- do k = isnow+1, nsoil @@ -5178,7 +5346,7 @@ subroutine hrt (parameters,nsnow ,nsoil ,isnow ,zsnso , & if (k == isnow+1) then ai(k) = 0.0 ci(k) = - df(k) * ddz(k) / denom(k) - if (opt_stc == 1) then + if (opt_stc == 1 .or. opt_stc == 3 ) then bi(k) = - ci(k) end if if (opt_stc == 2) then @@ -5215,19 +5383,19 @@ subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & integer, intent(in) :: nsoil integer, intent(in) :: nsnow integer, intent(in) :: isnow - real, intent(in) :: dt + real (kind=kind_phys), intent(in) :: dt ! output & input - real, dimension(-nsnow+1:nsoil), intent(inout) :: rhsts - real, dimension(-nsnow+1:nsoil), intent(inout) :: ai - real, dimension(-nsnow+1:nsoil), intent(inout) :: bi - real, dimension(-nsnow+1:nsoil), intent(inout) :: ci - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: rhsts + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ai + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: bi + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: ci + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc ! local integer :: k - real, dimension(-nsnow+1:nsoil) :: rhstsin - real, dimension(-nsnow+1:nsoil) :: ciin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: rhstsin + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: ciin ! ---------------------------------------------------------------------- do k = isnow+1,nsoil @@ -5237,7 +5405,6 @@ subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & ci(k) = ci(k) * dt end do - ! copy values for input variables before call to rosr12 do k = isnow+1,nsoil @@ -5247,7 +5414,6 @@ subroutine hstep (parameters,nsnow ,nsoil ,isnow ,dt , & ! solve the tri-diagonal matrix equation - call rosr12 (ci,ai,bi,ciin,rhstsin,rhsts,isnow+1,nsoil,nsnow) ! update snow & soil temperature @@ -5286,8 +5452,8 @@ subroutine rosr12 (p,a,b,c,d,delta,ntop,nsoil,nsnow) integer, intent(in) :: nsoil,nsnow integer :: k, kk - real, dimension(-nsnow+1:nsoil),intent(in):: a, b, d - real, dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(in):: a, b, d + real (kind=kind_phys), dimension(-nsnow+1:nsoil),intent(inout):: c,p,delta ! ---------------------------------------------------------------------- ! initialize eqn coef c for the lowest soil layer @@ -5346,25 +5512,25 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , integer, intent(in) :: nsoil !no. of soil layers [=4] integer, intent(in) :: isnow !actual no. of snow layers [<=3] integer, intent(in) :: ist !surface type: 1->soil; 2->lake - real, intent(in) :: dt !land model time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) + real (kind=kind_phys), intent(in) :: dt !land model time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: fact !temporary + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: hcpct !heat capacity (j/m3/k) ! outputs integer, dimension(-nsnow+1:nsoil), intent(out) :: imelt !phase change index - real, intent(out) :: qmelt !snowmelt rate [mm/s] - real, intent(out) :: ponding!snowmelt when snow has no layer [mm] + real (kind=kind_phys), intent(out) :: qmelt !snowmelt rate [mm/s] + real (kind=kind_phys), intent(out) :: ponding!snowmelt when snow has no layer [mm] ! inputs and outputs - real, intent(inout) :: sneqv - real, intent(inout) :: snowh - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] - real, dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: sneqv + real (kind=kind_phys), intent(inout) :: snowh + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water [m3/m3] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(inout) :: snliq !snow layer liquid water [mm] #ifdef CCPP character(len=*) , intent(inout) :: errmsg integer , intent(inout) :: errflg @@ -5373,19 +5539,19 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , ! local integer :: j !do loop index - real, dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] - real, dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] - real, dimension(-nsnow+1:nsoil) :: wmass0 - real, dimension(-nsnow+1:nsoil) :: wice0 - real, dimension(-nsnow+1:nsoil) :: wliq0 - real, dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] - real, dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] - real, dimension(-nsnow+1:nsoil) :: supercool !supercooled water in soil (kg/m2) - real :: heatr !energy residual or loss after melting/freezing - real :: temp1 !temporary variables [kg/m2] - real :: propor - real :: smp !frozen water potential (mm) - real :: xmf !total latent heat of phase change + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: hm !energy residual [w/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: xm !melting or freezing water [kg/m2] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wmass0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wice0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: wliq0 + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mice !soil/snow ice mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: mliq !soil/snow liquid water mass [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: supercool !supercooled water in soil (kg/m2) + real (kind=kind_phys) :: heatr !energy residual or loss after melting/freezing + real (kind=kind_phys) :: temp1 !temporary variables [kg/m2] + real (kind=kind_phys) :: propor + real (kind=kind_phys) :: smp !frozen water potential (mm) + real (kind=kind_phys) :: xmf !total latent heat of phase change ! ---------------------------------------------------------------------- ! initialization @@ -5422,16 +5588,16 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , if (opt_frz == 1) then if(stc(j) < tfrz) then smp = hfus*(tfrz-stc(j))/(grav*stc(j)) !(m) - supercool(j) = parameters%smcmax*(smp/parameters%psisat)**(-1./parameters%bexp) + supercool(j) = parameters%smcmax(j)*(smp/parameters%psisat(j))**(-1./parameters%bexp(j)) supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) end if end if if (opt_frz == 2) then #ifdef CCPP - call frh2o (parameters,supercool(j),stc(j),smc(j),sh2o(j),errmsg,errflg) + call frh2o (parameters,j,supercool(j),stc(j),smc(j),sh2o(j),errmsg,errflg) if (errflg /=0) return #else - call frh2o (parameters,supercool(j),stc(j),smc(j),sh2o(j)) + call frh2o (parameters,j,supercool(j),stc(j),smc(j),sh2o(j)) #endif supercool(j) = supercool(j)*dzsnso(j)*1000. !(mm) end if @@ -5480,6 +5646,7 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , sneqv = max(0.,temp1-xm(1)) propor = sneqv/temp1 snowh = max(0.,propor * snowh) + snowh = min(max(snowh,sneqv/500.0),sneqv/50.0) ! limit adjustment to a reasonable density heatr = hm(1) - hfus*(temp1-sneqv)/dt if (heatr > 0.) then xm(1) = heatr*dt/hfus @@ -5522,6 +5689,11 @@ subroutine phasechange (parameters,nsnow ,nsoil ,isnow ,dt ,fact , stc(j) = stc(j) + fact(j)*heatr if (j <= 0) then ! snow if (mliq(j)*mice(j)>0.) stc(j) = tfrz + if (mice(j) == 0.) then ! barlage + stc(j) = tfrz ! barlage + hm(j+1) = hm(j+1) + heatr ! barlage + xm(j+1) = hm(j+1)*dt/hfus ! barlage + endif end if endif @@ -5548,7 +5720,7 @@ end subroutine phasechange !== begin frh2o ==================================================================================== !>\ingroup NoahMP_LSM - subroutine frh2o (parameters,free,tkelv,smc,sh2o,& + subroutine frh2o (parameters,isoil,free,tkelv,smc,sh2o,& #ifdef CCPP errmsg,errflg) #else @@ -5584,16 +5756,17 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& ! ---------------------------------------------------------------------- implicit none type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: sh2o,smc,tkelv - real, intent(out) :: free + integer,intent(in) :: isoil + real (kind=kind_phys), intent(in) :: sh2o,smc,tkelv + real (kind=kind_phys), intent(out) :: free #ifdef CCPP character(len=*), intent(inout) :: errmsg integer, intent(inout) :: errflg #endif - real :: bx,denom,df,dswl,fk,swl,swlk + real (kind=kind_phys) :: bx,denom,df,dswl,fk,swl,swlk integer :: nlog,kcount ! parameter(ck = 0.0) - real, parameter :: ck = 8.0, blim = 5.5, error = 0.005, & + real (kind=kind_phys), parameter :: ck = 8.0, blim = 5.5, error = 0.005, & dice = 920.0 character(len=80) :: message @@ -5602,12 +5775,12 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& ! simulations showed if b > 5.5 unfrozen water content is ! non-realistically high at very low temperatures. ! ---------------------------------------------------------------------- - bx = parameters%bexp + bx = parameters%bexp(isoil) ! ---------------------------------------------------------------------- ! initializing iterations counter and iterative solution flag. ! ---------------------------------------------------------------------- - if (parameters%bexp > blim) bx = blim + if (parameters%bexp(isoil) > blim) bx = blim nlog = 0 ! ---------------------------------------------------------------------- @@ -5636,8 +5809,8 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& 1001 continue if (.not.( (nlog < 10) .and. (kcount == 0))) goto 1002 nlog = nlog +1 - df = alog ( ( parameters%psisat * grav / hfus ) * ( ( 1. + ck * swl )**2.) * & - ( parameters%smcmax / (smc - swl) )** bx) - alog ( - ( & + df = alog ( ( parameters%psisat(isoil) * grav / hfus ) * ( ( 1. + ck * swl )**2.) * & + ( parameters%smcmax(isoil) / (smc - swl) )** bx) - alog ( - ( & tkelv - tfrz)/ tkelv) denom = 2. * ck / ( 1. + ck * swl ) + bx / ( smc - swl ) swlk = swl - df / denom @@ -5682,8 +5855,8 @@ subroutine frh2o (parameters,free,tkelv,smc,sh2o,& #else call wrf_message(trim(message)) #endif - fk = ( ( (hfus / (grav * ( - parameters%psisat)))* & - ( (tkelv - tfrz)/ tkelv))** ( -1/ bx))* parameters%smcmax + fk = ( ( (hfus / (grav * ( - parameters%psisat(isoil))))* & + ( (tkelv - tfrz)/ tkelv))** ( -1/ bx))* parameters%smcmax(isoil) if (fk < 0.02) fk = 0.02 free = min (fk, smc) ! ---------------------------------------------------------------------- @@ -5729,91 +5902,91 @@ subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & integer , intent(in) :: ist !surface type 1-soil; 2-lake integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [1-melt; 2-freeze] - real, intent(in) :: dt !main time step (s) - real, intent(in) :: uu !u-direction wind speed [m/s] - real, intent(in) :: vv !v-direction wind speed [m/s] - real, intent(in) :: fcev !canopy evaporation (w/m2) [+ to atm ] - real, intent(in) :: fctr !transpiration (w/m2) [+ to atm] - real, intent(in) :: qprecc !convective precipitation (mm/s) - real, intent(in) :: qprecl !large-scale precipitation (mm/s) - real, intent(in) :: elai !leaf area index, after burying by snow - real, intent(in) :: esai !stem area index, after burying by snow - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: qvap !soil surface evaporation rate[mm/s] - real, intent(in) :: qdew !soil surface dew rate[mm/s] - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface - real, dimension( 1:nsoil), intent(in) :: btrani !soil water stress factor (0 to 1) - real, dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep -! real , intent(in) :: ponding ![mm] - real , intent(in) :: tg !ground temperature (k) - real , intent(in) :: fveg !greeness vegetation fraction (-) - real , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 - real , intent(in) :: fp !fraction of the gridcell that receives precipitation ! mb/an: v3.7 - real , intent(in) :: rain !rainfall (mm/s) ! mb/an: v3.7 - real , intent(in) :: snow !snowfall (mm/s) ! mb/an: v3.7 - real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] (used in m-m&f groundwater dynamics) - real , intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real , intent(in) :: qrain !rain at ground srf (mm) [+] - real , intent(in) :: snowhin !snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: uu !u-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: vv !v-direction wind speed [m/s] + real (kind=kind_phys), intent(in) :: fcev !canopy evaporation (w/m2) [+ to atm ] + real (kind=kind_phys), intent(in) :: fctr !transpiration (w/m2) [+ to atm] + real (kind=kind_phys), intent(in) :: qprecc !convective precipitation (mm/s) + real (kind=kind_phys), intent(in) :: qprecl !large-scale precipitation (mm/s) + real (kind=kind_phys), intent(in) :: elai !leaf area index, after burying by snow + real (kind=kind_phys), intent(in) :: esai !stem area index, after burying by snow + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: qvap !soil surface evaporation rate[mm/s] + real (kind=kind_phys), intent(in) :: qdew !soil surface dew rate[mm/s] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: btrani !soil water stress factor (0 to 1) + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold !ice fraction at last timestep +! real (kind=kind_phys) , intent(in) :: ponding ![mm] + real (kind=kind_phys) , intent(in) :: tg !ground temperature (k) + real (kind=kind_phys) , intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys) , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: fp !fraction of the gridcell that receives precipitation ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: rain !rainfall (mm/s) ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: snow !snowfall (mm/s) ! mb/an: v3.7 + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] (used in m-m&f groundwater dynamics) + real (kind=kind_phys) , intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys) , intent(in) :: qrain !rain at ground srf (mm) [+] + real (kind=kind_phys) , intent(in) :: snowhin !snow depth increasing rate (m/s) ! input/output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: canliq !intercepted liquid water (mm) - real, intent(inout) :: canice !intercepted ice mass (mm) - real, intent(inout) :: tv !vegetation temperature (k) - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] - real, intent(inout) :: zwt !the depth to water table [m] - real, intent(inout) :: wa !water storage in aquifer [mm] - real, intent(inout) :: wt !water storage in aquifer + real (kind=kind_phys), intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow/soil layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real (kind=kind_phys), intent(inout) :: zwt !the depth to water table [m] + real (kind=kind_phys), intent(inout) :: wa !water storage in aquifer [mm] + real (kind=kind_phys), intent(inout) :: wt !water storage in aquifer !+ stuarated soil [mm] - real, intent(inout) :: wslake !water storage in lake (can be -) (mm) - real , intent(inout) :: ponding ![mm] - real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] - real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] - real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) + real (kind=kind_phys), intent(inout) :: wslake !water storage in lake (can be -) (mm) + real (kind=kind_phys) , intent(inout) :: ponding ![mm] + real (kind=kind_phys), intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] + real (kind=kind_phys), intent(inout) :: deeprech !recharge to or from the water table when deep [m] + real (kind=kind_phys), intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) ! output - real, intent(out) :: cmc !intercepted water per ground area (mm) - real, intent(out) :: ecan !evap of intercepted water (mm/s) [+] - real, intent(out) :: etran !transpiration rate (mm/s) [+] - real, intent(out) :: fwet !wetted/snowed fraction of canopy (-) - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: runsub !baseflow (sturation excess) [mm/s] - real, intent(out) :: qin !groundwater recharge [mm/s] - real, intent(out) :: qdis !groundwater discharge [mm/s] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 - real, intent(out) :: esnow - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real , intent(in) :: latheav !latent heat vap./sublimation (j/kg) - real , intent(in) :: latheag !latent heat vap./sublimation (j/kg) + real (kind=kind_phys), intent(out) :: cmc !intercepted water per ground area (mm) + real (kind=kind_phys), intent(out) :: ecan !evap of intercepted water (mm/s) [+] + real (kind=kind_phys), intent(out) :: etran !transpiration rate (mm/s) [+] + real (kind=kind_phys), intent(out) :: fwet !wetted/snowed fraction of canopy (-) + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: runsub !baseflow (sturation excess) [mm/s] + real (kind=kind_phys), intent(out) :: qin !groundwater recharge [mm/s] + real (kind=kind_phys), intent(out) :: qdis !groundwater discharge [mm/s] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: esnow + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys) , intent(in) :: latheav !latent heat vap./sublimation (j/kg) + real (kind=kind_phys) , intent(in) :: latheag !latent heat vap./sublimation (j/kg) logical , intent(in) :: frozen_ground ! used to define latent heat pathway logical , intent(in) :: frozen_canopy ! used to define latent heat pathway ! local integer :: iz - real :: qinsur !water input on soil surface [m/s] - real :: qseva !soil surface evap rate [mm/s] - real :: qsdew !soil surface dew rate [mm/s] - real :: qsnfro !snow surface frost rate[mm/s] - real :: qsnsub !snow surface sublimation rate [mm/s] - real, dimension( 1:nsoil) :: etrani !transpiration rate (mm/s) [+] - real, dimension( 1:nsoil) :: wcnd !hydraulic conductivity (m/s) - real :: qdrain !soil-bottom free drainage [mm/s] - real :: snoflow !glacier flow [mm/s] - real :: fcrmax !maximum of fcr (-) + real (kind=kind_phys) :: qinsur !water input on soil surface [m/s] + real (kind=kind_phys) :: qseva !soil surface evap rate [mm/s] + real (kind=kind_phys) :: qsdew !soil surface dew rate [mm/s] + real (kind=kind_phys) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys) :: qsnsub !snow surface sublimation rate [mm/s] + real (kind=kind_phys), dimension( 1:nsoil) :: etrani !transpiration rate (mm/s) [+] + real (kind=kind_phys), dimension( 1:nsoil) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys) :: qdrain !soil-bottom free drainage [mm/s] + real (kind=kind_phys) :: snoflow !glacier flow [mm/s] + real (kind=kind_phys) :: fcrmax !maximum of fcr (-) - real, parameter :: wslmax = 5000. !maximum lake water storage (mm) + real (kind=kind_phys), parameter :: wslmax = 5000. !maximum lake water storage (mm) ! ---------------------------------------------------------------------- @@ -5841,7 +6014,7 @@ subroutine water (parameters,vegtyp ,nsnow ,nsoil ,imelt ,dt ,uu , & qsnsub = min(qvap, sneqv/dt) endif qseva = qvap-qsnsub - esnow = qsnsub*2.83e+6 + esnow = qsnsub*hsub qsnfro = 0. if (sneqv > 0.) then @@ -5951,38 +6124,38 @@ subroutine canwater (parameters,vegtyp ,dt , & !in integer,intent(in) :: iloc !grid index integer,intent(in) :: jloc !grid index integer,intent(in) :: vegtyp !vegetation type - real, intent(in) :: dt !main time step (s) - real, intent(in) :: fcev !canopy evaporation (w/m2) [+ = to atm] - real, intent(in) :: fctr !transpiration (w/m2) [+ = to atm] - real, intent(in) :: elai !leaf area index, after burying by snow - real, intent(in) :: esai !stem area index, after burying by snow - real, intent(in) :: tg !ground temperature (k) - real, intent(in) :: fveg !greeness vegetation fraction (-) + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: fcev !canopy evaporation (w/m2) [+ = to atm] + real (kind=kind_phys), intent(in) :: fctr !transpiration (w/m2) [+ = to atm] + real (kind=kind_phys), intent(in) :: elai !leaf area index, after burying by snow + real (kind=kind_phys), intent(in) :: esai !stem area index, after burying by snow + real (kind=kind_phys), intent(in) :: tg !ground temperature (k) + real (kind=kind_phys), intent(in) :: fveg !greeness vegetation fraction (-) logical , intent(in) :: frozen_canopy ! used to define latent heat pathway - real , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 + real (kind=kind_phys) , intent(in) :: bdfall !bulk density of snowfall (kg/m3) ! mb/an: v3.7 ! input & output - real, intent(inout) :: canliq !intercepted liquid water (mm) - real, intent(inout) :: canice !intercepted ice mass (mm) - real, intent(inout) :: tv !vegetation temperature (k) + real (kind=kind_phys), intent(inout) :: canliq !intercepted liquid water (mm) + real (kind=kind_phys), intent(inout) :: canice !intercepted ice mass (mm) + real (kind=kind_phys), intent(inout) :: tv !vegetation temperature (k) ! output - real, intent(out) :: cmc !intercepted water (mm) - real, intent(out) :: ecan !evaporation of intercepted water (mm/s) [+] - real, intent(out) :: etran !transpiration rate (mm/s) [+] - real, intent(out) :: fwet !wetted or snowed fraction of the canopy (-) + real (kind=kind_phys), intent(out) :: cmc !intercepted water (mm) + real (kind=kind_phys), intent(out) :: ecan !evaporation of intercepted water (mm/s) [+] + real (kind=kind_phys), intent(out) :: etran !transpiration rate (mm/s) [+] + real (kind=kind_phys), intent(out) :: fwet !wetted or snowed fraction of the canopy (-) ! -------------------------------------------------------------------- ! ------------------------ local variables --------------------------- - real :: maxsno !canopy capacity for snow interception (mm) - real :: maxliq !canopy capacity for rain interception (mm) - real :: qevac !evaporation rate (mm/s) - real :: qdewc !dew rate (mm/s) - real :: qfroc !frost rate (mm/s) - real :: qsubc !sublimation rate (mm/s) - real :: qmeltc !melting rate of canopy snow (mm/s) - real :: qfrzc !refreezing rate of canopy liquid water (mm/s) - real :: canmas !total canopy mass (kg/m2) + real (kind=kind_phys) :: maxsno !canopy capacity for snow interception (mm) + real (kind=kind_phys) :: maxliq !canopy capacity for rain interception (mm) + real (kind=kind_phys) :: qevac !evaporation rate (mm/s) + real (kind=kind_phys) :: qdewc !dew rate (mm/s) + real (kind=kind_phys) :: qfroc !frost rate (mm/s) + real (kind=kind_phys) :: qsubc !sublimation rate (mm/s) + real (kind=kind_phys) :: qmeltc !melting rate of canopy snow (mm/s) + real (kind=kind_phys) :: qfrzc !refreezing rate of canopy liquid water (mm/s) + real (kind=kind_phys) :: canmas !total canopy mass (kg/m2) ! -------------------------------------------------------------------- ! initialization @@ -6082,37 +6255,37 @@ subroutine snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (s) - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface - real, intent(in) :: sfctmp !surface air temperature [k] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] - real, dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), intent(in) :: dt !time step (s) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(in) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), dimension(-nsnow+1:0) , intent(in) :: ficeold!ice fraction at last timestep ! input & output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso !depth of snow/soil layer-bottom + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !snow/soil layer thickness [m] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] - real, intent(out) :: snoflow!glacier flow [mm] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: snoflow!glacier flow [mm] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 ! local integer :: iz,i - real :: bdsnow !bulk density of snow (kg/m3) + real (kind=kind_phys) :: bdsnow !bulk density of snow (kg/m3) ! ---------------------------------------------------------------------- snoflow = 0.0 ponding1 = 0.0 @@ -6158,9 +6331,9 @@ subroutine snowwater (parameters,nsnow ,nsoil ,imelt ,dt ,zsoil , & !in !to obtain equilibrium state of snow in glacier region - if(sneqv > 2000.) then ! 2000 mm -> maximum water depth + if(sneqv > 5000.) then ! 5000 mm -> maximum water depth bdsnow = snice(0) / dzsnso(0) - snoflow = (sneqv - 2000.) + snoflow = (sneqv - 5000.) snice(0) = snice(0) - snoflow dzsnso(0) = dzsnso(0) - snoflow/bdsnow snoflow = snoflow / dt @@ -6217,20 +6390,20 @@ subroutine snowfall (parameters,nsoil ,nsnow ,dt ,qsnow ,snowhin , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, intent(in) :: dt !main time step (s) - real, intent(in) :: qsnow !snow at ground srf (mm/s) [+] - real, intent(in) :: snowhin!snow depth increasing rate (m/s) - real, intent(in) :: sfctmp !surface air temperature [k] + real (kind=kind_phys), intent(in) :: dt !main time step (s) + real (kind=kind_phys), intent(in) :: qsnow !snow at ground srf (mm/s) [+] + real (kind=kind_phys), intent(in) :: snowhin!snow depth increasing rate (m/s) + real (kind=kind_phys), intent(in) :: sfctmp !surface air temperature [k] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, intent(inout) :: snowh !snow depth [m] - real, intent(inout) :: sneqv !swow water equivalent [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !swow water equivalent [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso !thickness of snow/soil layers (m) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] ! local @@ -6289,16 +6462,16 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] - real, intent(inout) :: sneqv !snow water equivalent [m] - real, intent(inout) :: snowh !snow depth [m] - real, intent(out) :: ponding1 - real, intent(out) :: ponding2 + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water equivalent [m] + real (kind=kind_phys), intent(inout) :: snowh !snow depth [m] + real (kind=kind_phys), intent(out) :: ponding1 + real (kind=kind_phys), intent(out) :: ponding2 ! local variables: @@ -6306,10 +6479,10 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in integer :: isnow_old ! number of top snow layer integer :: mssi ! node index integer :: neibor ! adjacent node selected for combination - real :: zwice ! total ice mass in snow - real :: zwliq ! total liquid water in snow + real (kind=kind_phys) :: zwice ! total ice mass in snow + real (kind=kind_phys) :: zwliq ! total liquid water in snow - real :: dzmin(3) ! minimum of top snow layer + real (kind=kind_phys) :: dzmin(3) ! minimum of top snow layer ! data dzmin /0.045, 0.05, 0.2/ data dzmin /0.025, 0.025, 0.1/ ! mb: change limit !----------------------------------------------------------------------- @@ -6321,10 +6494,12 @@ subroutine combine (parameters,nsnow ,nsoil ,iloc ,jloc , & !in if(j /= 0) then snliq(j+1) = snliq(j+1) + snliq(j) snice(j+1) = snice(j+1) + snice(j) + dzsnso(j+1) = dzsnso(j+1) + dzsnso(j) else if (isnow_old < -1) then ! mb/km: change to isnow snliq(j-1) = snliq(j-1) + snliq(j) snice(j-1) = snice(j-1) + snice(j) + dzsnso(j-1) = dzsnso(j-1) + dzsnso(j) else if(snice(j) >= 0.) then ponding1 = snliq(j) ! isnow will get set to zero below; ponding1 will get @@ -6472,24 +6647,24 @@ subroutine divide (parameters,nsnow ,nsoil , & !in ! input and output integer , intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso!snow layer depth [m] ! local variables: integer :: j !indices integer :: msno !number of layer (top) to msno (bot) - real :: drr !thickness of the combined [m] - real, dimension( 1:nsnow) :: dz !snow layer thickness [m] - real, dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] - real, dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] - real, dimension( 1:nsnow) :: tsno !node temperature [k] - real :: zwice !temporary - real :: zwliq !temporary - real :: propor!temporary - real :: dtdz !temporary + real (kind=kind_phys) :: drr !thickness of the combined [m] + real (kind=kind_phys), dimension( 1:nsnow) :: dz !snow layer thickness [m] + real (kind=kind_phys), dimension( 1:nsnow) :: swice !partial volume of ice [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: swliq !partial volume of liquid water [m3/m3] + real (kind=kind_phys), dimension( 1:nsnow) :: tsno !node temperature [k] + real (kind=kind_phys) :: zwice !temporary + real (kind=kind_phys) :: zwliq !temporary + real (kind=kind_phys) :: propor!temporary + real (kind=kind_phys) :: dtdz !temporary ! ---------------------------------------------------------------------- do j = 1,nsnow @@ -6596,24 +6771,24 @@ subroutine combo(parameters,dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! input type (noahmp_parameters), intent(in) :: parameters - real, intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] - real, intent(in) :: wliq2 !liquid water of element 2 [kg/m2] - real, intent(in) :: wice2 !ice of element 2 [kg/m2] - real, intent(in) :: t2 !nodal temperature of element 2 [k] - real, intent(inout) :: dz !nodal thickness of 1 elements being combined [m] - real, intent(inout) :: wliq !liquid water of element 1 - real, intent(inout) :: wice !ice of element 1 [kg/m2] - real, intent(inout) :: t !node temperature of element 1 [k] + real (kind=kind_phys), intent(in) :: dz2 !nodal thickness of 2 elements being combined [m] + real (kind=kind_phys), intent(in) :: wliq2 !liquid water of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: wice2 !ice of element 2 [kg/m2] + real (kind=kind_phys), intent(in) :: t2 !nodal temperature of element 2 [k] + real (kind=kind_phys), intent(inout) :: dz !nodal thickness of 1 elements being combined [m] + real (kind=kind_phys), intent(inout) :: wliq !liquid water of element 1 + real (kind=kind_phys), intent(inout) :: wice !ice of element 1 [kg/m2] + real (kind=kind_phys), intent(inout) :: t !node temperature of element 1 [k] ! local - real :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). - real :: wliqc !combined liquid water [kg/m2] - real :: wicec !combined ice [kg/m2] - real :: tc !combined node temperature [k] - real :: h !enthalpy of element 1 [j/m2] - real :: h2 !enthalpy of element 2 [j/m2] - real :: hc !temporary + real (kind=kind_phys) :: dzc !total thickness of nodes 1 and 2 (dzc=dz+dz2). + real (kind=kind_phys) :: wliqc !combined liquid water [kg/m2] + real (kind=kind_phys) :: wicec !combined ice [kg/m2] + real (kind=kind_phys) :: tc !combined node temperature [k] + real (kind=kind_phys) :: h !enthalpy of element 1 [j/m2] + real (kind=kind_phys) :: h2 !enthalpy of element 2 [j/m2] + real (kind=kind_phys) :: hc !temporary !----------------------------------------------------------------------- @@ -6655,37 +6830,37 @@ subroutine compact (parameters,nsnow ,nsoil ,dt ,stc ,snice , & !in integer, intent(in) :: nsoil !no. of soil layers [ =4] integer, intent(in) :: nsnow !maximum no. of snow layers [ =3] integer, dimension(-nsnow+1:0) , intent(in) :: imelt !melting state index [0-no melt;1-melt] - real, intent(in) :: dt !time step (sec) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] - real, dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil srf - real, dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil srf + real (kind=kind_phys), dimension(-nsnow+1: 0), intent(in) :: ficeold!ice fraction at last timestep ! input and output integer, intent(inout) :: isnow ! actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(inout) :: zsnso ! depth of snow/soil layer-bottom + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: zsnso ! depth of snow/soil layer-bottom ! local - real, parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 - real, parameter :: c3 = 2.5e-6 ![1/s] - real, parameter :: c4 = 0.04 ![1/k] - real, parameter :: c5 = 2.0 ! - real, parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] - real, parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] + real (kind=kind_phys), parameter :: c2 = 21.e-3 ![m3/kg] ! default 21.e-3 + real (kind=kind_phys), parameter :: c3 = 2.5e-6 ![1/s] + real (kind=kind_phys), parameter :: c4 = 0.04 ![1/k] + real (kind=kind_phys), parameter :: c5 = 2.0 ! + real (kind=kind_phys), parameter :: dm = 100.0 !upper limit on destructive metamorphism compaction [kg/m3] + real (kind=kind_phys), parameter :: eta0 = 0.8e+6 !viscosity coefficient [kg-s/m2] !according to anderson, it is between 0.52e6~1.38e6 - real :: burden !pressure of overlying snow [kg/m2] - real :: ddz1 !rate of settling of snow pack due to destructive metamorphism. - real :: ddz2 !rate of compaction of snow pack due to overburden. - real :: ddz3 !rate of compaction of snow pack due to melt [1/s] - real :: dexpf !expf=exp(-c4*(273.15-stc)). - real :: td !stc - tfrz [k] - real :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] - real :: void !void (1 - snice - snliq) - real :: wx !water mass (ice + liquid) [kg/m2] - real :: bi !partial density of ice [kg/m3] - real, dimension(-nsnow+1:0) :: fice !fraction of ice at current time step + real (kind=kind_phys) :: burden !pressure of overlying snow [kg/m2] + real (kind=kind_phys) :: ddz1 !rate of settling of snow pack due to destructive metamorphism. + real (kind=kind_phys) :: ddz2 !rate of compaction of snow pack due to overburden. + real (kind=kind_phys) :: ddz3 !rate of compaction of snow pack due to melt [1/s] + real (kind=kind_phys) :: dexpf !expf=exp(-c4*(273.15-stc)). + real (kind=kind_phys) :: td !stc - tfrz [k] + real (kind=kind_phys) :: pdzdtc !nodal rate of change in fractional-thickness due to compaction [fraction/s] + real (kind=kind_phys) :: void !void (1 - snice - snliq) + real (kind=kind_phys) :: wx !water mass (ice + liquid) [kg/m2] + real (kind=kind_phys) :: bi !partial density of ice [kg/m3] + real (kind=kind_phys), dimension(-nsnow+1:0) :: fice !fraction of ice at current time step integer :: j @@ -6735,6 +6910,7 @@ subroutine compact (parameters,nsnow ,nsoil ,dt ,stc ,snice , & !in ! the change in dz due to compaction dzsnso(j) = dzsnso(j)*(1.+pdzdtc) + dzsnso(j) = max(dzsnso(j),snice(j)/denice + snliq(j)/denh2o) end if ! pressure of overlying snow @@ -6766,38 +6942,39 @@ subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsnow !maximum no. of snow layers[=3] integer, intent(in) :: nsoil !no. of soil layers[=4] - real, intent(in) :: dt !time step - real, intent(in) :: qsnfro !snow surface frost rate[mm/s] - real, intent(in) :: qsnsub !snow surface sublimation rate[mm/s] - real, intent(in) :: qrain !snow surface rain rate[mm/s] + real (kind=kind_phys), intent(in) :: dt !time step + real (kind=kind_phys), intent(in) :: qsnfro !snow surface frost rate[mm/s] + real (kind=kind_phys), intent(in) :: qsnsub !snow surface sublimation rate[mm/s] + real (kind=kind_phys), intent(in) :: qrain !snow surface rain rate[mm/s] ! output - real, intent(out) :: qsnbot !melting water out of snow bottom [mm/s] + real (kind=kind_phys), intent(out) :: qsnbot !melting water out of snow bottom [mm/s] ! input and output integer, intent(inout) :: isnow !actual no. of snow layers - real, dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] - real, intent(inout) :: snowh !snow height [m] - real, intent(inout) :: sneqv !snow water eqv. [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] - real, dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] - real, dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) - real, dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) - real, dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: dzsnso ! snow layer depth [m] + real (kind=kind_phys), intent(inout) :: snowh !snow height [m] + real (kind=kind_phys), intent(inout) :: sneqv !snow water eqv. [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snice !snow layer ice [mm] + real (kind=kind_phys), dimension(-nsnow+1:0), intent(inout) :: snliq !snow layer liquid water [mm] + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !soil liquid moisture (m3/m3) + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sice !soil ice moisture (m3/m3) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(inout) :: stc !snow layer temperature [k] ! local variables: integer :: j !do loop/array indices - real :: qin !water flow into the element (mm/s) - real :: qout !water flow out of the element (mm/s) - real :: wgdif !ice mass after minus sublimation - real, dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer - real, dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer - real, dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice - real :: propor, temp - real :: ponding1, ponding2 + real (kind=kind_phys) :: qin !water flow into the element (mm/s) + real (kind=kind_phys) :: qout !water flow out of the element (mm/s) + real (kind=kind_phys) :: wgdif !ice mass after minus sublimation + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_liq !partial volume of liquid water in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: vol_ice !partial volume of ice lens in layer + real (kind=kind_phys), dimension(-nsnow+1:0) :: epore !effective porosity = porosity - vol_ice + real (kind=kind_phys) :: propor, temp + real (kind=kind_phys) :: ponding1, ponding2 + REAL, PARAMETER :: max_liq_mass_fraction = 0.4 ! ---------------------------------------------------------------------- !for the case when sneqv becomes '0' after 'combine' @@ -6820,6 +6997,7 @@ subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in sneqv = sneqv - qsnsub*dt + qsnfro*dt propor = sneqv/temp snowh = max(0.,propor * snowh) + snowh = min(max(snowh,sneqv/500.0),sneqv/50.0) ! limit adjustment to a reasonable density if(sneqv < 0.) then sice(1) = sice(1) + sneqv/(dzsnso(1)*1000.) @@ -6859,38 +7037,32 @@ subroutine snowh2o (parameters,nsnow ,nsoil ,dt ,qsnfro ,qsnsub , & !in ! porosity and partial volume - !kwm looks to me like loop index / if test can be simplified. - - do j = -nsnow+1, 0 - if (j >= isnow+1) then - vol_ice(j) = min(1., snice(j)/(dzsnso(j)*denice)) - epore(j) = 1. - vol_ice(j) - vol_liq(j) = min(epore(j),snliq(j)/(dzsnso(j)*denh2o)) - end if + do j = isnow+1, 0 + vol_ice(j) = min(1., snice(j)/(dzsnso(j)*denice)) + epore(j) = 1. - vol_ice(j) end do qin = 0. qout = 0. - !kwm looks to me like loop index / if test can be simplified. + do j = isnow+1, 0 + snliq(j) = snliq(j) + qin + vol_liq(j) = snliq(j)/(dzsnso(j)*denh2o) + qout = max(0.,(vol_liq(j)-parameters%ssi*epore(j))*dzsnso(j)) + if(j == 0) then + qout = max((vol_liq(j)- epore(j))*dzsnso(j) , parameters%snow_ret_fac*dt*qout) + end if + qout = qout*denh2o + snliq(j) = snliq(j) - qout + if((snliq(j)/(snice(j)+snliq(j))) > max_liq_mass_fraction) then + qout = qout + (snliq(j) - max_liq_mass_fraction/(1.0 - max_liq_mass_fraction)*snice(j)) + snliq(j) = max_liq_mass_fraction/(1.0 - max_liq_mass_fraction)*snice(j) + endif + qin = qout + end do - do j = -nsnow+1, 0 - if (j >= isnow+1) then - snliq(j) = snliq(j) + qin - if (j <= -1) then - if (epore(j) < 0.05 .or. epore(j+1) < 0.05) then - qout = 0. - else - qout = max(0.,(vol_liq(j)-parameters%ssi*epore(j))*dzsnso(j)) - qout = min(qout,(1.-vol_ice(j+1)-vol_liq(j+1))*dzsnso(j+1)) - end if - else - qout = max(0.,(vol_liq(j) - parameters%ssi*epore(j))*dzsnso(j)) - end if - qout = qout*1000. - snliq(j) = snliq(j) - qout - qin = qout - end if + do j = isnow+1, 0 + dzsnso(j) = max(dzsnso(j),snliq(j)/denh2o + snice(j)/denice) end do ! liquid water from snow bottom to soil @@ -6920,60 +7092,61 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, intent(in) :: dt !time step (sec) - real, intent(in) :: qinsur !water input on soil surface [mm/s] - real, intent(in) :: qseva !evap from soil surface [mm/s] - real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(1:nsoil), intent(in) :: etrani !evapotranspiration from soil layers [mm/s] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] - real, dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), intent(in) :: qinsur !water input on soil surface [mm/s] + real (kind=kind_phys), intent(in) :: qseva !evap from soil surface [mm/s] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: etrani !evapotranspiration from soil layers [mm/s] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] integer, intent(in) :: vegtyp ! input & output - real, dimension(1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] - real, dimension(1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] - real, intent(inout) :: zwt !water table depth [m] - real, intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] - real , intent(inout) :: deeprech + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real (kind=kind_phys), intent(inout) :: zwt !water table depth [m] + real (kind=kind_phys), intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] + real (kind=kind_phys) , intent(inout) :: deeprech ! output - real, intent(out) :: qdrain !soil-bottom free drainage [mm/s] - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: runsub !subsurface runoff [mm/s] - real, intent(out) :: fcrmax !maximum of fcr (-) - real, dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys), intent(out) :: qdrain !soil-bottom free drainage [mm/s] + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: runsub !subsurface runoff [mm/s] + real (kind=kind_phys), intent(out) :: fcrmax !maximum of fcr (-) + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) ! local integer :: k,iz !do-loop index integer :: iter !iteration index - real :: dtfine !fine time step (s) - real, dimension(1:nsoil) :: rhstt !right-hand side term of the matrix - real, dimension(1:nsoil) :: ai !left-hand side term - real, dimension(1:nsoil) :: bi !left-hand side term - real, dimension(1:nsoil) :: ci !left-hand side term - - real :: fff !runoff decay factor (m-1) - real :: rsbmx !baseflow coefficient [mm/s] - real :: pddum !infiltration rate at surface (m/s) - real :: fice !ice fraction in frozen soil - real :: wplus !saturation excess of the total soil [m] - real :: rsat !accumulation of wplus (saturation excess) [m] - real :: sicemax!maximum soil ice content (m3/m3) - real :: sh2omin!minimum soil liquid water content (m3/m3) - real :: wtsub !sum of wcnd(k)*dzsnso(k) - real :: mh2o !water mass removal (mm) - real :: fsat !fractional saturated area (-) - real, dimension(1:nsoil) :: mliq ! - real :: xs ! - real :: watmin ! - real :: qdrain_save ! - real :: epore !effective porosity [m3/m3] - real, dimension(1:nsoil) :: fcr !impermeable fraction due to frozen soil + real (kind=kind_phys) :: dtfine !fine time step (s) + real (kind=kind_phys), dimension(1:nsoil) :: rhstt !right-hand side term of the matrix + real (kind=kind_phys), dimension(1:nsoil) :: ai !left-hand side term + real (kind=kind_phys), dimension(1:nsoil) :: bi !left-hand side term + real (kind=kind_phys), dimension(1:nsoil) :: ci !left-hand side term + + real (kind=kind_phys) :: fff !runoff decay factor (m-1) + real (kind=kind_phys) :: rsbmx !baseflow coefficient [mm/s] + real (kind=kind_phys) :: pddum !infiltration rate at surface (m/s) + real (kind=kind_phys) :: fice !ice fraction in frozen soil + real (kind=kind_phys) :: wplus !saturation excess of the total soil [m] + real (kind=kind_phys) :: rsat !accumulation of wplus (saturation excess) [m] + real (kind=kind_phys) :: sicemax!maximum soil ice content (m3/m3) + real (kind=kind_phys) :: sh2omin!minimum soil liquid water content (m3/m3) + real (kind=kind_phys) :: wtsub !sum of wcnd(k)*dzsnso(k) + real (kind=kind_phys) :: mh2o !water mass removal (mm) + real (kind=kind_phys) :: fsat !fractional saturated area (-) + real (kind=kind_phys), dimension(1:nsoil) :: mliq ! + real (kind=kind_phys) :: xs ! + real (kind=kind_phys) :: watmin ! + real (kind=kind_phys) :: qdrain_save ! + real (kind=kind_phys) :: runsrf_save ! + real (kind=kind_phys) :: epore !effective porosity [m3/m3] + real (kind=kind_phys), dimension(1:nsoil) :: fcr !impermeable fraction due to frozen soil integer :: niter !iteration times soil moisture (-) - real :: smctot !2-m averaged soil moisture (m3/m3) - real :: dztot !2-m soil depth (m) - real, parameter :: a = 4.0 + real (kind=kind_phys) :: smctot !2-m averaged soil moisture (m3/m3) + real (kind=kind_phys) :: dztot !2-m soil depth (m) + real (kind=kind_phys), parameter :: a = 4.0 ! ---------------------------------------------------------------------- runsrf = 0.0 pddum = 0.0 @@ -6982,7 +7155,7 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in ! for the case when snowmelt water is too large do k = 1,nsoil - epore = max ( 1.e-4 , ( parameters%smcmax - sice(k) ) ) + epore = max ( 1.e-4 , ( parameters%smcmax(k) - sice(k) ) ) rsat = rsat + max(0.,sh2o(k)-epore)*dzsnso(k) sh2o(k) = min(epore,sh2o(k)) end do @@ -6990,7 +7163,7 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in !impermeable fraction due to frozen soil do k = 1,nsoil - fice = min(1.0,sice(k)/parameters%smcmax) + fice = min(1.0,sice(k)/parameters%smcmax(k)) fcr(k) = max(0.0,exp(-a*(1.-fice))- exp(-a)) / & (1.0 - exp(-a)) end do @@ -6999,7 +7172,7 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in sicemax = 0.0 fcrmax = 0.0 - sh2omin = parameters%smcmax + sh2omin = parameters%smcmax(1) do k = 1,nsoil if (sice(k) > sicemax) sicemax = sice(k) if (fcr(k) > fcrmax) fcrmax = fcr(k) @@ -7058,11 +7231,11 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in dztot = 0. do k = 1,nsoil dztot = dztot + dzsnso(k) - smctot = smctot + smc(k)*dzsnso(k) + smctot = smctot + smc(k)/parameters%smcmax(k)*dzsnso(k) if(dztot >= 2.0) exit end do smctot = smctot/dztot - fsat = max(0.01,smctot/parameters%smcmax) ** 4. !bats + fsat = max(0.01,smctot) ** 4. !bats if(qinsur > 0.) then runsrf = qinsur * ((1.0-fcr(1))*fsat+fcr(1)) @@ -7074,19 +7247,26 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in niter = 1 - if(opt_inf == 1) then !opt_inf =2 may cause water imbalance +! if(opt_inf == 1) then !opt_inf =2 may cause water imbalance niter = 3 - if (pddum*dt>dzsnso(1)*parameters%smcmax ) then + if (pddum*dt>dzsnso(1)*parameters%smcmax(1) ) then niter = niter*2 end if - end if +! end if dtfine = dt / niter ! solve soil moisture qdrain_save = 0.0 + runsrf_save = 0.0 do iter = 1, niter + if(qinsur > 0. .and. opt_run == 3) then + call infil (parameters,nsoil ,dtfine ,zsoil ,sh2o ,sice , & !in + sicemax,qinsur , & !in + pddum ,runsrf ) !out + end if + call srt (parameters,nsoil ,zsoil ,dtfine ,pddum ,etrani , & !in qseva ,sh2o ,smc ,zwt ,fcr , & !in sicemax,fcrmax ,iloc ,jloc ,smcwtd , & !in @@ -7100,9 +7280,11 @@ subroutine soilwater (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in wplus) !out rsat = rsat + wplus qdrain_save = qdrain_save + qdrain + runsrf_save = runsrf_save + runsrf end do qdrain = qdrain_save/niter + runsrf = runsrf_save/niter runsrf = runsrf * 1000. + rsat * 1000./dt ! m/s -> mm/s qdrain = qdrain * 1000. @@ -7174,28 +7356,28 @@ subroutine zwteq (parameters,nsoil ,nsnow ,zsoil ,dzsnso ,sh2o ,zwt) type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: nsnow !maximum no. of snow layers - real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] - real, dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer depth [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] ! output - real, intent(out) :: zwt !water table depth [m] + real (kind=kind_phys), intent(out) :: zwt !water table depth [m] ! locals integer :: k !do-loop index integer, parameter :: nfine = 100 !no. of fine soil layers of 6m soil - real :: wd1 !water deficit from coarse (4-l) soil moisture profile - real :: wd2 !water deficit from fine (100-l) soil moisture profile - real :: dzfine !layer thickness of the 100-l soil layers to 6.0 m - real :: temp !temporary variable - real, dimension(1:nfine) :: zfine !layer-bottom depth of the 100-l soil layers to 6.0 m + real (kind=kind_phys) :: wd1 !water deficit from coarse (4-l) soil moisture profile + real (kind=kind_phys) :: wd2 !water deficit from fine (100-l) soil moisture profile + real (kind=kind_phys) :: dzfine !layer thickness of the 100-l soil layers to 6.0 m + real (kind=kind_phys) :: temp !temporary variable + real (kind=kind_phys), dimension(1:nfine) :: zfine !layer-bottom depth of the 100-l soil layers to 6.0 m ! ---------------------------------------------------------------------- wd1 = 0. do k = 1,nsoil - wd1 = wd1 + (parameters%smcmax-sh2o(k)) * dzsnso(k) ! [m] + wd1 = wd1 + (parameters%smcmax(1)-sh2o(k)) * dzsnso(k) ! [m] enddo dzfine = 3.0 * (-zsoil(nsoil)) / nfine @@ -7207,8 +7389,8 @@ subroutine zwteq (parameters,nsoil ,nsnow ,zsoil ,dzsnso ,sh2o ,zwt) wd2 = 0. do k = 1,nfine - temp = 1. + (zwt-zfine(k))/parameters%psisat - wd2 = wd2 + parameters%smcmax*(1.-temp**(-1./parameters%bexp))*dzfine + temp = 1. + (zwt-zfine(k))/parameters%psisat(1) + wd2 = wd2 + parameters%smcmax(1)*(1.-temp**(-1./parameters%bexp(1)))*dzfine if(abs(wd2-wd1).le.0.01) then zwt = zfine(k) exit @@ -7231,50 +7413,50 @@ subroutine infil (parameters,nsoil ,dt ,zsoil ,sh2o ,sice , & !in ! inputs type (noahmp_parameters), intent(in) :: parameters integer, intent(in) :: nsoil !no. of soil layers - real, intent(in) :: dt !time step (sec) - real, dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] - real, dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] - real, intent(in) :: qinsur !water input on soil surface [mm/s] - real, intent(in) :: sicemax!maximum soil ice content (m3/m3) + real (kind=kind_phys), intent(in) :: dt !time step (sec) + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sh2o !soil liquid water content [m3/m3] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), intent(in) :: qinsur !water input on soil surface [mm/s] + real (kind=kind_phys), intent(in) :: sicemax!maximum soil ice content (m3/m3) ! outputs - real, intent(out) :: runsrf !surface runoff [mm/s] - real, intent(out) :: pddum !infiltration rate at surface + real (kind=kind_phys), intent(out) :: runsrf !surface runoff [mm/s] + real (kind=kind_phys), intent(out) :: pddum !infiltration rate at surface ! locals integer :: ialp1, j, jj, k - real :: val - real :: ddt - real :: px - real :: dt1, dd, dice - real :: fcr - real :: sum - real :: acrt - real :: wdf - real :: wcnd - real :: smcav - real :: infmax - real, dimension(1:nsoil) :: dmax + real (kind=kind_phys) :: val + real (kind=kind_phys) :: ddt + real (kind=kind_phys) :: px + real (kind=kind_phys) :: dt1, dd, dice + real (kind=kind_phys) :: fcr + real (kind=kind_phys) :: sum + real (kind=kind_phys) :: acrt + real (kind=kind_phys) :: wdf + real (kind=kind_phys) :: wcnd + real (kind=kind_phys) :: smcav + real (kind=kind_phys) :: infmax + real (kind=kind_phys), dimension(1:nsoil) :: dmax integer, parameter :: cvfrz = 3 ! -------------------------------------------------------------------------------- if (qinsur > 0.0) then dt1 = dt /86400. - smcav = parameters%smcmax - parameters%smcwlt + smcav = parameters%smcmax(1) - parameters%smcwlt(1) ! maximum infiltration rate dmax(1)= -zsoil(1) * smcav dice = -zsoil(1) * sice(1) - dmax(1)= dmax(1)* (1.0-(sh2o(1) + sice(1) - parameters%smcwlt)/smcav) + dmax(1)= dmax(1)* (1.0-(sh2o(1) + sice(1) - parameters%smcwlt(1))/smcav) dd = dmax(1) do k = 2,nsoil dice = dice + (zsoil(k-1) - zsoil(k) ) * sice(k) dmax(k) = (zsoil(k-1) - zsoil(k)) * smcav - dmax(k) = dmax(k) * (1.0-(sh2o(k) + sice(k) - parameters%smcwlt)/smcav) + dmax(k) = dmax(k) * (1.0-(sh2o(k) + sice(k) - parameters%smcwlt(k))/smcav) dd = dd + dmax(k) end do @@ -7307,7 +7489,7 @@ subroutine infil (parameters,nsoil ,dt ,zsoil ,sh2o ,sice , & !in ! jref for urban areas ! if ( parameters%urban_flag ) infmax == infmax * 0.05 - call wdfcnd2 (parameters,wdf,wcnd,sh2o(1),sicemax) + call wdfcnd2 (parameters,wdf,wcnd,sh2o(1),sicemax,1) infmax = max (infmax,wcnd) infmax = min (infmax,px) @@ -7339,46 +7521,46 @@ subroutine srt (parameters,nsoil ,zsoil ,dt ,pddum ,etrani , & !in integer, intent(in) :: iloc !grid index integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil - real, dimension(1:nsoil), intent(in) :: zsoil - real, intent(in) :: dt - real, intent(in) :: pddum - real, intent(in) :: qseva - real, dimension(1:nsoil), intent(in) :: etrani - real, dimension(1:nsoil), intent(in) :: sh2o - real, dimension(1:nsoil), intent(in) :: smc - real, intent(in) :: zwt ! water table depth [m] - real, dimension(1:nsoil), intent(in) :: fcr - real, intent(in) :: fcrmax !maximum of fcr (-) - real, intent(in) :: sicemax!maximum soil ice content (m3/m3) - real, intent(in) :: smcwtd !soil moisture between bottom of the soil and the water table + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: zsoil + real (kind=kind_phys), intent(in) :: dt + real (kind=kind_phys), intent(in) :: pddum + real (kind=kind_phys), intent(in) :: qseva + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: etrani + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: sh2o + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: smc + real (kind=kind_phys), intent(in) :: zwt ! water table depth [m] + real (kind=kind_phys), dimension(1:nsoil), intent(in) :: fcr + real (kind=kind_phys), intent(in) :: fcrmax !maximum of fcr (-) + real (kind=kind_phys), intent(in) :: sicemax!maximum soil ice content (m3/m3) + real (kind=kind_phys), intent(in) :: smcwtd !soil moisture between bottom of the soil and the water table ! output - real, dimension(1:nsoil), intent(out) :: rhstt - real, dimension(1:nsoil), intent(out) :: ai - real, dimension(1:nsoil), intent(out) :: bi - real, dimension(1:nsoil), intent(out) :: ci - real, dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) - real, intent(out) :: qdrain !bottom drainage (m/s) + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: rhstt + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: ai + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: bi + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: ci + real (kind=kind_phys), dimension(1:nsoil), intent(out) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys), intent(out) :: qdrain !bottom drainage (m/s) ! local integer :: k - real, dimension(1:nsoil) :: ddz - real, dimension(1:nsoil) :: denom - real, dimension(1:nsoil) :: dsmdz - real, dimension(1:nsoil) :: wflux - real, dimension(1:nsoil) :: wdf - real, dimension(1:nsoil) :: smx - real :: temp1 - real :: smxwtd !soil moisture between bottom of the soil and water table - real :: smxbot !soil moisture below bottom to calculate flux + real (kind=kind_phys), dimension(1:nsoil) :: ddz + real (kind=kind_phys), dimension(1:nsoil) :: denom + real (kind=kind_phys), dimension(1:nsoil) :: dsmdz + real (kind=kind_phys), dimension(1:nsoil) :: wflux + real (kind=kind_phys), dimension(1:nsoil) :: wdf + real (kind=kind_phys), dimension(1:nsoil) :: smx + real (kind=kind_phys) :: temp1 + real (kind=kind_phys) :: smxwtd !soil moisture between bottom of the soil and water table + real (kind=kind_phys) :: smxbot !soil moisture below bottom to calculate flux ! niu and yang (2006), j. of hydrometeorology ! ---------------------------------------------------------------------- if(opt_inf == 1) then do k = 1, nsoil - call wdfcnd1 (parameters,wdf(k),wcnd(k),smc(k),fcr(k)) + call wdfcnd1 (parameters,wdf(k),wcnd(k),smc(k),fcr(k),k) smx(k) = smc(k) end do if(opt_run == 5)smxwtd=smcwtd @@ -7386,7 +7568,7 @@ subroutine srt (parameters,nsoil ,zsoil ,dt ,pddum ,etrani , & !in if(opt_inf == 2) then do k = 1, nsoil - call wdfcnd2 (parameters,wdf(k),wcnd(k),sh2o(k),sicemax) + call wdfcnd2 (parameters,wdf(k),wcnd(k),sh2o(k),sicemax,k) smx(k) = sh2o(k) end do if(opt_run == 5)smxwtd=smcwtd*sh2o(nsoil)/smc(nsoil) !same liquid fraction as in the bottom layer @@ -7473,33 +7655,33 @@ subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsoil ! integer, intent(in) :: nsnow ! - real, intent(in) :: dt - real, intent(in) :: zwt - real, dimension( 1:nsoil), intent(in) :: zsoil - real, dimension( 1:nsoil), intent(in) :: sice - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] + real (kind=kind_phys), intent(in) :: dt + real (kind=kind_phys), intent(in) :: zwt + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sice + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] !input and output - real, dimension(1:nsoil), intent(inout) :: sh2o - real, dimension(1:nsoil), intent(inout) :: smc - real, dimension(1:nsoil), intent(inout) :: ai - real, dimension(1:nsoil), intent(inout) :: bi - real, dimension(1:nsoil), intent(inout) :: ci - real, dimension(1:nsoil), intent(inout) :: rhstt - real , intent(inout) :: smcwtd - real , intent(inout) :: qdrain - real , intent(inout) :: deeprech + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: sh2o + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: smc + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: ai + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: bi + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: ci + real (kind=kind_phys), dimension(1:nsoil), intent(inout) :: rhstt + real (kind=kind_phys) , intent(inout) :: smcwtd + real (kind=kind_phys) , intent(inout) :: qdrain + real (kind=kind_phys) , intent(inout) :: deeprech !output - real, intent(out) :: wplus !saturation excess water (m) + real (kind=kind_phys), intent(out) :: wplus !saturation excess water (m) !local integer :: k - real, dimension(1:nsoil) :: rhsttin - real, dimension(1:nsoil) :: ciin - real :: stot - real :: epore - real :: wminus + real (kind=kind_phys), dimension(1:nsoil) :: rhsttin + real (kind=kind_phys), dimension(1:nsoil) :: ciin + real (kind=kind_phys) :: stot + real (kind=kind_phys) :: epore + real (kind=kind_phys) :: wminus ! ---------------------------------------------------------------------- wplus = 0.0 @@ -7538,10 +7720,10 @@ subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in deeprech = deeprech + dt * qdrain else smcwtd = smcwtd + dt * qdrain / dzsnso(nsoil) - wplus = max((smcwtd-parameters%smcmax), 0.0) * dzsnso(nsoil) + wplus = max((smcwtd-parameters%smcmax(nsoil)), 0.0) * dzsnso(nsoil) wminus = max((1.e-4-smcwtd), 0.0) * dzsnso(nsoil) - smcwtd = max( min(smcwtd,parameters%smcmax) , 1.e-4) + smcwtd = max( min(smcwtd,parameters%smcmax(nsoil)) , 1.e-4) sh2o(nsoil) = sh2o(nsoil) + wplus/dzsnso(nsoil) !reduce fluxes at the bottom boundaries accordingly @@ -7552,22 +7734,38 @@ subroutine sstep (parameters,nsoil ,nsnow ,dt ,zsoil ,dzsnso , & !in endif do k = nsoil,2,-1 - epore = max ( 1.e-4 , ( parameters%smcmax - sice(k) ) ) + epore = max ( 1.e-4 , ( parameters%smcmax(k) - sice(k) ) ) wplus = max((sh2o(k)-epore), 0.0) * dzsnso(k) sh2o(k) = min(epore,sh2o(k)) sh2o(k-1) = sh2o(k-1) + wplus/dzsnso(k-1) end do - epore = max ( 1.e-4 , ( parameters%smcmax - sice(1) ) ) + epore = max ( 1.e-4 , ( parameters%smcmax(1) - sice(1) ) ) wplus = max((sh2o(1)-epore), 0.0) * dzsnso(1) sh2o(1) = min(epore,sh2o(1)) + if(wplus > 0.0) then + sh2o(2) = sh2o(2) + wplus/dzsnso(2) + do k = 2,nsoil-1 + epore = max ( 1.e-4 , ( parameters%smcmax(k) - sice(k) ) ) + wplus = max((sh2o(k)-epore), 0.0) * dzsnso(k) + sh2o(k) = min(epore,sh2o(k)) + sh2o(k+1) = sh2o(k+1) + wplus/dzsnso(k+1) + end do + + epore = max ( 1.e-4 , ( parameters%smcmax(nsoil) - sice(nsoil) ) ) + wplus = max((sh2o(nsoil)-epore), 0.0) * dzsnso(nsoil) + sh2o(nsoil) = min(epore,sh2o(nsoil)) + end if + + smc = sh2o + sice + end subroutine sstep !== begin wdfcnd1 ================================================================================== !>\ingroup NoahMP_LSM - subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr) + subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr,isoil) ! ---------------------------------------------------------------------- ! calculate soil water diffusivity and soil hydraulic conductivity. ! ---------------------------------------------------------------------- @@ -7575,30 +7773,31 @@ subroutine wdfcnd1 (parameters,wdf,wcnd,smc,fcr) ! ---------------------------------------------------------------------- ! input type (noahmp_parameters), intent(in) :: parameters - real,intent(in) :: smc - real,intent(in) :: fcr + real (kind=kind_phys),intent(in) :: smc + real (kind=kind_phys),intent(in) :: fcr + integer,intent(in) :: isoil ! output - real,intent(out) :: wcnd - real,intent(out) :: wdf + real (kind=kind_phys),intent(out) :: wcnd + real (kind=kind_phys),intent(out) :: wdf ! local - real :: expon - real :: factr - real :: vkwgt + real (kind=kind_phys) :: expon + real (kind=kind_phys) :: factr + real (kind=kind_phys) :: vkwgt ! ---------------------------------------------------------------------- ! soil water diffusivity - factr = max(0.01, smc/parameters%smcmax) - expon = parameters%bexp + 2.0 - wdf = parameters%dwsat * factr ** expon + factr = max(0.01, smc/parameters%smcmax(isoil)) + expon = parameters%bexp(isoil) + 2.0 + wdf = parameters%dwsat(isoil) * factr ** expon wdf = wdf * (1.0 - fcr) ! hydraulic conductivity - expon = 2.0*parameters%bexp + 3.0 - wcnd = parameters%dksat * factr ** expon + expon = 2.0*parameters%bexp(isoil) + 3.0 + wcnd = parameters%dksat(isoil) * factr ** expon wcnd = wcnd * (1.0 - fcr) end subroutine wdfcnd1 @@ -7606,7 +7805,7 @@ end subroutine wdfcnd1 !== begin wdfcnd2 ================================================================================== !>\ingroup NoahMP_LSM - subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice) + subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice,isoil) ! ---------------------------------------------------------------------- ! calculate soil water diffusivity and soil hydraulic conductivity. ! ---------------------------------------------------------------------- @@ -7614,34 +7813,37 @@ subroutine wdfcnd2 (parameters,wdf,wcnd,smc,sice) ! ---------------------------------------------------------------------- ! input type (noahmp_parameters), intent(in) :: parameters - real,intent(in) :: smc - real,intent(in) :: sice + real (kind=kind_phys),intent(in) :: smc + real (kind=kind_phys),intent(in) :: sice + integer,intent(in) :: isoil ! output - real,intent(out) :: wcnd - real,intent(out) :: wdf + real (kind=kind_phys),intent(out) :: wcnd + real (kind=kind_phys),intent(out) :: wdf ! local - real :: expon - real :: factr - real :: vkwgt + real (kind=kind_phys) :: expon + real (kind=kind_phys) :: factr1,factr2 + real (kind=kind_phys) :: vkwgt ! ---------------------------------------------------------------------- ! soil water diffusivity - factr = max(0.01, smc/parameters%smcmax) - expon = parameters%bexp + 2.0 - wdf = parameters%dwsat * factr ** expon + factr1 = 0.05/parameters%smcmax(isoil) + factr2 = max(0.01, smc/parameters%smcmax(isoil)) + factr1 = min(factr1,factr2) + expon = parameters%bexp(isoil) + 2.0 + wdf = parameters%dwsat(isoil) * factr2 ** expon if (sice > 0.0) then vkwgt = 1./ (1. + (500.* sice)**3.) - wdf = vkwgt * wdf + (1.-vkwgt)*parameters%dwsat*(0.2/parameters%smcmax)**expon + wdf = vkwgt * wdf + (1.-vkwgt)*parameters%dwsat(isoil)*(factr1)**expon end if ! hydraulic conductivity - expon = 2.0*parameters%bexp + 3.0 - wcnd = parameters%dksat * factr ** expon + expon = 2.0*parameters%bexp(isoil) + 3.0 + wcnd = parameters%dksat(isoil) * factr2 ** expon end subroutine wdfcnd2 @@ -7661,46 +7863,46 @@ subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in integer, intent(in) :: jloc !grid index integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers - real, intent(in) :: dt !timestep [sec] - real, intent(in) :: fcrmax!maximum fcr (-) - real, dimension( 1:nsoil), intent(in) :: sice !soil ice content [m3/m3] - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension( 1:nsoil), intent(in) :: wcnd !hydraulic conductivity (m/s) - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) + real (kind=kind_phys), intent(in) :: dt !timestep [sec] + real (kind=kind_phys), intent(in) :: fcrmax!maximum fcr (-) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: sice !soil ice content [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: wcnd !hydraulic conductivity (m/s) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature (k) ! input and output - real, dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil water [m3/m3] - real, intent(inout) :: zwt !the depth to water table [m] - real, intent(inout) :: wa !water storage in aquifer [mm] - real, intent(inout) :: wt !water storage in aquifer + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: sh2o !liquid soil water [m3/m3] + real (kind=kind_phys), intent(inout) :: zwt !the depth to water table [m] + real (kind=kind_phys), intent(inout) :: wa !water storage in aquifer [mm] + real (kind=kind_phys), intent(inout) :: wt !water storage in aquifer !+ saturated soil [mm] ! output - real, intent(out) :: qin !groundwater recharge [mm/s] - real, intent(out) :: qdis !groundwater discharge [mm/s] + real (kind=kind_phys), intent(out) :: qin !groundwater recharge [mm/s] + real (kind=kind_phys), intent(out) :: qdis !groundwater discharge [mm/s] ! local - real :: fff !runoff decay factor (m-1) - real :: rsbmx !baseflow coefficient [mm/s] + real (kind=kind_phys) :: fff !runoff decay factor (m-1) + real (kind=kind_phys) :: rsbmx !baseflow coefficient [mm/s] integer :: iz !do-loop index integer :: iwt !layer index above water table layer - real, dimension( 1:nsoil) :: dzmm !layer thickness [mm] - real, dimension( 1:nsoil) :: znode !node depth [m] - real, dimension( 1:nsoil) :: mliq !liquid water mass [kg/m2 or mm] - real, dimension( 1:nsoil) :: epore !effective porosity [-] - real, dimension( 1:nsoil) :: hk !hydraulic conductivity [mm/s] - real, dimension( 1:nsoil) :: smc !total soil water content [m3/m3] - real(kind=8) :: s_node!degree of saturation of iwt layer - real :: dzsum !cumulative depth above water table [m] - real :: smpfz !matric potential (frozen effects) [mm] - real :: ka !aquifer hydraulic conductivity [mm/s] - real :: wh_zwt!water head at water table [mm] - real :: wh !water head at layer above zwt [mm] - real :: ws !water used to fill air pore [mm] - real :: wtsub !sum of hk*dzmm - real :: watmin!minimum soil vol soil moisture [m3/m3] - real :: xs !excessive water above saturation [mm] - real, parameter :: rous = 0.2 !specific yield [-] - real, parameter :: cmic = 0.20 !microprore content (0.0-1.0) + real (kind=kind_phys), dimension( 1:nsoil) :: dzmm !layer thickness [mm] + real (kind=kind_phys), dimension( 1:nsoil) :: znode !node depth [m] + real (kind=kind_phys), dimension( 1:nsoil) :: mliq !liquid water mass [kg/m2 or mm] + real (kind=kind_phys), dimension( 1:nsoil) :: epore !effective porosity [-] + real (kind=kind_phys), dimension( 1:nsoil) :: hk !hydraulic conductivity [mm/s] + real (kind=kind_phys), dimension( 1:nsoil) :: smc !total soil water content [m3/m3] + real (kind=kind_phys) :: s_node!degree of saturation of iwt layer + real (kind=kind_phys) :: dzsum !cumulative depth above water table [m] + real (kind=kind_phys) :: smpfz !matric potential (frozen effects) [mm] + real (kind=kind_phys) :: ka !aquifer hydraulic conductivity [mm/s] + real (kind=kind_phys) :: wh_zwt!water head at water table [mm] + real (kind=kind_phys) :: wh !water head at layer above zwt [mm] + real (kind=kind_phys) :: ws !water used to fill air pore [mm] + real (kind=kind_phys) :: wtsub !sum of hk*dzmm + real (kind=kind_phys) :: watmin!minimum soil vol soil moisture [m3/m3] + real (kind=kind_phys) :: xs !excessive water above saturation [mm] + real (kind=kind_phys), parameter :: rous = 0.2 !specific yield [-] + real (kind=kind_phys), parameter :: cmic = 0.20 !microprore content (0.0-1.0) !0.0-close to free drainage ! ------------------------------------------------------------- qdis = 0.0 @@ -7726,7 +7928,7 @@ subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in do iz = 1, nsoil smc(iz) = sh2o(iz) + sice(iz) mliq(iz) = sh2o(iz) * dzmm(iz) - epore(iz) = max(0.01,parameters%smcmax - sice(iz)) + epore(iz) = max(0.01,parameters%smcmax(iz) - sice(iz)) hk(iz) = 1.e3*wcnd(iz) enddo @@ -7750,9 +7952,9 @@ subroutine groundwater(parameters,nsnow ,nsoil ,dt ,sice ,zsoil , & !in ! matric potential at the layer above the water table - s_node = min(1.0,smc(iwt)/parameters%smcmax ) + s_node = min(1.0,smc(iwt)/parameters%smcmax(iwt) ) s_node = max(s_node,real(0.01,kind=8)) - smpfz = -parameters%psisat*1000.*s_node**(-parameters%bexp) ! m --> mm + smpfz = -parameters%psisat(iwt)*1000.*s_node**(-parameters%bexp(iwt)) ! m --> mm smpfz = max(-120000.0,cmic*smpfz) ! recharge rate qin to groundwater @@ -7850,26 +8052,26 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in integer, intent(in) :: nsnow !maximum no. of snow layers integer, intent(in) :: nsoil !no. of soil layers integer, intent(in) :: iloc,jloc - real, intent(in) :: dt - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] - real, dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] + real (kind=kind_phys), intent(in) :: dt + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of soil layer-bottom [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso ! snow/soil layer thickness [m] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smceq !equilibrium soil water content [m3/m3] ! input and output - real, dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] - real, intent(inout) :: wtd !the depth to water table [m] - real, intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] - real, intent(out) :: rech ! groundwater recharge (net vertical flux across the water table), positive up - real, intent(inout) :: qdrain + real (kind=kind_phys), dimension( 1:nsoil), intent(inout) :: smc !total soil water content [m3/m3] + real (kind=kind_phys), intent(inout) :: wtd !the depth to water table [m] + real (kind=kind_phys), intent(inout) :: smcwtd !soil moisture between bottom of the soil and the water table [m3/m3] + real (kind=kind_phys), intent(out) :: rech ! groundwater recharge (net vertical flux across the water table), positive up + real (kind=kind_phys), intent(inout) :: qdrain ! local integer :: iz !do-loop index integer :: iwtd !layer index above water table layer integer :: kwtd !layer index where the water table layer is - real :: wtdold - real :: dzup - real :: smceqdeep - real, dimension( 0:nsoil) :: zsoil0 + real (kind=kind_phys) :: wtdold + real (kind=kind_phys) :: dzup + real (kind=kind_phys) :: smceqdeep + real (kind=kind_phys), dimension( 0:nsoil) :: zsoil0 ! ------------------------------------------------------------- @@ -7888,30 +8090,30 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in wtdold=wtd if(smc(kwtd).gt.smceq(kwtd))then - if(smc(kwtd).eq.parameters%smcmax)then !wtd went to the layer above + if(smc(kwtd).eq.parameters%smcmax(kwtd))then !wtd went to the layer above wtd=zsoil0(iwtd) - rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + rech=-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) iwtd=iwtd-1 kwtd=kwtd-1 if(kwtd.ge.1)then if(smc(kwtd).gt.smceq(kwtd))then wtdold=wtd wtd = min( ( smc(kwtd)*dzsnso(kwtd) & - - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & - ( parameters%smcmax-smceq(kwtd) ), zsoil0(iwtd)) - rech=rech-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax(kwtd)*zsoil0(kwtd) ) / & + ( parameters%smcmax(kwtd)-smceq(kwtd) ), zsoil0(iwtd)) + rech=rech-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) endif endif else !wtd stays in the layer wtd = min( ( smc(kwtd)*dzsnso(kwtd) & - - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & - ( parameters%smcmax-smceq(kwtd) ), zsoil0(iwtd)) - rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax(kwtd)*zsoil0(kwtd) ) / & + ( parameters%smcmax(kwtd)-smceq(kwtd) ), zsoil0(iwtd)) + rech=-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) endif else !wtd has gone down to the layer below wtd=zsoil0(kwtd) - rech=-(wtdold-wtd) * (parameters%smcmax-smceq(kwtd)) + rech=-(wtdold-wtd) * (parameters%smcmax(kwtd)-smceq(kwtd)) kwtd=kwtd+1 iwtd=iwtd+1 !wtd crossed to the layer below. now adjust it there @@ -7919,13 +8121,13 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in wtdold=wtd if(smc(kwtd).gt.smceq(kwtd))then wtd = min( ( smc(kwtd)*dzsnso(kwtd) & - - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax*zsoil0(kwtd) ) / & - ( parameters%smcmax-smceq(kwtd) ) , zsoil0(iwtd) ) + - smceq(kwtd)*zsoil0(iwtd) + parameters%smcmax(kwtd)*zsoil0(kwtd) ) / & + ( parameters%smcmax(kwtd)-smceq(kwtd) ) , zsoil0(iwtd) ) else wtd=zsoil0(kwtd) endif rech = rech - (wtdold-wtd) * & - (parameters%smcmax-smceq(kwtd)) + (parameters%smcmax(kwtd)-smceq(kwtd)) else wtdold=wtd @@ -7934,38 +8136,42 @@ subroutine shallowwatertable (parameters,nsnow ,nsoil ,zsoil, dt , & !in ! qdrain = qdrain - 1000 * (smceq(nsoil)-smc(nsoil)) * dzsnso(nsoil) / dt ! smc(nsoil)=smceq(nsoil) !adjust wtd in the ficticious layer below - smceqdeep = parameters%smcmax * ( -parameters%psisat / ( -parameters%psisat - dzsnso(nsoil) ) ) ** (1./parameters%bexp) + smceqdeep = parameters%smcmax(nsoil) * ( -parameters%psisat(nsoil) / ( -parameters%psisat(nsoil) - dzsnso(nsoil) ) ) ** (1./parameters%bexp(nsoil)) wtd = min( ( smcwtd*dzsnso(nsoil) & - - smceqdeep*zsoil0(nsoil) + parameters%smcmax*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & - ( parameters%smcmax-smceqdeep ) , zsoil0(nsoil) ) + - smceqdeep*zsoil0(nsoil) + parameters%smcmax(nsoil)*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & + ( parameters%smcmax(nsoil)-smceqdeep ) , zsoil0(nsoil) ) rech = rech - (wtdold-wtd) * & - (parameters%smcmax-smceqdeep) + (parameters%smcmax(nsoil)-smceqdeep) endif endif elseif(wtd.ge.zsoil0(nsoil)-dzsnso(nsoil))then !if wtd was already below the bottom of the resolved soil crust wtdold=wtd - smceqdeep = parameters%smcmax * ( -parameters%psisat / ( -parameters%psisat - dzsnso(nsoil) ) ) ** (1./parameters%bexp) + smceqdeep = parameters%smcmax(nsoil) * ( -parameters%psisat(nsoil) / ( -parameters%psisat(nsoil) - dzsnso(nsoil) ) ) ** (1./parameters%bexp(nsoil)) if(smcwtd.gt.smceqdeep)then wtd = min( ( smcwtd*dzsnso(nsoil) & - - smceqdeep*zsoil0(nsoil) + parameters%smcmax*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & - ( parameters%smcmax-smceqdeep ) , zsoil0(nsoil) ) - rech = -(wtdold-wtd) * (parameters%smcmax-smceqdeep) + - smceqdeep*zsoil0(nsoil) + parameters%smcmax(nsoil)*(zsoil0(nsoil)-dzsnso(nsoil)) ) / & + ( parameters%smcmax(nsoil)-smceqdeep ) , zsoil0(nsoil) ) + rech = -(wtdold-wtd) * (parameters%smcmax(nsoil)-smceqdeep) else - rech = -(wtdold-(zsoil0(nsoil)-dzsnso(nsoil))) * (parameters%smcmax-smceqdeep) + rech = -(wtdold-(zsoil0(nsoil)-dzsnso(nsoil))) * (parameters%smcmax(nsoil)-smceqdeep) wtdold=zsoil0(nsoil)-dzsnso(nsoil) !and now even further down - dzup=(smceqdeep-smcwtd)*dzsnso(nsoil)/(parameters%smcmax-smceqdeep) + dzup=(smceqdeep-smcwtd)*dzsnso(nsoil)/(parameters%smcmax(nsoil)-smceqdeep) wtd=wtdold-dzup - rech = rech - (parameters%smcmax-smceqdeep)*dzup + rech = rech - (parameters%smcmax(nsoil)-smceqdeep)*dzup smcwtd=smceqdeep endif endif -if(iwtd.lt.nsoil)smcwtd=parameters%smcmax +if(iwtd.lt.nsoil .and. iwtd.gt.0) then + smcwtd=parameters%smcmax(iwtd) +elseif(iwtd.lt.nsoil .and. iwtd.le.0) then + smcwtd=parameters%smcmax(1) +end if end subroutine shallowwatertable @@ -7994,51 +8200,51 @@ subroutine carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in integer , intent(in) :: vegtyp !vegetation type integer , intent(in) :: nsnow !number of snow layers integer , intent(in) :: nsoil !number of soil layers - real , intent(in) :: lat !latitude (radians) - real , intent(in) :: dt !time step (s) - real, dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] - real, dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] - real , intent(in) :: tv !vegetation temperature (k) - real , intent(in) :: tg !ground temperature (k) - real , intent(in) :: foln !foliage nitrogen (%) - real , intent(in) :: btran !soil water transpiration factor (0 to 1) - real , intent(in) :: psn !total leaf photosyn (umolco2/m2/s) [+] - real , intent(in) :: apar !par by canopy (w/m2) - real , intent(in) :: igs !growing season index (0=off, 1=on) - real , intent(in) :: fveg !vegetation greenness fraction - real , intent(in) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottom from soil surface + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) , intent(in) :: tv !vegetation temperature (k) + real (kind=kind_phys) , intent(in) :: tg !ground temperature (k) + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: btran !soil water transpiration factor (0 to 1) + real (kind=kind_phys) , intent(in) :: psn !total leaf photosyn (umolco2/m2/s) [+] + real (kind=kind_phys) , intent(in) :: apar !par by canopy (w/m2) + real (kind=kind_phys) , intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys) , intent(in) :: fveg !vegetation greenness fraction + real (kind=kind_phys) , intent(in) :: troot !root-zone averaged temperature (k) integer , intent(in) :: ist !surface type 1->soil; 2->lake ! input & output (carbon) - real , intent(inout) :: lfmass !leaf mass [g/m2] - real , intent(inout) :: rtmass !mass of fine roots [g/m2] - real , intent(inout) :: stmass !stem mass [g/m2] - real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] - real , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] - real , intent(inout) :: fastcp !short-lived carbon in shallow soil [g/m2] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon in deep soil [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short-lived carbon in shallow soil [g/m2] ! outputs: (carbon) - real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] - real , intent(out) :: npp !net primary productivity [g/m2/s c] - real , intent(out) :: nee !net ecosystem exchange [g/m2/s co2] - real , intent(out) :: autors !net ecosystem respiration [g/m2/s c] - real , intent(out) :: heters !organic respiration [g/m2/s c] - real , intent(out) :: totsc !total soil carbon [g/m2 c] - real , intent(out) :: totlb !total living carbon ([g/m2 c] - real , intent(out) :: xlai !leaf area index [-] - real , intent(out) :: xsai !stem area index [-] -! real , intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2/s c] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange [g/m2/s co2] + real (kind=kind_phys) , intent(out) :: autors !net ecosystem respiration [g/m2/s c] + real (kind=kind_phys) , intent(out) :: heters !organic respiration [g/m2/s c] + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon [g/m2 c] + real (kind=kind_phys) , intent(out) :: totlb !total living carbon ([g/m2 c] + real (kind=kind_phys) , intent(out) :: xlai !leaf area index [-] + real (kind=kind_phys) , intent(out) :: xsai !stem area index [-] +! real (kind=kind_phys) , intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] ! local variables integer :: j !do-loop index - real :: wroot !root zone soil water [-] - real :: wstres !water stress coeficient [-] (1. for wilting ) - real :: lapm !leaf area per unit mass [m2/g] + real (kind=kind_phys) :: wroot !root zone soil water [-] + real (kind=kind_phys) :: wstres !water stress coeficient [-] (1. for wilting ) + real (kind=kind_phys) :: lapm !leaf area per unit mass [m2/g] ! ------------------------------------------------------------------------------------------ if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & @@ -8070,7 +8276,7 @@ subroutine carbon (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil , & !in wroot = 0. do j=1,parameters%nroot - wroot = wroot + smc(j)/parameters%smcmax * dzsnso(j) / (-zsoil(parameters%nroot)) + wroot = wroot + smc(j)/parameters%smcmax(j) * dzsnso(j) / (-zsoil(parameters%nroot)) enddo call co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in @@ -8112,102 +8318,102 @@ subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in integer , intent(in) :: vegtyp !vegetation physiology type integer , intent(in) :: nsnow !number of snow layers integer , intent(in) :: nsoil !number of soil layers - real , intent(in) :: dt !time step (s) - real , intent(in) :: lat !latitude (radians) - real , intent(in) :: igs !growing season index (0=off, 1=on) - real, dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] - real, dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] - real , intent(in) :: psn !total leaf photosynthesis (umolco2/m2/s) - real , intent(in) :: troot !root-zone averaged temperature (k) - real , intent(in) :: tv !leaf temperature (k) - real , intent(in) :: wroot !root zone soil water - real , intent(in) :: wstres !soil water stress - real , intent(in) :: foln !foliage nitrogen (%) - real , intent(in) :: lapm !leaf area per unit mass [m2/g] - real , intent(in) :: fveg !vegetation greenness fraction + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys) , intent(in) :: lat !latitude (radians) + real (kind=kind_phys) , intent(in) :: igs !growing season index (0=off, 1=on) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layer thickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature [k] + real (kind=kind_phys) , intent(in) :: psn !total leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys) , intent(in) :: troot !root-zone averaged temperature (k) + real (kind=kind_phys) , intent(in) :: tv !leaf temperature (k) + real (kind=kind_phys) , intent(in) :: wroot !root zone soil water + real (kind=kind_phys) , intent(in) :: wstres !soil water stress + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: lapm !leaf area per unit mass [m2/g] + real (kind=kind_phys) , intent(in) :: fveg !vegetation greenness fraction ! input and output - real , intent(inout) :: xlai !leaf area index from leaf carbon [-] - real , intent(inout) :: xsai !stem area index from leaf carbon [-] - real , intent(inout) :: lfmass !leaf mass [g/m2] - real , intent(inout) :: rtmass !mass of fine roots [g/m2] - real , intent(inout) :: stmass !stem mass [g/m2] - real , intent(inout) :: fastcp !short lived carbon [g/m2] - real , intent(inout) :: stblcp !stable carbon pool [g/m2] - real , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: xlai !leaf area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: xsai !stem area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short lived carbon [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon pool [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] ! output - real , intent(out) :: gpp !net instantaneous assimilation [g/m2/s] - real , intent(out) :: npp !net primary productivity [g/m2] - real , intent(out) :: nee !net ecosystem exchange (autors+heters-gpp) - real , intent(out) :: autors !net ecosystem resp. (maintance and growth) - real , intent(out) :: heters !organic respiration - real , intent(out) :: totsc !total soil carbon (g/m2) - real , intent(out) :: totlb !total living carbon (g/m2) + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange (autors+heters-gpp) + real (kind=kind_phys) , intent(out) :: autors !net ecosystem resp. (maintance and growth) + real (kind=kind_phys) , intent(out) :: heters !organic respiration + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon (g/m2) + real (kind=kind_phys) , intent(out) :: totlb !total living carbon (g/m2) ! local - real :: cflux !carbon flux to atmosphere [g/m2/s] - real :: lfmsmn !minimum leaf mass [g/m2] - real :: rswood !wood respiration [g/m2] - real :: rsleaf !leaf maintenance respiration per timestep [g/m2] - real :: rsroot !fine root respiration per time step [g/m2] - real :: nppl !leaf net primary productivity [g/m2/s] - real :: nppr !root net primary productivity [g/m2/s] - real :: nppw !wood net primary productivity [g/m2/s] - real :: npps !wood net primary productivity [g/m2/s] - real :: dielf !death of leaf mass per time step [g/m2] - - real :: addnpplf !leaf assimil after resp. losses removed [g/m2] - real :: addnppst !stem assimil after resp. losses removed [g/m2] - real :: carbfx !carbon assimilated per model step [g/m2] - real :: grleaf !growth respiration rate for leaf [g/m2/s] - real :: grroot !growth respiration rate for root [g/m2/s] - real :: grwood !growth respiration rate for wood [g/m2/s] - real :: grstem !growth respiration rate for stem [g/m2/s] - real :: leafpt !fraction of carbon allocated to leaves [-] - real :: lfdel !maximum leaf mass available to change [g/m2/s] - real :: lftovr !stem turnover per time step [g/m2] - real :: sttovr !stem turnover per time step [g/m2] - real :: wdtovr !wood turnover per time step [g/m2] - real :: rssoil !soil respiration per time step [g/m2] - real :: rttovr !root carbon loss per time step by turnover [g/m2] - real :: stablc !decay rate of fast carbon to slow carbon [g/m2/s] - real :: woodf !calculated wood to root ratio [-] - real :: nonlef !fraction of carbon to root and wood [-] - real :: rootpt !fraction of carbon flux to roots [-] - real :: woodpt !fraction of carbon flux to wood [-] - real :: stempt !fraction of carbon flux to stem [-] - real :: resp !leaf respiration [umol/m2/s] - real :: rsstem !stem respiration [g/m2/s] - - real :: fsw !soil water factor for microbial respiration - real :: fst !soil temperature factor for microbial respiration - real :: fnf !foliage nitrogen adjustemt to respiration (<= 1) - real :: tf !temperature factor - real :: rf !respiration reduction factor (<= 1) - real :: stdel - real :: stmsmn - real :: sapm !stem area per unit mass (m2/g) - real :: diest + real (kind=kind_phys) :: cflux !carbon flux to atmosphere [g/m2/s] + real (kind=kind_phys) :: lfmsmn !minimum leaf mass [g/m2] + real (kind=kind_phys) :: rswood !wood respiration [g/m2] + real (kind=kind_phys) :: rsleaf !leaf maintenance respiration per timestep [g/m2] + real (kind=kind_phys) :: rsroot !fine root respiration per time step [g/m2] + real (kind=kind_phys) :: nppl !leaf net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppr !root net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppw !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: npps !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: dielf !death of leaf mass per time step [g/m2] + + real (kind=kind_phys) :: addnpplf !leaf assimil after resp. losses removed [g/m2] + real (kind=kind_phys) :: addnppst !stem assimil after resp. losses removed [g/m2] + real (kind=kind_phys) :: carbfx !carbon assimilated per model step [g/m2] + real (kind=kind_phys) :: grleaf !growth respiration rate for leaf [g/m2/s] + real (kind=kind_phys) :: grroot !growth respiration rate for root [g/m2/s] + real (kind=kind_phys) :: grwood !growth respiration rate for wood [g/m2/s] + real (kind=kind_phys) :: grstem !growth respiration rate for stem [g/m2/s] + real (kind=kind_phys) :: leafpt !fraction of carbon allocated to leaves [-] + real (kind=kind_phys) :: lfdel !maximum leaf mass available to change [g/m2/s] + real (kind=kind_phys) :: lftovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: sttovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: wdtovr !wood turnover per time step [g/m2] + real (kind=kind_phys) :: rssoil !soil respiration per time step [g/m2] + real (kind=kind_phys) :: rttovr !root carbon loss per time step by turnover [g/m2] + real (kind=kind_phys) :: stablc !decay rate of fast carbon to slow carbon [g/m2/s] + real (kind=kind_phys) :: woodf !calculated wood to root ratio [-] + real (kind=kind_phys) :: nonlef !fraction of carbon to root and wood [-] + real (kind=kind_phys) :: rootpt !fraction of carbon flux to roots [-] + real (kind=kind_phys) :: woodpt !fraction of carbon flux to wood [-] + real (kind=kind_phys) :: stempt !fraction of carbon flux to stem [-] + real (kind=kind_phys) :: resp !leaf respiration [umol/m2/s] + real (kind=kind_phys) :: rsstem !stem respiration [g/m2/s] + + real (kind=kind_phys) :: fsw !soil water factor for microbial respiration + real (kind=kind_phys) :: fst !soil temperature factor for microbial respiration + real (kind=kind_phys) :: fnf !foliage nitrogen adjustemt to respiration (<= 1) + real (kind=kind_phys) :: tf !temperature factor + real (kind=kind_phys) :: rf !respiration reduction factor (<= 1) + real (kind=kind_phys) :: stdel + real (kind=kind_phys) :: stmsmn + real (kind=kind_phys) :: sapm !stem area per unit mass (m2/g) + real (kind=kind_phys) :: diest ! -------------------------- constants ------------------------------- - real :: bf !parameter for present wood allocation [-] - real :: rswoodc !wood respiration coeficient [1/s] - real :: stovrc !stem turnover coefficient [1/s] - real :: rsdryc !degree of drying that reduces soil respiration [-] - real :: rtovrc !root turnover coefficient [1/s] - real :: wstrc !water stress coeficient [-] - real :: laimin !minimum leaf area index [m2/m2] - real :: xsamin !minimum leaf area index [m2/m2] - real :: sc - real :: sd - real :: vegfrac + real (kind=kind_phys) :: bf !parameter for present wood allocation [-] + real (kind=kind_phys) :: rswoodc !wood respiration coeficient [1/s] + real (kind=kind_phys) :: stovrc !stem turnover coefficient [1/s] + real (kind=kind_phys) :: rsdryc !degree of drying that reduces soil respiration [-] + real (kind=kind_phys) :: rtovrc !root turnover coefficient [1/s] + real (kind=kind_phys) :: wstrc !water stress coeficient [-] + real (kind=kind_phys) :: laimin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: xsamin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: sc + real (kind=kind_phys) :: sd + real (kind=kind_phys) :: vegfrac ! respiration as a function of temperature - real :: r,x + real (kind=kind_phys) :: r,x r(x) = exp(0.08*(x-298.16)) ! --------------------------------------------------------------------------------- @@ -8258,10 +8464,10 @@ subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in ! fraction of carbon into wood versus root - if(wood.gt.0) then + if(wood > 1.e-6) then woodf = (1.-exp(-bf*(parameters%wrrat*rtmass/wood))/bf)*parameters%wdpool else - woodf = 0. + woodf = parameters%wdpool endif rootpt = nonlef*(1.-woodf) @@ -8360,6 +8566,585 @@ subroutine co2flux (parameters,nsnow ,nsoil ,vegtyp ,igs ,dt , & !in end subroutine co2flux +!== begin carbon_crop ============================================================================== + + subroutine carbon_crop (parameters,nsnow ,nsoil ,vegtyp ,dt ,zsoil ,julian , & !in + dzsnso ,stc ,smc ,tv ,psn ,foln ,btran , & !in + soldn ,t2m , & !in + lfmass ,rtmass ,stmass ,wood ,stblcp ,fastcp ,grain , & !inout + xlai ,xsai ,gdd , & !inout + gpp ,npp ,nee ,autors ,heters ,totsc ,totlb, pgs ) !out +! ------------------------------------------------------------------------------------------ +! initial crop version created by xing liu +! initial crop version added by barlage v3.8 + +! ------------------------------------------------------------------------------------------ + implicit none +! ------------------------------------------------------------------------------------------ +! inputs (carbon) + + type (noahmp_parameters), intent(in) :: parameters + integer , intent(in) :: nsnow !number of snow layers + integer , intent(in) :: nsoil !number of soil layers + integer , intent(in) :: vegtyp !vegetation type + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: zsoil !depth of layer-bottomfrom soil surface + real (kind=kind_phys) , intent(in) :: julian !julian day of year(fractional) ( 0 <= julian < yearlen ) + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: dzsnso !snow/soil layerthickness [m] + real (kind=kind_phys), dimension(-nsnow+1:nsoil), intent(in) :: stc !snow/soil temperature[k] + real (kind=kind_phys), dimension( 1:nsoil), intent(in) :: smc !soil moisture (ice +liq.) [m3/m3] + real (kind=kind_phys) , intent(in) :: tv !vegetation temperature(k) + real (kind=kind_phys) , intent(in) :: psn !total leaf photosyn(umolco2/m2/s) [+] + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + real (kind=kind_phys) , intent(in) :: btran !soil watertranspiration factor (0 to 1) + real (kind=kind_phys) , intent(in) :: soldn !downward solar radiation + real (kind=kind_phys) , intent(in) :: t2m !air temperature + +! input & output (carbon) + + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots[g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl.woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon in deepsoil [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short-lived carbon inshallow soil [g/m2] + real (kind=kind_phys) , intent(inout) :: grain !mass of grain [g/m2] + real (kind=kind_phys) , intent(inout) :: xlai !leaf area index [-] + real (kind=kind_phys) , intent(inout) :: xsai !stem area index [-] + real (kind=kind_phys) , intent(inout) :: gdd !growing degree days + +! outout + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s c] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2/s c] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange[g/m2/s co2] + real (kind=kind_phys) , intent(out) :: autors !net ecosystem respiration [g/m2/s c] + real (kind=kind_phys) , intent(out) :: heters !organic respiration[g/m2/s c] + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon [g/m2c] + real (kind=kind_phys) , intent(out) :: totlb !total living carbon ([g/m2 c] + +! local variables + + integer :: j !do-loop index + real (kind=kind_phys) :: wroot !root zone soil water [-] + real (kind=kind_phys) :: wstres !water stress coeficient [-] (1. for wilting ) + integer :: ipa !planting index + integer :: iha !havestindex(0=on,1=off) + integer, intent(out) :: pgs !plant growth stage + + real (kind=kind_phys) :: psncrop + +! ------------------------------------------------------------------------------------------ + if ( ( vegtyp == parameters%iswater ) .or. ( vegtyp == parameters%isbarren ) .or. & + ( vegtyp == parameters%isice ) .or. (parameters%urban_flag) ) then + xlai = 0. + xsai = 0. + gpp = 0. + npp = 0. + nee = 0. + autors = 0. + heters = 0. + totsc = 0. + totlb = 0. + lfmass = 0. + rtmass = 0. + stmass = 0. + wood = 0. + stblcp = 0. + fastcp = 0. + grain = 0. + return + end if + +! water stress + + + wstres = 1.- btran + + wroot = 0. + do j=1,parameters%nroot + wroot = wroot + smc(j)/parameters%smcmax(j) * dzsnso(j) / (-zsoil(parameters%nroot)) + enddo + + call psn_crop ( parameters, & !in + soldn, xlai, t2m, & !in + psncrop ) !out + + call growing_gdd (parameters, & !in + t2m , dt, julian, & !in + gdd , & !inout + ipa , iha, pgs) !out + + call co2flux_crop (parameters, & !in + dt ,stc(1) ,psn ,tv ,wroot ,wstres ,foln , & !in + ipa ,iha ,pgs , & !in xing + xlai ,xsai ,lfmass ,rtmass ,stmass , & !inout + fastcp ,stblcp ,wood ,grain ,gdd , & !inout + gpp ,npp ,nee ,autors ,heters , & !out + totsc ,totlb ) !out + + end subroutine carbon_crop + +!== begin co2flux_crop ============================================================================= + + subroutine co2flux_crop (parameters, & !in + dt ,stc ,psn ,tv ,wroot ,wstres ,foln , & !in + ipa ,iha ,pgs , & !in xing + xlai ,xsai ,lfmass ,rtmass ,stmass , & !inout + fastcp ,stblcp ,wood ,grain ,gdd, & !inout + gpp ,npp ,nee ,autors ,heters , & !out + totsc ,totlb ) !out +! ----------------------------------------------------------------------------------------- +! the original code from re dickinson et al.(1998) and guo-yue niu(2004), +! modified by xing liu, 2014. +! +! ----------------------------------------------------------------------------------------- + implicit none +! ----------------------------------------------------------------------------------------- + +! input + + type (noahmp_parameters), intent(in) :: parameters + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys) , intent(in) :: stc !soil temperature[k] + real (kind=kind_phys) , intent(in) :: psn !total leaf photosynthesis (umolco2/m2/s) + real (kind=kind_phys) , intent(in) :: tv !leaf temperature (k) + real (kind=kind_phys) , intent(in) :: wroot !root zone soil water + real (kind=kind_phys) , intent(in) :: wstres !soil water stress + real (kind=kind_phys) , intent(in) :: foln !foliage nitrogen (%) + integer , intent(in) :: ipa + integer , intent(in) :: iha + integer , intent(in) :: pgs + +! input and output + + real (kind=kind_phys) , intent(inout) :: xlai !leaf area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: xsai !stem area index from leaf carbon [-] + real (kind=kind_phys) , intent(inout) :: lfmass !leaf mass [g/m2] + real (kind=kind_phys) , intent(inout) :: rtmass !mass of fine roots [g/m2] + real (kind=kind_phys) , intent(inout) :: stmass !stem mass [g/m2] + real (kind=kind_phys) , intent(inout) :: fastcp !short lived carbon [g/m2] + real (kind=kind_phys) , intent(inout) :: stblcp !stable carbon pool [g/m2] + real (kind=kind_phys) , intent(inout) :: wood !mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) , intent(inout) :: grain !mass of grain (xing) [g/m2] + real (kind=kind_phys) , intent(inout) :: gdd !growing degree days (xing) + +! output + + real (kind=kind_phys) , intent(out) :: gpp !net instantaneous assimilation [g/m2/s] + real (kind=kind_phys) , intent(out) :: npp !net primary productivity [g/m2] + real (kind=kind_phys) , intent(out) :: nee !net ecosystem exchange (autors+heters-gpp) + real (kind=kind_phys) , intent(out) :: autors !net ecosystem resp. (maintance and growth) + real (kind=kind_phys) , intent(out) :: heters !organic respiration + real (kind=kind_phys) , intent(out) :: totsc !total soil carbon (g/m2) + real (kind=kind_phys) , intent(out) :: totlb !total living carbon (g/m2) + +! local + + real (kind=kind_phys) :: cflux !carbon flux to atmosphere [g/m2/s] + real (kind=kind_phys) :: lfmsmn !minimum leaf mass [g/m2] + real (kind=kind_phys) :: rswood !wood respiration [g/m2] + real (kind=kind_phys) :: rsleaf !leaf maintenance respiration per timestep[g/m2] + real (kind=kind_phys) :: rsroot !fine root respiration per time step [g/m2] + real (kind=kind_phys) :: rsgrain !grain respiration [g/m2] + real (kind=kind_phys) :: nppl !leaf net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppr !root net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppw !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: npps !wood net primary productivity [g/m2/s] + real (kind=kind_phys) :: nppg !grain net primary productivity [g/m2/s] + real (kind=kind_phys) :: dielf !death of leaf mass per time step [g/m2] + + real (kind=kind_phys) :: addnpplf !leaf assimil after resp. losses removed[g/m2] + real (kind=kind_phys) :: addnppst !stem assimil after resp. losses removed[g/m2] + real (kind=kind_phys) :: carbfx !carbon assimilated per model step [g/m2] + real (kind=kind_phys) :: cbhydrafx!carbonhydrate assimilated per model step [g/m2] + real (kind=kind_phys) :: grleaf !growth respiration rate for leaf [g/m2/s] + real (kind=kind_phys) :: grroot !growth respiration rate for root [g/m2/s] + real (kind=kind_phys) :: grwood !growth respiration rate for wood [g/m2/s] + real (kind=kind_phys) :: grstem !growth respiration rate for stem [g/m2/s] + real (kind=kind_phys) :: grgrain !growth respiration rate for stem [g/m2/s] + real (kind=kind_phys) :: leafpt !fraction of carbon allocated to leaves [-] + real (kind=kind_phys) :: lfdel !maximum leaf mass available to change[g/m2/s] + real (kind=kind_phys) :: lftovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: sttovr !stem turnover per time step [g/m2] + real (kind=kind_phys) :: wdtovr !wood turnover per time step [g/m2] + real (kind=kind_phys) :: grtovr !grainturnover per time step [g/m2] + real (kind=kind_phys) :: rssoil !soil respiration per time step [g/m2] + real (kind=kind_phys) :: rttovr !root carbon loss per time step by turnover[g/m2] + real (kind=kind_phys) :: stablc !decay rate of fast carbon to slow carbon[g/m2/s] + real (kind=kind_phys) :: woodf !calculated wood to root ratio [-] + real (kind=kind_phys) :: nonlef !fraction of carbon to root and wood [-] + real (kind=kind_phys) :: resp !leaf respiration [umol/m2/s] + real (kind=kind_phys) :: rsstem !stem respiration [g/m2/s] + + real (kind=kind_phys) :: fsw !soil water factor for microbial respiration + real (kind=kind_phys) :: fst !soil temperature factor for microbialrespiration + real (kind=kind_phys) :: fnf !foliage nitrogen adjustemt to respiration(<= 1) + real (kind=kind_phys) :: tf !temperature factor + real (kind=kind_phys) :: stdel + real (kind=kind_phys) :: stmsmn + real (kind=kind_phys) :: sapm !stem area per unit mass (m2/g) + real (kind=kind_phys) :: diest + real (kind=kind_phys) :: stconvert !stem to grain conversion [g/m2/s] + real (kind=kind_phys) :: rtconvert !root to grain conversion [g/m2/s] +! -------------------------- constants ------------------------------- + real (kind=kind_phys) :: bf !parameter for present wood allocation [-] + real (kind=kind_phys) :: rswoodc !wood respiration coeficient [1/s] + real (kind=kind_phys) :: stovrc !stem turnover coefficient [1/s] + real (kind=kind_phys) :: rsdryc !degree of drying that reduces soilrespiration [-] + real (kind=kind_phys) :: rtovrc !root turnover coefficient [1/s] + real (kind=kind_phys) :: wstrc !water stress coeficient [-] + real (kind=kind_phys) :: laimin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: xsamin !minimum leaf area index [m2/m2] + real (kind=kind_phys) :: sc + real (kind=kind_phys) :: sd + real (kind=kind_phys) :: vegfrac + real (kind=kind_phys) :: temp + +! respiration as a function of temperature + + real (kind=kind_phys) :: r,x + r(x) = exp(0.08*(x-298.16)) +! --------------------------------------------------------------------------------- + +! constants + rsdryc = 40.0 !original was 40.0 + rswoodc = 3.0e-10 ! + bf = 0.90 !original was 0.90 ! carbon to roots + wstrc = 100.0 + laimin = 0.05 + xsamin = 0.05 + + sapm = 3.*0.001 ! m2/kg -->m2/g + lfmsmn = laimin/0.035 + stmsmn = xsamin/sapm +! --------------------------------------------------------------------------------- + +! carbon assimilation +! 1 mole -> 12 g carbon or 44 g co2 or 30 g ch20 + + carbfx = psn*12.e-6!*ipa !umol co2 /m2/ s -> g/m2/s c + cbhydrafx = psn*30.e-6!*ipa + +! mainteinance respiration + fnf = min( foln/max(1.e-06,parameters%foln_mx), 1.0 ) + tf = parameters%q10mr**( (tv-298.16)/10. ) + resp = parameters%lfmr25 * tf * fnf * xlai * (1.-wstres) ! umol/m2/s + rsleaf = min((lfmass-lfmsmn)/dt,resp*30.e-6) ! g/m2/s + rsroot = parameters%rtmr25*(rtmass*1e-3)*tf * 30.e-6 ! g/m2/s + rsstem = parameters%stmr25*(stmass*1e-3)*tf * 30.e-6 ! g/m2/s + rsgrain = parameters%grainmr25*(grain*1e-3)*tf * 30.e-6 ! g/m2/s + +! calculate growth respiration for leaf, rtmass and grain + + grleaf = max(0.0,parameters%fra_gr*(parameters%lfpt(pgs)*cbhydrafx - rsleaf)) + grstem = max(0.0,parameters%fra_gr*(parameters%stpt(pgs)*cbhydrafx - rsstem)) + grroot = max(0.0,parameters%fra_gr*(parameters%rtpt(pgs)*cbhydrafx - rsroot)) + grgrain = max(0.0,parameters%fra_gr*(parameters%grainpt(pgs)*cbhydrafx - rsgrain)) + +! leaf turnover, stem turnover, root turnover and leaf death caused by soil +! water and soil temperature stress + + lftovr = parameters%lf_ovrc(pgs)*1.e-6*lfmass + rttovr = parameters%rt_ovrc(pgs)*1.e-6*rtmass + sttovr = parameters%st_ovrc(pgs)*1.e-6*stmass + sc = exp(-0.3*max(0.,tv-parameters%lefreez)) * (lfmass/120.) + sd = exp((wstres-1.)*wstrc) + dielf = lfmass*1.e-6*(parameters%dile_fw(pgs) * sd + parameters%dile_fc(pgs)*sc) + +! allocation of cbhydrafx to leaf, stem, root and grain at each growth stage + + + addnpplf = max(0.,parameters%lfpt(pgs)*cbhydrafx - grleaf-rsleaf) + addnpplf = parameters%lfpt(pgs)*cbhydrafx - grleaf-rsleaf + addnppst = max(0.,parameters%stpt(pgs)*cbhydrafx - grstem-rsstem) + addnppst = parameters%stpt(pgs)*cbhydrafx - grstem-rsstem + + +! avoid reducing leaf mass below its minimum value but conserve mass + + lfdel = (lfmass - lfmsmn)/dt + stdel = (stmass - stmsmn)/dt + lftovr = min(lftovr,lfdel+addnpplf) + sttovr = min(sttovr,stdel+addnppst) + dielf = min(dielf,lfdel+addnpplf-lftovr) + +! net primary productivities + + nppl = max(addnpplf,-lfdel) + nppl = addnpplf + npps = max(addnppst,-stdel) + npps = addnppst + nppr = parameters%rtpt(pgs)*cbhydrafx - rsroot - grroot + nppg = parameters%grainpt(pgs)*cbhydrafx - rsgrain - grgrain + +! masses of plant components + + lfmass = lfmass + (nppl-lftovr-dielf)*dt + stmass = stmass + (npps-sttovr)*dt ! g/m2 + rtmass = rtmass + (nppr-rttovr)*dt + grain = grain + nppg*dt + + gpp = cbhydrafx* 0.4 !!g/m2/s c 0.4=12/30, ch20 to c + + stconvert = 0.0 + rtconvert = 0.0 + if(pgs==6) then + stconvert = stmass*(0.00005*dt/3600.0) + stmass = stmass - stconvert + rtconvert = rtmass*(0.0005*dt/3600.0) + rtmass = rtmass - rtconvert + grain = grain + stconvert + rtconvert + end if + + if(rtmass.lt.0.0) then + rttovr = nppr + rtmass = 0.0 + endif + + if(grain.lt.0.0) then + grain = 0.0 + endif + + ! soil carbon budgets + +! if(pgs == 1 .or. pgs == 2 .or. pgs == 8) then +! fastcp=1000 +! else + fastcp = fastcp + (rttovr+lftovr+sttovr+dielf)*dt +! end if + fst = 2.0**( (stc-283.16)/10. ) + fsw = wroot / (0.20+wroot) * 0.23 / (0.23+wroot) + rssoil = fsw * fst * parameters%mrp* max(0.,fastcp*1.e-3)*12.e-6 + + stablc = 0.1*rssoil + fastcp = fastcp - (rssoil + stablc)*dt + stblcp = stblcp + stablc*dt + +! total carbon flux + + cflux = - carbfx + rsleaf + rsroot + rsstem & + + rssoil + grleaf + grroot ! g/m2/s 0.4=12/30, ch20 to c + +! for outputs + !g/m2/s c + + npp = (nppl + npps+ nppr +nppg)*0.4 !!g/m2/s c 0.4=12/30, ch20 to c + + + autors = rsroot + rsgrain + rsleaf + & !g/m2/s c + grleaf + grroot + grgrain !g/m2/s c + + heters = rssoil !g/m2/s c + nee = (autors + heters - gpp)*44./30. !g/m2/s co2 + totsc = fastcp + stblcp !g/m2 c + + totlb = lfmass + rtmass + grain + +! leaf area index and stem area index + + xlai = max(lfmass*parameters%bio2lai,laimin) + xsai = max(stmass*sapm,xsamin) + + +!after harversting +! if(pgs == 8 ) then +! lfmass = 0.62 +! stmass = 0 +! grain = 0 +! end if + +! if(pgs == 1 .or. pgs == 2 .or. pgs == 8) then + if(pgs == 8 .and. (grain > 0. .or. lfmass > 0 .or. stmass > 0 .or. rtmass > 0)) then + xlai = 0.05 + xsai = 0.05 + lfmass = lfmsmn + stmass = stmsmn + rtmass = 0 + grain = 0 + end if + +end subroutine co2flux_crop + +!== begin growing_gdd ============================================================================== + + subroutine growing_gdd (parameters, & !in + t2m , dt, julian, & !in + gdd , & !inout + ipa, iha, pgs) !out +!=================================================================================================== + +! input + + type (noahmp_parameters), intent(in) :: parameters + real (kind=kind_phys) , intent(in) :: t2m !air temperature + real (kind=kind_phys) , intent(in) :: dt !time step (s) + real (kind=kind_phys) , intent(in) :: julian !julian day of year (fractional) ( 0 <= julian < yearlen ) + +! input and output + + real (kind=kind_phys) , intent(inout) :: gdd !growing degress days + +! output + + integer , intent(out) :: ipa !planting index index(0=off, 1=on) + integer , intent(out) :: iha !havestindex(0=on,1=off) + integer , intent(out) :: pgs !plant growth stage(1=s1,2=s2,3=s3) + +!local + + real (kind=kind_phys) :: gddday !gap bewtween gdd and gdd8 + real (kind=kind_phys) :: dayofs2 !days in stage2 + real (kind=kind_phys) :: tdiff !temperature difference for growing degree days calculation + real (kind=kind_phys) :: tc + + tc = t2m - 273.15 + +!havestindex(0=on,1=off) + + ipa = 1 + iha = 1 + +!turn on/off the planting + + if(julian < parameters%pltday) ipa = 0 + +!turn on/off the harvesting + if(julian >= parameters%hsday) iha = 0 + +!calculate the growing degree days + + if(tc < parameters%gddtbase) then + tdiff = 0.0 + elseif(tc >= parameters%gddtcut) then + tdiff = parameters%gddtcut - parameters%gddtbase + else + tdiff = tc - parameters%gddtbase + end if + + gdd = (gdd + tdiff * dt / 86400.0) * ipa * iha + + gddday = gdd + + ! decide corn growth stage, based on hybrid-maize + ! pgs = 1 : before planting + ! pgs = 2 : from tassel initiation to silking + ! pgs = 3 : from silking to effective grain filling + ! pgs = 4 : from effective grain filling to pysiological maturity + ! pgs = 5 : gddm=1389 + ! pgs = 6 : + ! pgs = 7 : + ! pgs = 8 : + ! gddm = 1389 + ! gddm = 1555 + ! gddsk = 0.41*gddm +145.4+150 !from hybrid-maize + ! gdds1 = ((gddsk-96)/38.9-4)*21 + ! gdds1 = 0.77*gddsk + ! gdds3 = gddsk+170 + ! gdds3 = 170 + + pgs = 1 ! mb: set pgs = 1 (for initialization during growing season when no gdd) + + if(gddday > 0.0) pgs = 2 + + if(gddday >= parameters%gdds1) pgs = 3 + + if(gddday >= parameters%gdds2) pgs = 4 + + if(gddday >= parameters%gdds3) pgs = 5 + + if(gddday >= parameters%gdds4) pgs = 6 + + if(gddday >= parameters%gdds5) pgs = 7 + + if(julian >= parameters%hsday) pgs = 8 + + if(julian < parameters%pltday) pgs = 1 + +end subroutine growing_gdd + +!== begin psn_crop ================================================================================= + +subroutine psn_crop ( parameters, & !in + soldn, xlai,t2m, & !in + psncrop ) !out +!=================================================================================================== + +! input + + type (noahmp_parameters), intent(in) :: parameters + real (kind=kind_phys) , intent(in) :: soldn ! downward solar radiation + real (kind=kind_phys) , intent(in) :: xlai ! lai + real (kind=kind_phys) , intent(in) :: t2m ! air temp + real (kind=kind_phys) , intent(out) :: psncrop ! + +!local + + real (kind=kind_phys) :: par ! photosynthetically active radiation (w/m2) 1 w m-2 = 0.0864 mj m-2 day-1 + real (kind=kind_phys) :: amax ! maximum co2 assimulation rate g/co2/s + real (kind=kind_phys) :: l1 ! three gaussian method + real (kind=kind_phys) :: l2 ! three gaussian method + real (kind=kind_phys) :: l3 ! three gaussian method + real (kind=kind_phys) :: i1 ! three gaussian method + real (kind=kind_phys) :: i2 ! three gaussian method + real (kind=kind_phys) :: i3 ! three gaussian method + real (kind=kind_phys) :: a1 ! three gaussian method + real (kind=kind_phys) :: a2 ! three gaussian method + real (kind=kind_phys) :: a3 ! three gaussian method + real (kind=kind_phys) :: a ! co2 assimulation + real (kind=kind_phys) :: tc + + tc = t2m - 273.15 + + par = parameters%i2par * soldn * 0.0036 !w to mj m-2 + + if(tc < parameters%tassim0) then + amax = 1e-10 + elseif(tc >= parameters%tassim0 .and. tc < parameters%tassim1) then + amax = (tc - parameters%tassim0) * parameters%aref / (parameters%tassim1 - parameters%tassim0) + elseif(tc >= parameters%tassim1 .and. tc < parameters%tassim2) then + amax = parameters%aref + else + amax= parameters%aref - 0.2 * (t2m - parameters%tassim2) + endif + + amax = max(amax,0.01) + + if(xlai <= 0.05) then + l1 = 0.1127 * 0.05 !use initial lai(0.05), avoid error + l2 = 0.5 * 0.05 + l3 = 0.8873 * 0.05 + else + l1 = 0.1127 * xlai + l2 = 0.5 * xlai + l3 = 0.8873 * xlai + end if + + i1 = parameters%k * par * exp(-parameters%k * l1) + i2 = parameters%k * par * exp(-parameters%k * l2) + i3 = parameters%k * par * exp(-parameters%k * l3) + + i1 = max(i1,1e-10) + i2 = max(i2,1e-10) + i3 = max(i3,1e-10) + + a1 = amax * (1 - exp(-parameters%epsi * i1 / amax)) + a2 = amax * (1 - exp(-parameters%epsi * i2 / amax)) * 1.6 + a3 = amax * (1 - exp(-parameters%epsi * i3 / amax)) + + if (xlai <= 0.05) then + a = (a1+a2+a3) / 3.6 * 0.05 + elseif (xlai > 0.05 .and. xlai <= 4.0) then + a = (a1+a2+a3) / 3.6 * xlai + else + a = (a1+a2+a3) / 3.6 * 4 + end if + + a = a * parameters%psnrf ! attainable + + psncrop = 6.313 * a ! (1/44) * 1000000)/3600 = 6.313 + +end subroutine psn_crop + !== begin bvocflux ================================================================================= ! subroutine bvocflux(parameters,vocflx, vegtyp, vegfrac, apar, tv ) @@ -8390,32 +9175,32 @@ end subroutine co2flux ! ------------------------ input/output variables ----------------- ! input ! integer ,intent(in) :: vegtyp !vegetation type -! real ,intent(in) :: vegfrac !green vegetation fraction [0.0-1.0] -! real ,intent(in) :: apar !photosynthesis active energy by canopy (w/m2) -! real ,intent(in) :: tv !vegetation canopy temperature (k) +! real (kind=kind_phys) ,intent(in) :: vegfrac !green vegetation fraction [0.0-1.0] +! real (kind=kind_phys) ,intent(in) :: apar !photosynthesis active energy by canopy (w/m2) +! real (kind=kind_phys) ,intent(in) :: tv !vegetation canopy temperature (k) ! ! output -! real ,intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] +! real (kind=kind_phys) ,intent(out) :: vocflx(5) ! voc fluxes [ug c m-2 h-1] ! ! local variables ! -! real, parameter :: r = 8.314 ! univ. gas constant [j k-1 mol-1] -! real, parameter :: alpha = 0.0027 ! empirical coefficient -! real, parameter :: cl1 = 1.066 ! empirical coefficient -! real, parameter :: ct1 = 95000.0 ! empirical coefficient [j mol-1] -! real, parameter :: ct2 = 230000.0 ! empirical coefficient [j mol-1] -! real, parameter :: ct3 = 0.961 ! empirical coefficient -! real, parameter :: tm = 314.0 ! empirical coefficient [k] -! real, parameter :: tstd = 303.0 ! std temperature [k] -! real, parameter :: bet = 0.09 ! beta empirical coefficient [k-1] +! real (kind=kind_phys), parameter :: r = 8.314 ! univ. gas constant [j k-1 mol-1] +! real (kind=kind_phys), parameter :: alpha = 0.0027 ! empirical coefficient +! real (kind=kind_phys), parameter :: cl1 = 1.066 ! empirical coefficient +! real (kind=kind_phys), parameter :: ct1 = 95000.0 ! empirical coefficient [j mol-1] +! real (kind=kind_phys), parameter :: ct2 = 230000.0 ! empirical coefficient [j mol-1] +! real (kind=kind_phys), parameter :: ct3 = 0.961 ! empirical coefficient +! real (kind=kind_phys), parameter :: tm = 314.0 ! empirical coefficient [k] +! real (kind=kind_phys), parameter :: tstd = 303.0 ! std temperature [k] +! real (kind=kind_phys), parameter :: bet = 0.09 ! beta empirical coefficient [k-1] ! ! integer ivoc ! do-loop index ! integer ityp ! do-loop index -! real epsilon(5) -! real gamma(5) -! real density -! real elai -! real par,cl,reciprod,ct +! real (kind=kind_phys) epsilon(5) +! real (kind=kind_phys) gamma(5) +! real (kind=kind_phys) density +! real (kind=kind_phys) elai +! real (kind=kind_phys) par,cl,reciprod,ct ! ! epsilon : ! @@ -8460,7 +9245,8 @@ end subroutine co2flux !>\ingroup NoahMP_LSM subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc ,iopt_frz , & - iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) + iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc, & + iopt_rsf , iopt_soil, iopt_pedo, iopt_crop ) implicit none @@ -8478,6 +9264,10 @@ subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc integer, intent(in) :: iopt_stc !snow/soil temperature time scheme (only layer 1) ! 1 -> semi-implicit; 2 -> full implicit (original noah) + integer, intent(in) :: iopt_rsf !surface resistance (1->sakaguchi/zeng; 2->seller; 3->mod sellers; 4->1+snow) + integer, intent(in) :: iopt_soil !soil parameters set-up option + integer, intent(in) :: iopt_pedo !pedo-transfer function (1->saxton and rawls) + integer, intent(in) :: iopt_crop !crop model option (0->none; 1->liu et al.) ! ------------------------------------------------------------------------------------------------- @@ -8494,9 +9284,12 @@ subroutine noahmp_options(idveg ,iopt_crs ,iopt_btr ,iopt_run ,iopt_sfc opt_snf = iopt_snf opt_tbot = iopt_tbot opt_stc = iopt_stc + opt_rsf = iopt_rsf + opt_soil = iopt_soil + opt_pedo = iopt_pedo + opt_crop = iopt_crop end subroutine noahmp_options - end module module_sf_noahmplsm diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 index 7bab292fb..84a5775a5 100644 --- a/physics/noahmp_tables.f90 +++ b/physics/noahmp_tables.f90 @@ -11,19 +11,15 @@ module noahmp_tables implicit none - integer :: i integer, private, parameter :: mvt = 30 ! use 30 instead of 27 integer, private, parameter :: mband = 2 integer, private, parameter :: msc = 8 integer, private, parameter :: max_soiltyp = 30 - integer, private, parameter :: slcats = 30 - real :: slope_table(9) !slope factor for soil drainage - -! crops - integer, private, parameter :: ncrop = 5 integer, private, parameter :: nstage = 8 + integer :: i + integer, private, parameter :: slcats = 30 ! mptable.tbl vegetation parameters @@ -31,7 +27,12 @@ module noahmp_tables integer :: iswater_table = 17 integer :: isbarren_table = 16 integer :: isice_table = 15 - integer :: eblforest_table = 2 + integer :: iscrop_table = 12 + integer :: eblforest_table = 2 + integer :: natural_table = 14 + integer :: low_density_residential_table = 31 + integer :: high_density_residential_table = 32 + integer :: high_intensity_industrial_table = 33 ! real :: ch2op_table(mvt) !maximum intercepted h2o per unit lai+sai (mm) @@ -88,12 +89,20 @@ module noahmp_tables & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / real :: mfsno_table(mvt) !snowmelt curve parameter () - data ( mfsno_table(i),i=1,mvt) / 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & - & 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & - & 2.50, 2.50, 2.50, 2.50, 2.50, 2.50, & - & 2.50, 2.50, 0.00, 0.00, 0.00, 0.00, & + data ( mfsno_table(i),i=1,mvt) / 1.00, 1.00, 1.00, 1.00, 1.00, 2.00, & + & 2.00, 2.00, 2.00, 2.00, 3.00, 3.00, & + & 4.00, 4.00, 2.50, 3.00, 3.00, 3.50, & + & 3.50, 3.50, 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / + real :: scffac_table(mvt) !snow cover factor (m) + data (scffac_table(i),i=1,mvt) / 0.005, 0.005, 0.005, 0.005, 0.005, & + & 0.008, 0.008, 0.010, 0.010, 0.010, & + & 0.010, 0.007, 0.021, 0.013, 0.015, & + & 0.008, 0.015, 0.015, 0.015, 0.015, & + & 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.000, 0.000, 0.000, 0.000, 0.000 / + ! real :: saim_table(mvt,12) !monthly stem area index, one-sided @@ -501,10 +510,10 @@ module noahmp_tables ! real :: cwpvt_table(mvt) !empirical canopy wind parameter - data ( cwpvt_table (i),i=1,mvt) / 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & - & 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & - & 0.18, 0.18, 0.18, 0.18, 0.18, 0.18, & - & 0.18, 0.18, 0.00, 0.00, 0.00, 0.00, & + data ( cwpvt_table (i),i=1,mvt) / 0.18, 0.67, 0.18, 0.67, 0.29, 1.00, & + & 2.00, 1.30, 1.00, 5.00, 1.17, 1.67, & + & 1.67, 1.67, 0.18, 0.18, 0.18, 0.67, & + & 1.00, 0.18, 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / @@ -635,15 +644,15 @@ module noahmp_tables real :: bexp_table(max_soiltyp) - data (bexp_table(i), i=1,slcats) /2.79, 4.26, 4.74, 5.33, 5.33, 5.25,& + data (bexp_table(i), i=1,slcats) /2.79, 4.26, 4.74, 5.33, 3.86, 5.25,& & 6.77, 8.72, 8.17, 10.73, 10.39, 11.55, & & 5.25, 0.0, 2.79, 4.26, 11.55, 2.79, & & 2.79, 0.00, 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / real :: smcdry_table(max_soiltyp) - data (smcdry_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.084,& - & 0.066, 0.067, 0.120, 0.103, 0.100, 0.126, 0.138, & + data (smcdry_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.061,& + & 0.066, 0.069, 0.120, 0.103, 0.100, 0.126, 0.138, & & 0.066, 0.0, 0.006, 0.028, 0.030, 0.006, & & 0.010, 0.000, 0.000, 0.000, 0.000, 0.000, & & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / @@ -658,7 +667,7 @@ module noahmp_tables real :: smcmax_table(max_soiltyp) - data (smcmax_table(i), i=1,slcats) /0.339, 0.421, 0.434, 0.476, 0.476,& + data (smcmax_table(i), i=1,slcats) /0.339, 0.421, 0.434, 0.476, 0.484,& & 0.439, 0.404, 0.464, 0.465, 0.406, 0.468, 0.468, & & 0.439, 1.000, 0.200, 0.421, 0.468, 0.200, & & 0.339, 0.339, 0.000, 0.000, 0.000, 0.000, & @@ -666,15 +675,15 @@ module noahmp_tables real :: smcref_table(max_soiltyp) - data (smcref_table(i), i=1,slcats) /0.236, 0.383, 0.383, 0.360, 0.383, & - & 0.329, 0.314, 0.387, 0.382, 0.338, 0.404, 0.412, & + data (smcref_table(i), i=1,slcats) /0.192, 0.283, 0.312, 0.360, 0.347, & + & 0.329, 0.315, 0.387, 0.382, 0.338, 0.404, 0.412, & & 0.329, 0.000, 0.170, 0.283, 0.454, 0.170, & - & 0.236, 0.000, 0.000, 0.000, 0.000, 0.000, & + & 0.192, 0.000, 0.000, 0.000, 0.000, 0.000, & & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / real :: psisat_table(max_soiltyp) - data (psisat_table(i), i=1,slcats) /0.069, 0.036, 0.141, 0.759, 0.759, & + data (psisat_table(i), i=1,slcats) /0.069, 0.036, 0.141, 0.759, 0.955, & & 0.355, 0.135, 0.617, 0.263, 0.098, 0.324, 0.468, & & 0.355, 0.00, 0.069, 0.036, 0.468, 0.069, & & 0.069, 0.00, 0.00, 0.00, 0.00, 0.00, & @@ -683,7 +692,7 @@ module noahmp_tables real :: dksat_table(max_soiltyp) data (dksat_table(i), i=1,slcats) /4.66e-5, 1.41e-5, 5.23e-6, 2.81e-6, & - & 2.81e-6, 3.38e-6, 4.45e-6, 2.03e-6, 2.45e-6,7.22e-6, & + & 2.18e-6, 3.38e-6, 4.45e-6, 2.03e-6, 2.45e-6,7.22e-6, & & 1.34e-6, 9.74e-7, 3.38e-6, 0.00, 1.41e-4, & & 1.41e-5, 9.74e-7, 1.41e-4, 4.66e-5,0.0, & & 0.00, 0.00, 0.00, 0.00, 0.00, & @@ -691,18 +700,18 @@ module noahmp_tables real :: dwsat_table(max_soiltyp) - data (dwsat_table(i), i=1,slcats) /0.608e-6, 0.514e-5, 0.805e-5, & - & 0.239e-4, 0.239e-4,0.143e-4, 0.99e-5, 0.237e-4, 0.113e-4, 0.187e-4, & - & 0.964e-5, 0.112e-4,0.143e-4,0.00, 0.136e-3, 0.514e-5, & - & 0.112e-4, 0.136e-3, 0.608e-6, 0.00, 0.00, & - & 0.00, 0.00, 0.00, 0.00, & + data (dwsat_table(i), i=1,slcats) / 2.65e-5, 5.14e-6, 8.05e-6, & + & 2.39e-5, 1.66e-5, 1.43e-5, 1.01e-5, 2.35e-5, 1.13e-5, 1.87e-5, & + & 9.64e-6, 1.12e-5, 1.43e-5, 0.00, 1.36e-4, 5.14e-6, & + & 1.12e-5, 1.36e-4, 2.65e-5, 0.00, 0.00, & + & 0.00, 0.00, 0.00, 0.00, & & 0.00, 0.00, 0.00, 0.00, 0.00 / real :: smcwlt_table(max_soiltyp) - data (smcwlt_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.084,& - & 0.066, 0.067, 0.120, 0.103, 0.100, 0.126, 0.138, & - & 0.066, 0.00, 0.006, 0.028, 0.03, 0.006, & + data (smcwlt_table(i), i=1,slcats) /0.010, 0.028, 0.047, 0.084, 0.061,& + & 0.066, 0.069, 0.120, 0.103, 0.100, 0.126, 0.138, & + & 0.066, 0.000, 0.006, 0.028, 0.030, 0.006, & & 0.010, 0.000, 0.000, 0.000, 0.000, 0.000, & & 0.000, 0.000, 0.000, 0.000, 0.000, 0.000 / @@ -717,6 +726,7 @@ module noahmp_tables ! genparm.tbl parameters + real :: slope_table(9) !slope factor for soil drainage data (slope_table(i), i=1,9) /0.1, 0.6, 1.0, 0.35, 0.55, 0.8, & & 0.63, 0.0, 0.0 / @@ -725,7 +735,7 @@ module noahmp_tables real :: refkdt_table = 3.0 !parameter in the surface runoff parameterization real :: frzk_table =0.15 !frozen ground parameter real :: zbot_table = -8.0 !depth [m] of lower boundary soil temperature - real :: czil_table = 0.075 !parameter used in the calculation of the roughness length for heat + real :: czil_table = 0.01 !parameter used in the calculation of the roughness length for heat ! mptable.tbl radiation parameters @@ -763,10 +773,26 @@ module noahmp_tables real :: o2_table = 0.209 !o2 partial pressure real :: timean_table = 10.5 !gridcell mean topgraphic index (global mean) real :: fsatmx_table = 0.38 !maximum surface saturated fraction (global mean) - real :: z0sno_table = 0.002 !snow surface roughness length (m) (0.002) - real :: ssi_table = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) - real :: swemx_table = 1.00 !new snow mass to fully cover old snow (mm) - real :: rsurf_snow_table = 50.0 !surface resistance for snow(s/m) + + real :: z0sno_table = 0.002 !snow surface roughness length (m) (0.002) + real :: ssi_table = 0.03 !liquid water holding capacity for snowpack (m3/m3) (0.03) + real :: snow_ret_fac_table = 5.e-5 !snowpack water release timescale factor (1/s) + real :: swemx_table = 1.00 !new snow mass to fully cover old snow (mm) + + real :: tau0_table = 1.e6 !tau0 from yang97 eqn. 10a + real :: grain_growth_table = 5000. !growth from vapor diffusion yang97 eqn. 10b + real :: extra_growth_table = 10. !extra growth near freezing yang97 eqn. 10c + real :: dirt_soot_table = 0.3 !dirt and soot term yang97 eqn. 10d + real :: bats_cosz_table = 2.0 !zenith angle snow albedo adjustment; b in yang97 eqn. 15 + real :: bats_vis_new_table = 0.95 !new snow visible albedo + real :: bats_nir_new_table = 0.65 !new snow nir albedo + real :: bats_vis_age_table = 0.2 !age factor for diffuse visible snow albedo yang97 eqn. 17 + real :: bats_nir_age_table = 0.5 !age factor for diffuse nir snow albedo yang97 eqn. 18 + real :: bats_vis_dir_table = 0.4 !cosz factor for direct visible snow albedo yang97 eqn. 15 + real :: bats_nir_dir_table = 0.4 !cosz factor for direct nir snow albedo yang97 eqn. 16 + real :: rsurf_snow_table = 50.0 !surface resistance for snow(s/m) + real :: rsurf_exp_table = 5.0 !exponent in the shape parameter for soil resistance option 1 + real :: snow_emis_table = 0.95 !surface emissivity ! Noah mp crops @@ -960,5 +986,61 @@ module noahmp_tables real :: bio2lai_table(ncrop) ! leaf are per living leaf biomass [m^2/kg] data (bio2lai_table(i),i=1,5) /0.035,0.015,0.015,0.015,0.015/ +! mptable.tbl optional parameters + + !------------------------------------------------------------------------------ + ! Saxton and Rawls 2006 Pedo-transfer function coefficients + !------------------------------------------------------------------------------ + + real :: sr2006_theta_1500t_a = -0.024 ! sand coefficient + real :: sr2006_theta_1500t_b = 0.487 ! clay coefficient + real :: sr2006_theta_1500t_c = 0.006 ! orgm coefficient + real :: sr2006_theta_1500t_d = 0.005 ! sand*orgm coefficient + real :: sr2006_theta_1500t_e = -0.013 ! clay*orgm coefficient + real :: sr2006_theta_1500t_f = 0.068 ! sand*clay coefficient + real :: sr2006_theta_1500t_g = 0.031 ! constant adjustment + + real :: sr2006_theta_1500_a = 0.14 ! theta_1500t coefficient + real :: sr2006_theta_1500_b = -0.02 ! constant adjustment + + real :: sr2006_theta_33t_a = -0.251 ! sand coefficient + real :: sr2006_theta_33t_b = 0.195 ! clay coefficient + real :: sr2006_theta_33t_c = 0.011 ! orgm coefficient + real :: sr2006_theta_33t_d = 0.006 ! sand*orgm coefficient + real :: sr2006_theta_33t_e = -0.027 ! clay*orgm coefficient + real :: sr2006_theta_33t_f = 0.452 ! sand*clay coefficient + real :: sr2006_theta_33t_g = 0.299 ! constant adjustment + + real :: sr2006_theta_33_a = 1.283 ! theta_33t*theta_33t coefficient + real :: sr2006_theta_33_b = -0.374 ! theta_33t coefficient + real :: sr2006_theta_33_c = -0.015 ! constant adjustment + + real :: sr2006_theta_s33t_a = 0.278 ! sand coefficient + real :: sr2006_theta_s33t_b = 0.034 ! clay coefficient + real :: sr2006_theta_s33t_c = 0.022 ! orgm coefficient + real :: sr2006_theta_s33t_d = -0.018 ! sand*orgm coefficient + real :: sr2006_theta_s33t_e = -0.027 ! clay*orgm coefficient + real :: sr2006_theta_s33t_f = -0.584 ! sand*clay coefficient + real :: sr2006_theta_s33t_g = 0.078 ! constant adjustment + + real :: sr2006_theta_s33_a = 0.636 ! theta_s33t coefficient + real :: sr2006_theta_s33_b = -0.107 ! constant adjustment + + real :: sr2006_psi_et_a = -21.67 ! sand coefficient + real :: sr2006_psi_et_b = -27.93 ! clay coefficient + real :: sr2006_psi_et_c = -81.97 ! theta_s33 coefficient + real :: sr2006_psi_et_d = 71.12 ! sand*theta_s33 coefficient + real :: sr2006_psi_et_e = 8.29 ! clay*theta_s33 coefficient + real :: sr2006_psi_et_f = 14.05 ! sand*clay coefficient + real :: sr2006_psi_et_g = 27.16 ! constant adjustment + + real :: sr2006_psi_e_a = 0.02 ! psi_et*psi_et coefficient + real :: sr2006_psi_e_b = -0.113 ! psi_et coefficient + real :: sr2006_psi_e_c = -0.7 ! constant adjustment + + real :: sr2006_smcmax_a = -0.097 ! sand adjustment + real :: sr2006_smcmax_b = 0.043 ! constant adjustment + + end module noahmp_tables diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index f0cbdd18a..63bc4f907 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -205,6 +205,12 @@ subroutine sfc_init & print *,' - Using MODIS based land surface albedo for sw' endif + elseif ( ialbflg == 2 ) then ! use albedo from land model + + if ( me == 0 ) then + print *,' - Using Albedo From Land Model' + endif + else print *,' !! ERROR in Albedo Scheme Setting, IALB=',ialbflg stop @@ -265,6 +271,12 @@ subroutine sfc_init & close(NIRADSF) endif ! end if_file_exist_block + elseif ( iemslw == 2 ) then ! use emiss from land model + + if ( me == 0 ) then + print *,' - Using Surface Emissivity From Land Model' + endif + else print *,' !! ERROR in Emissivity Scheme Setting, IEMS=',iemsflg stop @@ -319,7 +331,7 @@ end subroutine sfc_init subroutine setalb & & ( slmsk,snowf,sncovr,snoalb,zorlf,coszf,tsknf,tairf,hprif, & ! --- inputs: & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & - & IMAX, & + & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir,IMAX, & & albPpert, pertalb, & ! sfc-perts, mgehne & sfcalb & ! --- outputs: & ) @@ -389,6 +401,7 @@ subroutine setalb & real (kind=kind_phys), dimension(:), intent(in) :: & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & sncovr, snoalb, albPpert ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne @@ -513,7 +526,7 @@ subroutine setalb & enddo ! end_do_i_loop !> - If use modis based albedo for land area: - else + elseif ( ialbflg == 1 ) then do i = 1, IMAX @@ -623,6 +636,114 @@ subroutine setalb & enddo ! end_do_i_loop +!> -# use land model output for land area: + elseif ( ialbflg == 2 ) then + do i = 1, IMAX + +!> - albedo from noah mp already includes the snow portion + + fsno0 = f_zero + + if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero + + if (nint(slmsk(i)) == 2) then + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one, max(0.20, 1.0577-1.1538e-3*hprif(i) ) ) + fsno0 = asnow / (argh + asnow) * hrgh + endif + + fsno1 = f_one - fsno0 + flnd0 = min(f_one, facsf(i)+facwf(i)) + fsea0 = max(f_zero, f_one-flnd0) + fsno = fsno0 + fsea = fsea0 * fsno1 + flnd = flnd0 * fsno1 + +!> - Calculate diffused sea surface albedo. + + if (tsknf(i) >= 271.5) then + asevd = 0.06 + asend = 0.06 + elseif (tsknf(i) < 271.1) then + asevd = 0.70 + asend = 0.65 + else + a1 = (tsknf(i) - 271.1)**2 + asevd = 0.7 - 4.0*a1 + asend = 0.65 - 3.6875*a1 + endif + +!> - Calculate diffused snow albedo, land area use input max snow +!! albedo. + + if (nint(slmsk(i)) == 2) then + ffw = f_one - fice(i) + if (ffw < f_one) then + dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) + b1 = 0.03 * dtgd + else + b1 = f_zero + endif + + b3 = 0.06 * ffw + asnvd = (0.70 + b1) * fice(i) + b3 + asnnd = (0.60 + b1) * fice(i) + b3 + asevd = 0.70 * fice(i) + b3 + asend = 0.60 * fice(i) + b3 + else + asnvd = snoalb(i) + asnnd = snoalb(i) + endif + +!> - Calculate direct snow albedo. + + if (nint(slmsk(i)) == 2) then + if (coszf(i) < 0.5) then + csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) + asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) + asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + else + asnvb = asnvd + asnnb = asnnd + endif + endif + +!> - Calculate direct sea surface albedo, use fanglin's zenith angle +!! treatment. + + if (coszf(i) > 0.0001) then + +! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & +! & - 2.02*coszf(i)*coszf(i)*coszf(i) + rfcs = 1.775/(1.0+1.55*coszf(i)) + + if (tsknf(i) >= con_t0c) then + asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb = asevb + else + asevb = asevd + asenb = asend + endif + else + rfcs = f_one + asevb = asevd + asenb = asend + endif + + sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*flnd & + & + asenb*fsea + asnnb*fsno + sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*flnd & + & + asend*fsea + asnnd*fsno + sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*flnd & + & + asevb*fsea + asnvb*fsno + sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*flnd & + & + asevd*fsea + asnvd*fsno + + enddo ! end_do_i_loop + endif ! end if_ialbflg ! @@ -673,7 +794,7 @@ end subroutine setalb !----------------------------------- subroutine setemis & & ( xlon,xlat,slmsk,snowf,sncovr,zorlf,tsknf,tairf,hprif, & ! --- inputs: - & IMAX, & + & lsmemiss,IMAX, & & sfcemis & ! --- outputs: & ) @@ -699,6 +820,7 @@ subroutine setemis & ! tsknf (IMAX) - ground surface temperature in k ! ! tairf (IMAX) - lowest model layer air temperature in k ! ! hprif (IMAX) - topographic sdv in m ! +! lsmemiss(IMAX)- emissivity from lsm ! ! IMAX - array horizontal dimension ! ! ! ! outputs: ! @@ -722,7 +844,8 @@ subroutine setemis & integer, intent(in) :: IMAX real (kind=kind_phys), dimension(:), intent(in) :: & - & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif + & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif,& + & lsmemiss ! --- outputs real (kind=kind_phys), dimension(:), intent(out) :: sfcemis @@ -749,7 +872,7 @@ subroutine setemis & sfcemis(:) = f_one return - else ! emiss set by sfc type and condition + elseif ( iemslw == 1 ) then ! emiss set by sfc type and condition dltg = 360.0 / float(IMXEMS) hdlt = 0.5 * dltg @@ -830,6 +953,26 @@ subroutine setemis & enddo lab_do_IMAX + elseif ( iemslw == 2 ) then ! sfc emiss updated in land model + + do i = 1, IMAX + + if ( nint(slmsk(i)) == 0 ) then ! sea point + + sfcemis(i) = emsref(1) + + else if ( nint(slmsk(i)) == 2 ) then ! sea-ice + + sfcemis(i) = emsref(7) + + else ! land + + sfcemis(i) = lsmemiss(i) + + endif ! end if_slmsk_block + enddo + + endif ! end if_iemslw_block !chk print *,' In setemis, iemsflg, sfcemis =',iemsflg,sfcemis diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index d96a1f486..276a0a5bd 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -13,7 +13,7 @@ end subroutine rrtmg_lw_pre_init !! \htmlinclude rrtmg_lw_pre_run.html !! subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& - zorl, hprime, tsfg, tsfa, semis, errmsg, errflg) + zorl, hprime, tsfg, tsfa, semis, emiss, errmsg, errflg) use machine, only: kind_phys use module_radiation_surface, only: setemis @@ -23,7 +23,8 @@ subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& integer, intent(in) :: im logical, intent(in) :: lslwr real(kind=kind_phys), dimension(im), intent(in) :: xlat, xlon, slmsk, & - snowd, sncovr, zorl, hprime, tsfg, tsfa + snowd, sncovr, zorl, hprime, tsfg, tsfa + real(kind=kind_phys), dimension(:), intent(in) :: emiss real(kind=kind_phys), dimension(im), intent(out) :: semis character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -36,7 +37,7 @@ subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& !> - Call module_radiation_surface::setemis(),to setup surface !! emissivity for LW radiation. call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, & - hprime, im, & ! --- inputs + hprime, emiss, im, & ! --- inputs semis) ! --- outputs endif diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index bfb0bd61f..d62d9881c 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -113,6 +113,15 @@ kind = kind_phys intent = out optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index f54a5a963..89dc9acfe 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -14,7 +14,8 @@ end subroutine rrtmg_sw_pre_init !! subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf,& - alnwf, facsf, facwf, fice, tisfc, sfalb, nday, idxday, sfcalb1, & + alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & + sfalb, nday, idxday, sfcalb1, & sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) use machine, only: kind_phys @@ -36,6 +37,8 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln alvwf, alnwf, & facsf, facwf, & fice, tisfc + real(kind=kind_phys), dimension(:), intent(in) :: albdvis, albdnir, & + albivis, albinir real(kind=kind_phys), dimension(im), intent(inout) :: sfalb integer, intent(out) :: nday integer, dimension(im), intent(out) :: idxday @@ -83,8 +86,9 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln call setalb (slmsk, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, & ! --- inputs hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, & - tisfc, IM, alb1d, lndp_alb, & ! mg, sfc-perts - sfcalb) ! --- outputs + tisfc, albdvis, albdnir, albivis, albinir,IM, alb1d, & ! mg, sfc-perts + lndp_alb, sfcalb) ! --- outputs + !> -# Approximate mean surface albedo from vis- and nir- diffuse values. sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index b965b5381..49d83ff89 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -219,6 +219,42 @@ kind = kind_phys intent = in optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [sfalb] standard_name = surface_diffused_shortwave_albedo long_name = mean surface diffused sw albedo diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 358e49bee..44a30aa04 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -25,7 +25,7 @@ end subroutine rrtmgp_lw_pre_init !! \htmlinclude rrtmgp_lw_pre_run.html !! subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & - tsfg, tsfa, hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) + tsfg, tsfa, hprime, lw_gas_props, sfc_emiss_byband, emiss, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -42,6 +42,8 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc tsfg, & ! Surface ground temperature for radiation (K) tsfa, & ! Lowest model layer air temperature for radiation (K) hprime ! Standard deviation of subgrid orography + real(kind_phys), dimension(:), intent(in) :: & + emiss ! Surface emissivity from Noah MP type(ty_gas_optics_rrtmgp),intent(in) :: & lw_gas_props ! RRTMGP DDT: spectral information for LW calculation @@ -67,7 +69,7 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc ! ####################################################################################### ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. ! ####################################################################################### - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, nCol, semis) + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, emiss,nCol, semis) ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 1f329dd8d..5422e6318 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -112,14 +112,14 @@ type = ty_gas_optics_rrtmgp intent = in optional = F -[semis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = out + intent = in optional = F [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band @@ -130,6 +130,15 @@ kind = kind_phys intent = out optional = F +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sfc_noahmp_drv.F90 b/physics/sfc_noahmp_drv.F90 new file mode 100644 index 000000000..475520473 --- /dev/null +++ b/physics/sfc_noahmp_drv.F90 @@ -0,0 +1,1529 @@ +#define CCPP +!> \file sfc_noahmp_drv.F90 +!! This file contains the NoahMP land surface scheme driver. + +!>\defgroup NoahMP_LSM NoahMP LSM Model +!! \brief This is the NoahMP LSM driver module, with the functionality of +!! preparing variables to run the NoahMP LSM subroutine noahmp_sflx(), calling NoahMP LSM and post-processing +!! variables for return to the parent model suite including unit conversion, as well +!! as diagnotics calculation. + +!> This module contains the CCPP-compliant NoahMP land surface model driver. + module noahmpdrv + + implicit none + + private + + public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_finalize + + contains + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to +!! initialize soil and vegetation parameters for the chosen soil and vegetation data sources. +!! \section arg_table_noahmpdrv_init Argument Table +!! \htmlinclude noahmpdrv_init.html +!! + subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & + errmsg, errflg) + + use machine, only: kind_phys + use set_soilveg_mod, only: set_soilveg + use namelist_soilveg + + implicit none + + integer, intent(in) :: me, isot, ivegsrc, nlunit + + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (ivegsrc /= 1) then + errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + if (isot /= 1) then + errmsg = 'The NOAHMP LSM expects that the isot physics '// & + 'namelist parameter is 1. Exiting...' + errflg = 1 + return + end if + + !--- initialize soil vegetation + call set_soilveg(me, isot, ivegsrc, nlunit) + + pores (:) = maxsmc (:) + resid (:) = drysmc (:) + + end subroutine noahmpdrv_init + + subroutine noahmpdrv_finalize + end subroutine noahmpdrv_finalize + +!> \ingroup NoahMP_LSM +!! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. +!! \section arg_table_noahmpdrv_run Argument Table +!! \htmlinclude noahmpdrv_run.html +!! +!! \section general_noahmpdrv NoahMP Driver General Algorithm +!! @{ +!! - Initialize CCPP error handling variables. +!! - Set a flag to only continue with each grid cell if the fraction of land is non-zero. +!! - This driver may be called as part of an iterative loop. If called as the first "guess" run, +!! save land-related prognostic fields to restore. +!! - Initialize output variables to zero and prepare variables for input into the NoahMP LSM. +!! - Call transfer_mp_parameters() to fill a derived datatype for input into the NoahMP LSM. +!! - Call noahmp_options() to set module-level scheme options for the NoahMP LSM. +!! - If the vegetation type is ice for the grid cell, call noahmp_options_glacier() to set +!! module-level scheme options for NoahMP Glacier and call noahmp_glacier(). +!! - For other vegetation types, call noahmp_sflx(), the entry point of the NoahMP LSM. +!! - Set output variables from the output of noahmp_glacier() and/or noahmp_sflx(). +!! - Call penman() to calculate potential evaporation. +!! - Calculate the surface specific humidity and convert surface sensible and latent heat fluxes in W m-2 from their kinematic values. +!! - If a "guess" run, restore the land-related prognostic fields. +! ! +!----------------------------------- + subroutine noahmpdrv_run & +!................................... +! --- inputs: + ( im, km, itime, ps, u1, v1, t1, q1, soiltyp, vegtype, & + sigmaf, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & + prsl1, prslki, zf, dry, wind, slopetyp, & + shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & + idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & + iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, & + iopt_stc, xlatin, xcoszin, iyrlen, julian, & + rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, & + con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & + con_fvirt, con_rd, con_hfus, & + +! --- in/outs: + weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & + canopy, trans, tsurf, zorl, & + +! --- Noah MP specific + + snowxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy,& + chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy,& + waxy, wtxy, tsnoxy, zsnsoxy, snicexy, snliqxy, lfmassxy, & + rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, xlaixy, & + xsaixy, taussxy, smoiseq, smcwtdxy, deeprechxy, rechxy, & + albdvis, albdnir, albivis, albinir,emiss, & + +! --- outputs: + sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & + cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & + smcwlt2, smcref2, wet1, t2mmp, q2mp, errmsg, errflg) + + use machine , only : kind_phys + use funcphys, only : fpvs + + use module_sf_noahmplsm + use module_sf_noahmp_glacier + use noahmp_tables, only : isice_table, co2_table, o2_table, & + isurban_table,smcref_table,smcdry_table, & + smcmax_table,co2_table,o2_table, & + saim_table,laim_table + + implicit none + + real(kind=kind_phys), parameter :: a2 = 17.2693882 + real(kind=kind_phys), parameter :: a3 = 273.16 + real(kind=kind_phys), parameter :: a4 = 35.86 + real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) + + real, parameter :: undefined = -1.e36 ! TODO change to smaller value + + integer, parameter :: nsoil = 4 ! hardwired to Noah + integer, parameter :: nsnow = 3 ! max. snow layers + + real(kind=kind_phys), save :: zsoil(nsoil) + data zsoil / -0.1, -0.4, -1.0, -2.0 / + +! +! --- CCPP interface fields (in call order) +! + + integer , intent(in) :: im ! horiz dimension and num of used pts + integer , intent(in) :: km ! vertical soil layer dimension + integer , intent(in) :: itime ! NOT USED + real(kind=kind_phys), dimension(im) , intent(in) :: ps ! surface pressure [Pa] + real(kind=kind_phys), dimension(im) , intent(in) :: u1 ! u-component of wind [m/s] + real(kind=kind_phys), dimension(im) , intent(in) :: v1 ! u-component of wind [m/s] + real(kind=kind_phys), dimension(im) , intent(in) :: t1 ! layer 1 temperature [K] + real(kind=kind_phys), dimension(im) , intent(in) :: q1 ! layer 1 specific humidity [kg/kg] + integer , dimension(im) , intent(in) :: soiltyp ! soil type (integer index) + integer , dimension(im) , intent(in) :: vegtype ! vegetation type (integer index) + real(kind=kind_phys), dimension(im) , intent(in) :: sigmaf ! areal fractional cover of green vegetation + real(kind=kind_phys), dimension(im) , intent(in) :: dlwflx ! downward longwave radiation [W/m2] + real(kind=kind_phys), dimension(im) , intent(in) :: dswsfc ! downward shortwave radiation [W/m2] + real(kind=kind_phys), dimension(im) , intent(in) :: snet ! total sky sfc netsw flx into ground[W/m2] + real(kind=kind_phys) , intent(in) :: delt ! time interval [s] + real(kind=kind_phys), dimension(im) , intent(in) :: tg3 ! deep soil temperature [K] + real(kind=kind_phys), dimension(im) , intent(in) :: cm ! surface exchange coeff for momentum [-] + real(kind=kind_phys), dimension(im) , intent(in) :: ch ! surface exchange coeff heat & moisture[-] + real(kind=kind_phys), dimension(im) , intent(in) :: prsl1 ! sfc layer 1 mean pressure [Pa] + real(kind=kind_phys), dimension(im) , intent(in) :: prslki ! to calculate potential temperature + real(kind=kind_phys), dimension(im) , intent(in) :: zf ! height of bottom layer [m] + logical , dimension(im) , intent(in) :: dry ! = T if a point with any land + real(kind=kind_phys), dimension(im) , intent(in) :: wind ! wind speed [m/s] + integer , dimension(im) , intent(in) :: slopetyp ! surface slope classification + real(kind=kind_phys), dimension(im) , intent(in) :: shdmin ! min green vegetation coverage [fraction] + real(kind=kind_phys), dimension(im) , intent(in) :: shdmax ! max green vegetation coverage [fraction] + real(kind=kind_phys), dimension(im) , intent(in) :: snoalb ! upper bound on max albedo over deep snow + real(kind=kind_phys), dimension(im) , intent(inout) :: sfalb ! mean surface albedo [fraction] + logical , dimension(im) , intent(in) :: flag_iter ! + logical , dimension(im) , intent(in) :: flag_guess ! + integer , intent(in) :: idveg ! option for dynamic vegetation + integer , intent(in) :: iopt_crs ! option for canopy stomatal resistance + integer , intent(in) :: iopt_btr ! option for soil moisture factor for stomatal resistance + integer , intent(in) :: iopt_run ! option for runoff and groundwater + integer , intent(in) :: iopt_sfc ! option for surface layer drag coeff (ch & cm) + integer , intent(in) :: iopt_frz ! option for supercooled liquid water (or ice fraction) + integer , intent(in) :: iopt_inf ! option for frozen soil permeability + integer , intent(in) :: iopt_rad ! option for radiation transfer + integer , intent(in) :: iopt_alb ! option for ground snow surface albedo + integer , intent(in) :: iopt_snf ! option for partitioning precipitation into rainfall & snowfall + integer , intent(in) :: iopt_tbot ! option for lower boundary condition of soil temperature + integer , intent(in) :: iopt_stc ! option for snow/soil temperature time scheme (only layer 1) + real(kind=kind_phys), dimension(im) , intent(in) :: xlatin ! latitude + real(kind=kind_phys), dimension(im) , intent(in) :: xcoszin ! cosine of zenith angle + integer , intent(in) :: iyrlen ! year length [days] + real(kind=kind_phys) , intent(in) :: julian ! julian day of year + real(kind=kind_phys), dimension(im) , intent(in) :: rainn_mp ! microphysics non-convective precipitation [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: rainc_mp ! microphysics convective precipitation [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: snow_mp ! microphysics snow [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: graupel_mp ! microphysics graupel [mm] + real(kind=kind_phys), dimension(im) , intent(in) :: ice_mp ! microphysics ice/hail [mm] + real(kind=kind_phys) , intent(in) :: con_hvap ! latent heat condensation [J/kg] + real(kind=kind_phys) , intent(in) :: con_cp ! specific heat air [J/kg/K] + real(kind=kind_phys) , intent(in) :: con_jcal ! joules per calorie (not used) + real(kind=kind_phys) , intent(in) :: rhoh2o ! density of water [kg/m^3] + real(kind=kind_phys) , intent(in) :: con_eps ! Rd/Rv + real(kind=kind_phys) , intent(in) :: con_epsm1 ! Rd/Rv - 1 + real(kind=kind_phys) , intent(in) :: con_fvirt ! Rv/Rd - 1 + real(kind=kind_phys) , intent(in) :: con_rd ! gas constant air [J/kg/K] + real(kind=kind_phys) , intent(in) :: con_hfus ! lat heat H2O fusion [J/kg] + real(kind=kind_phys), dimension(im) , intent(inout) :: weasd ! water equivalent accumulated snow depth [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: snwdph ! snow depth [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: tskin ! ground surface skin temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: tprcp ! total precipitation [m] + real(kind=kind_phys), dimension(im) , intent(inout) :: srflag ! snow/rain flag for precipitation + real(kind=kind_phys), dimension(im,km) , intent(inout) :: smc ! total soil moisture content [m3/m3] + real(kind=kind_phys), dimension(im,km) , intent(inout) :: stc ! soil temp [K] + real(kind=kind_phys), dimension(im,km) , intent(inout) :: slc ! liquid soil moisture [m3/m3] + real(kind=kind_phys), dimension(im) , intent(inout) :: canopy ! canopy moisture content [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: trans ! total plant transpiration [m/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: tsurf ! surface skin temperature [after iteration] + real(kind=kind_phys), dimension(im) , intent(inout) :: zorl ! surface roughness [cm] + real(kind=kind_phys), dimension(im) , intent(inout) :: snowxy ! actual no. of snow layers + real(kind=kind_phys), dimension(im) , intent(inout) :: tvxy ! vegetation leaf temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: tgxy ! bulk ground surface temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: canicexy ! canopy-intercepted ice [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: canliqxy ! canopy-intercepted liquid water [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: eahxy ! canopy air vapor pressure [Pa] + real(kind=kind_phys), dimension(im) , intent(inout) :: tahxy ! canopy air temperature [K] + real(kind=kind_phys), dimension(im) , intent(inout) :: cmxy ! bulk momentum drag coefficient [m/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: chxy ! bulk sensible heat exchange coefficient [m/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: fwetxy ! wetted or snowed fraction of the canopy [-] + real(kind=kind_phys), dimension(im) , intent(inout) :: sneqvoxy ! snow mass at last time step[mm h2o] + real(kind=kind_phys), dimension(im) , intent(inout) :: alboldxy ! snow albedo at last time step [-] + real(kind=kind_phys), dimension(im) , intent(inout) :: qsnowxy ! snowfall on the ground [mm/s] + real(kind=kind_phys), dimension(im) , intent(inout) :: wslakexy ! lake water storage [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: zwtxy ! water table depth [m] + real(kind=kind_phys), dimension(im) , intent(inout) :: waxy ! water in the "aquifer" [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: wtxy ! groundwater storage [mm] + real(kind=kind_phys), dimension(im,-2:0), intent(inout) :: tsnoxy ! snow temperature [K] + real(kind=kind_phys), dimension(im,-2:4), intent(inout) :: zsnsoxy ! snow/soil layer depth [m] + real(kind=kind_phys), dimension(im,-2:0), intent(inout) :: snicexy ! snow layer ice [mm] + real(kind=kind_phys), dimension(im,-2:0), intent(inout) :: snliqxy ! snow layer liquid water [mm] + real(kind=kind_phys), dimension(im) , intent(inout) :: lfmassxy ! leaf mass [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: rtmassxy ! mass of fine roots [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: stmassxy ! stem mass [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: woodxy ! mass of wood (incl. woody roots) [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: stblcpxy ! stable carbon in deep soil [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: fastcpxy ! short-lived carbon, shallow soil [g/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: xlaixy ! leaf area index [m2/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: xsaixy ! stem area index [m2/m2] + real(kind=kind_phys), dimension(im) , intent(inout) :: taussxy ! snow age factor [-] + real(kind=kind_phys), dimension(im,1:4) , intent(inout) :: smoiseq ! eq volumetric soil moisture [m3/m3] + real(kind=kind_phys), dimension(im) , intent(inout) :: smcwtdxy ! soil moisture content in the layer to the water table when deep + real(kind=kind_phys), dimension(im) , intent(inout) :: deeprechxy ! recharge to the water table when deep + real(kind=kind_phys), dimension(im) , intent(inout) :: rechxy ! recharge to the water table + real(kind=kind_phys), dimension(im) , intent(out) :: albdvis ! albedo - direct visible [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: albdnir ! albedo - direct NIR [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: albivis ! albedo - diffuse visible [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: albinir ! albedo - diffuse NIR [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: emiss ! sfc lw emissivity [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: sncovr1 ! snow cover over land [fraction] + real(kind=kind_phys), dimension(im) , intent(out) :: qsurf ! specific humidity at sfc [kg/kg] + real(kind=kind_phys), dimension(im) , intent(out) :: gflux ! soil heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: drain ! subsurface runoff [mm/s] + real(kind=kind_phys), dimension(im) , intent(out) :: evap ! total latent heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: hflx ! sensible heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: ep ! potential evaporation [mm/s?] + real(kind=kind_phys), dimension(im) , intent(out) :: runoff ! surface runoff [mm/s] + real(kind=kind_phys), dimension(im) , intent(out) :: cmm ! cm*U [m/s] + real(kind=kind_phys), dimension(im) , intent(out) :: chh ! ch*U*rho [kg/m2/s] + real(kind=kind_phys), dimension(im) , intent(out) :: evbs ! direct soil evaporation [m/s] + real(kind=kind_phys), dimension(im) , intent(out) :: evcw ! canopy water evaporation [m/s] + real(kind=kind_phys), dimension(im) , intent(out) :: sbsno ! sublimation/deposit from snopack [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: snowc ! fractional snow cover [-] + real(kind=kind_phys), dimension(im) , intent(out) :: stm ! total soil column moisture content [mm] + real(kind=kind_phys), dimension(im) , intent(out) :: snohf ! snow/freezing-rain latent heat flux [W/m2] + real(kind=kind_phys), dimension(im) , intent(out) :: smcwlt2 ! dry soil moisture threshold [m3/m3] + real(kind=kind_phys), dimension(im) , intent(out) :: smcref2 ! soil moisture threshold [m3/m3] + real(kind=kind_phys), dimension(im) , intent(out) :: wet1 ! normalized surface soil saturated fraction + real(kind=kind_phys), dimension(im) , intent(out) :: t2mmp ! combined T2m from tiles + real(kind=kind_phys), dimension(im) , intent(out) :: q2mp ! combined q2m from tiles + character(len=*) , intent(out) :: errmsg + integer , intent(out) :: errflg + +! +! --- some new options, hard code for now +! + + integer :: iopt_rsf = 4 ! option for surface resistance + integer :: iopt_soil = 1 ! option for soil parameter treatment + integer :: iopt_pedo = 1 ! option for pedotransfer function + integer :: iopt_crop = 0 ! option for crop model + integer :: iopt_gla = 2 ! option for glacier treatment + +! +! --- guess iteration fields - target for removal +! + + real(kind=kind_phys), dimension(im) :: weasd_old + real(kind=kind_phys), dimension(im) :: snwdph_old + real(kind=kind_phys), dimension(im) :: tskin_old + real(kind=kind_phys), dimension(im) :: canopy_old + real(kind=kind_phys), dimension(im) :: tprcp_old + real(kind=kind_phys), dimension(im) :: srflag_old + real(kind=kind_phys), dimension(im) :: snow_old + real(kind=kind_phys), dimension(im) :: tv_old + real(kind=kind_phys), dimension(im) :: tg_old + real(kind=kind_phys), dimension(im) :: canice_old + real(kind=kind_phys), dimension(im) :: canliq_old + real(kind=kind_phys), dimension(im) :: eah_old + real(kind=kind_phys), dimension(im) :: tah_old + real(kind=kind_phys), dimension(im) :: fwet_old + real(kind=kind_phys), dimension(im) :: sneqvo_old + real(kind=kind_phys), dimension(im) :: albold_old + real(kind=kind_phys), dimension(im) :: qsnow_old + real(kind=kind_phys), dimension(im) :: wslake_old + real(kind=kind_phys), dimension(im) :: zwt_old + real(kind=kind_phys), dimension(im) :: wa_old + real(kind=kind_phys), dimension(im) :: wt_old + real(kind=kind_phys), dimension(im) :: lfmass_old + real(kind=kind_phys), dimension(im) :: rtmass_old + real(kind=kind_phys), dimension(im) :: stmass_old + real(kind=kind_phys), dimension(im) :: wood_old + real(kind=kind_phys), dimension(im) :: stblcp_old + real(kind=kind_phys), dimension(im) :: fastcp_old + real(kind=kind_phys), dimension(im) :: xlai_old + real(kind=kind_phys), dimension(im) :: xsai_old + real(kind=kind_phys), dimension(im) :: tauss_old + real(kind=kind_phys), dimension(im) :: smcwtd_old + real(kind=kind_phys), dimension(im) :: rech_old + real(kind=kind_phys), dimension(im) :: deeprech_old + real(kind=kind_phys), dimension(im, km) :: smc_old + real(kind=kind_phys), dimension(im, km) :: stc_old + real(kind=kind_phys), dimension(im, km) :: slc_old + real(kind=kind_phys), dimension(im, km) :: smoiseq_old + real(kind=kind_phys), dimension(im,-2: 0) :: tsno_old + real(kind=kind_phys), dimension(im,-2: 0) :: snice_old + real(kind=kind_phys), dimension(im,-2: 0) :: snliq_old + real(kind=kind_phys), dimension(im,-2:km) :: zsnso_old + real(kind=kind_phys), dimension(im,-2:km) :: tsnso_old + +! +! --- local inputs to noah-mp and glacier subroutines; listed in order in noah-mp call +! + ! intent + integer :: i_location ! in | grid index + integer :: j_location ! in | grid index (not used in ccpp) + real (kind=kind_phys) :: latitude ! in | latitude [radians] + integer :: year_length ! in | number of days in the current year + real (kind=kind_phys) :: julian_day ! in | julian day of year [floating point] + real (kind=kind_phys) :: cosine_zenith ! in | cosine solar zenith angle [-1,1] + real (kind=kind_phys) :: timestep ! in | time step [sec] + real (kind=kind_phys) :: spatial_scale ! in | spatial scale [m] (not used in noah-mp) + real (kind=kind_phys) :: atmosphere_thickness ! in | thickness of lowest atmo layer [m] (not used in noah-mp) + integer :: soil_levels ! in | soil levels + real (kind=kind_phys), dimension( 1:nsoil) :: soil_interface_depth ! in | soil layer-bottom depth from surface [m] + integer :: max_snow_levels ! in | maximum number of snow levels + real (kind=kind_phys) :: vegetation_frac ! in | vegetation fraction [0.0-1.0] + real (kind=kind_phys) :: max_vegetation_frac ! in | annual maximum vegetation fraction [0.0-1.0] + integer :: vegetation_category ! in | vegetation category + integer :: ice_flag ! in | ice flag (1->ice) + integer :: surface_type ! in | surface type flag 1->soil; 2->lake + integer :: crop_type ! in | crop type category + real (kind=kind_phys), dimension( 1:nsoil) :: eq_soil_water_vol ! in | (opt_run=5) equilibrium soil water content [m3/m3] + real (kind=kind_phys) :: temperature_forcing ! in | forcing air temperature [K] + real (kind=kind_phys) :: air_pressure_surface ! in | surface air pressure [Pa] + real (kind=kind_phys) :: air_pressure_forcing ! in | forcing air pressure [Pa] + real (kind=kind_phys) :: uwind_forcing ! in | forcing u-wind [m/s] + real (kind=kind_phys) :: vwind_forcing ! in | forcing v-wind [m/s] + real (kind=kind_phys) :: spec_humidity_forcing ! in | forcing mixing ratio [kg/kg] + real (kind=kind_phys) :: cloud_water_forcing ! in | cloud water mixing ratio [kg/kg] (not used in noah-mp) + real (kind=kind_phys) :: sw_radiation_forcing ! in | forcing downward shortwave radiation [W/m2] + real (kind=kind_phys) :: radiation_lw_forcing ! in | forcing downward longwave radiation [W/m2] + real (kind=kind_phys) :: precipitation_forcing ! in | total precipitation [mm/s] + real (kind=kind_phys) :: precip_convective ! in | convective precipitation [mm/s] + real (kind=kind_phys) :: precip_non_convective ! in | non-convective precipitation [mm/s] + real (kind=kind_phys) :: precip_sh_convective ! in | shallow convective precipitation [mm/s] + real (kind=kind_phys) :: precip_snow ! in | snow precipitation [mm/s] + real (kind=kind_phys) :: precip_graupel ! in | graupel precipitation [mm/s] + real (kind=kind_phys) :: precip_hail ! in | hail precipitation [mm/s] + real (kind=kind_phys) :: temperature_soil_bot ! in | soil bottom boundary condition temperature [K] + real (kind=kind_phys) :: co2_air ! in | atmospheric co2 concentration [Pa] + real (kind=kind_phys) :: o2_air ! in | atmospheric o2 concentration [Pa] + real (kind=kind_phys) :: foliage_nitrogen ! in | foliage nitrogen [%] [1-saturated] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_ice_frac_old ! in | snow ice fraction at last timestep [-] + real (kind=kind_phys) :: forcing_height ! inout | forcing height [m] + real (kind=kind_phys) :: snow_albedo_old ! inout | snow albedo at last time step (class option) [-] + real (kind=kind_phys) :: snow_water_equiv_old ! inout | snow water equivalent at last time step [mm] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: temperature_snow_soil ! inout | snow/soil temperature [K] + real (kind=kind_phys), dimension( 1:nsoil) :: soil_liquid_vol ! inout | volumetric liquid soil moisture [m3/m3] + real (kind=kind_phys), dimension( 1:nsoil) :: soil_moisture_vol ! inout | volumetric soil moisture (ice + liq.) [m3/m3] + real (kind=kind_phys) :: temperature_canopy_air! inout | canopy air tmeperature [K] + real (kind=kind_phys) :: vapor_pres_canopy_air ! inout | canopy air vapor pressure [Pa] + real (kind=kind_phys) :: canopy_wet_fraction ! inout | wetted or snowed fraction of canopy (-) + real (kind=kind_phys) :: canopy_liquid ! inout | canopy intercepted liquid [mm] + real (kind=kind_phys) :: canopy_ice ! inout | canopy intercepted ice [mm] + real (kind=kind_phys) :: temperature_leaf ! inout | leaf temperature [K] + real (kind=kind_phys) :: temperature_ground ! inout | grid ground surface temperature [K] + real (kind=kind_phys) :: spec_humidity_surface ! inout | surface specific humidty [kg/kg] + real (kind=kind_phys) :: snowfall ! inout | land model partitioned snowfall [mm/s] + real (kind=kind_phys) :: rainfall ! inout | land model partitioned rainfall [mm/s] + integer :: snow_levels ! inout | active snow levels [-] + real (kind=kind_phys), dimension(-nsnow+1:nsoil) :: interface_depth ! inout | layer-bottom depth from snow surf [m] + real (kind=kind_phys) :: snow_depth ! inout | snow depth [m] + real (kind=kind_phys) :: snow_water_equiv ! inout | snow water equivalent [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_level_ice ! inout | snow level ice [mm] + real (kind=kind_phys), dimension(-nsnow+1: 0) :: snow_level_liquid ! inout | snow level liquid [mm] + real (kind=kind_phys) :: depth_water_table ! inout | depth to water table [m] + real (kind=kind_phys) :: aquifer_water ! inout | water storage in aquifer [mm] + real (kind=kind_phys) :: saturated_water ! inout | water in aquifer+saturated soil [mm] + real (kind=kind_phys) :: lake_water ! inout | lake water storage (can be neg.) [mm] + real (kind=kind_phys) :: leaf_carbon ! inout | leaf mass [g/m2] + real (kind=kind_phys) :: root_carbon ! inout | mass of fine roots [g/m2] + real (kind=kind_phys) :: stem_carbon ! inout | stem mass [g/m2] + real (kind=kind_phys) :: wood_carbon ! inout | mass of wood (incl. woody roots) [g/m2] + real (kind=kind_phys) :: soil_carbon_stable ! inout | stable soil carbon [g/m2] + real (kind=kind_phys) :: soil_carbon_fast ! inout | short-lived soil carbon [g/m2] + real (kind=kind_phys) :: leaf_area_index ! inout | leaf area index [-] + real (kind=kind_phys) :: stem_area_index ! inout | stem area index [-] + real (kind=kind_phys) :: cm_noahmp ! inout | grid momentum drag coefficient [m/s] + real (kind=kind_phys) :: ch_noahmp ! inout | grid heat exchange coefficient [m/s] + real (kind=kind_phys) :: snow_age ! inout | non-dimensional snow age [-] + real (kind=kind_phys) :: grain_carbon ! inout | grain mass [g/m2] + real (kind=kind_phys) :: growing_deg_days ! inout | growing degree days [-] + integer :: plant_growth_stage ! inout | plant growing stage [-] + real (kind=kind_phys) :: soil_moisture_wtd ! inout | (opt_run=5) soil water content between bottom of the soil and water table [m3/m3] + real (kind=kind_phys) :: deep_recharge ! inout | (opt_run=5) recharge to or from the water table when deep [m] + real (kind=kind_phys) :: recharge ! inout | (opt_run=5) recharge to or from the water table when shallow [m] (diagnostic) + real (kind=kind_phys) :: z0_total ! out | weighted z0 sent to coupled model [m] + real (kind=kind_phys) :: sw_absorbed_total ! out | total absorbed solar radiation [W/m2] + real (kind=kind_phys) :: sw_reflected_total ! out | total reflected solar radiation [W/m2] + real (kind=kind_phys) :: lw_absorbed_total ! out | total net lw rad [W/m2] [+ to atm] + real (kind=kind_phys) :: sensible_heat_total ! out | total sensible heat [W/m2] [+ to atm] + real (kind=kind_phys) :: ground_heat_total ! out | ground heat flux [W/m2] [+ to soil] + real (kind=kind_phys) :: latent_heat_canopy ! out | canopy evaporation heat flux [W/m2] [+ to atm] + real (kind=kind_phys) :: latent_heat_ground ! out | ground evaporation heat flux [W/m2] [+ to atm] + real (kind=kind_phys) :: transpiration_heat ! out | transpiration heat flux [W/m2] [+ to atm] + real (kind=kind_phys) :: evaporation_canopy ! out | canopy evaporation [mm/s] + real (kind=kind_phys) :: transpiration ! out | transpiration [mm/s] + real (kind=kind_phys) :: evaporation_soil ! out | soil surface evaporation [mm/s] + real (kind=kind_phys) :: temperature_radiative ! out | surface radiative temperature [K] + real (kind=kind_phys) :: temperature_bare_grd ! out | bare ground surface temperature [K] + real (kind=kind_phys) :: temperature_veg_grd ! out | below_canopy ground surface temperature [K] + real (kind=kind_phys) :: temperature_veg_2m ! out | vegetated 2-m air temperature [K] + real (kind=kind_phys) :: temperature_bare_2m ! out | bare ground 2-m air temperature [K] + real (kind=kind_phys) :: spec_humidity_veg_2m ! out | vegetated 2-m air specific humidity [K] + real (kind=kind_phys) :: spec_humidity_bare_2m ! out | bare ground 2-m air specfic humidity [K] + real (kind=kind_phys) :: runoff_surface ! out | surface runoff [mm/s] + real (kind=kind_phys) :: runoff_baseflow ! out | baseflow runoff [mm/s] + real (kind=kind_phys) :: par_absorbed ! out | absorbed photosynthesis active radiation [W/m2] + real (kind=kind_phys) :: photosynthesis ! out | total photosynthesis [umol CO2/m2/s] [+ out] + real (kind=kind_phys) :: sw_absorbed_veg ! out | solar radiation absorbed by vegetation [W/m2] + real (kind=kind_phys) :: sw_absorbed_ground ! out | solar radiation absorbed by ground [W/m2] + real (kind=kind_phys) :: snow_cover_fraction ! out | snow cover fraction on the ground [-] + real (kind=kind_phys) :: net_eco_exchange ! out | net ecosystem exchange [g/m2/s CO2] + real (kind=kind_phys) :: global_prim_prod ! out | global primary production [g/m2/s C] + real (kind=kind_phys) :: net_prim_prod ! out | net primary productivity [g/m2/s C] + real (kind=kind_phys) :: vegetation_fraction ! out | vegetation fraction [0.0-1.0] + real (kind=kind_phys) :: albedo_total ! out | total surface albedo [-] + real (kind=kind_phys) :: snowmelt_out ! out | snowmelt out bottom of pack [mm/s] + real (kind=kind_phys) :: snowmelt_shallow ! out | shallow snow melt [mm] + real (kind=kind_phys) :: snowmelt_shallow_1 ! out | additional shallow snow melt [mm] + real (kind=kind_phys) :: snowmelt_shallow_2 ! out | additional shallow snow melt [mm] + real (kind=kind_phys) :: rs_sunlit ! out | sunlit leaf stomatal resistance [s/m] + real (kind=kind_phys) :: rs_shaded ! out | shaded leaf stomatal resistance [s/m] + real (kind=kind_phys), dimension(1:2) :: albedo_direct ! out | direct vis/nir albedo [-] + real (kind=kind_phys), dimension(1:2) :: albedo_diffuse ! out | diffuse vis/nir albedo [-] + real (kind=kind_phys), dimension(1:2) :: albedo_direct_snow ! out | direct vis/nir snow albedo [-] + real (kind=kind_phys), dimension(1:2) :: albedo_diffuse_snow ! out | diffuse vis/nir snow albedo [-] + real (kind=kind_phys) :: canopy_gap_fraction ! out | between canopy gap fraction [-] + real (kind=kind_phys) :: incanopy_gap_fraction ! out | within canopy gap fraction for beam [-] + real (kind=kind_phys) :: ch_vegetated ! out | vegetated heat exchange coefficient [m/s] + real (kind=kind_phys) :: ch_bare_ground ! out | bare-ground heat exchange coefficient [m/s] + real (kind=kind_phys) :: emissivity_total ! out | grid emissivity [-] + real (kind=kind_phys) :: sensible_heat_grd_veg ! out | below-canopy ground sensible heat flux [W/m2] + real (kind=kind_phys) :: sensible_heat_leaf ! out | leaf-to-canopy sensible heat flux [W/m2] + real (kind=kind_phys) :: sensible_heat_grd_bar ! out | bare ground sensible heat flux [W/m2] + real (kind=kind_phys) :: latent_heat_grd_veg ! out | below-canopy ground evaporation heat flux [W/m2] + real (kind=kind_phys) :: latent_heat_grd_bare ! out | bare ground evaporation heat flux [W/m2] + real (kind=kind_phys) :: ground_heat_veg ! out | below-canopy ground heat flux [W/m2] + real (kind=kind_phys) :: ground_heat_bare ! out | bare ground heat flux [W/m2] + real (kind=kind_phys) :: lw_absorbed_grd_veg ! out | below-canopy ground absorbed longwave radiation [W/m2] + real (kind=kind_phys) :: lw_absorbed_leaf ! out | leaf absorbed longwave radiation [W/m2] + real (kind=kind_phys) :: lw_absorbed_grd_bare ! out | bare ground net longwave radiation [W/m2] + real (kind=kind_phys) :: latent_heat_trans ! out | transpiration [W/m2] + real (kind=kind_phys) :: latent_heat_leaf ! out | leaf evaporation [W/m2] + real (kind=kind_phys) :: ch_leaf ! out | leaf exchange coefficient [m/s] + real (kind=kind_phys) :: ch_below_canopy ! out | below-canopy exchange coefficient [m/s] + real (kind=kind_phys) :: ch_vegetated_2m ! out | 2-m vegetated heat exchange coefficient [m/s] + real (kind=kind_phys) :: ch_bare_ground_2m ! out | 2-m bare-ground heat exchange coefficient [m/s] + real (kind=kind_phys) :: precip_frozen_frac ! out | precipitation snow fraction [-] + real (kind=kind_phys) :: precip_adv_heat_veg ! out | precipitation advected heat - vegetation net [W/m2] + real (kind=kind_phys) :: precip_adv_heat_grd_v ! out | precipitation advected heat - below-canopy net [W/m2] + real (kind=kind_phys) :: precip_adv_heat_grd_b ! out | precipitation advected heat - bare ground net [W/m2] + real (kind=kind_phys) :: precip_adv_heat_total ! out | precipitation advected heat - total [W/m2) + real (kind=kind_phys) :: snow_sublimation ! out | snow sublimation [W/m2] + real (kind=kind_phys) :: lai_sunlit ! out | sunlit leaf area index [m2/m2] + real (kind=kind_phys) :: lai_shaded ! out | shaded leaf area index [m2/m2] + real (kind=kind_phys) :: leaf_air_resistance ! out | leaf boundary layer resistance [s/m] + +! +! --- local variable +! + + integer :: soil_category(nsoil) + integer :: slope_category + integer :: soil_color_category + + real (kind=kind_phys) :: spec_humidity_sat ! saturation specific humidity + real (kind=kind_phys) :: vapor_pressure_sat ! saturation vapor pressure + real (kind=kind_phys) :: latent_heat_total ! total latent heat flux [W/m2] + real (kind=kind_phys) :: density ! air density + real (kind=kind_phys) :: virtual_temperature ! used for penman calculation and density + real (kind=kind_phys) :: potential_evaporation ! used for penman calculation + real (kind=kind_phys) :: potential_temperature ! used for penman calculation + real (kind=kind_phys) :: penman_radiation ! used for penman calculation + real (kind=kind_phys) :: dqsdt ! used for penman calculation + real (kind=kind_phys) :: precip_freeze_frac_in ! used for penman calculation + + logical :: is_snowing ! used for penman calculation + logical :: is_freeze_rain ! used for penman calculation + integer :: i, k + +! +! --- local derived constants: +! + + type(noahmp_parameters) :: parameters + +! +! --- end declaration +! + +! +! --- Initialize CCPP error handling variables +! + errmsg = '' + errflg = 0 + +! +! --- save land-related prognostic fields for guess run TARGET FOR REMOVAL +! + do i = 1, im + if (dry(i) .and. flag_guess(i)) then + weasd_old(i) = weasd(i) + snwdph_old(i) = snwdph(i) + tskin_old(i) = tskin(i) + canopy_old(i) = canopy(i) + tprcp_old(i) = tprcp(i) + srflag_old(i) = srflag(i) + snow_old(i) = snowxy(i) + tv_old(i) = tvxy(i) + tg_old(i) = tgxy(i) + canice_old(i) = canicexy(i) + canliq_old(i) = canliqxy(i) + eah_old(i) = eahxy(i) + tah_old(i) = tahxy(i) + fwet_old(i) = fwetxy(i) + sneqvo_old(i) = sneqvoxy(i) + albold_old(i) = alboldxy(i) + qsnow_old(i) = qsnowxy(i) + wslake_old(i) = wslakexy(i) + zwt_old(i) = zwtxy(i) + wa_old(i) = waxy(i) + wt_old(i) = wtxy(i) + lfmass_old(i) = lfmassxy(i) + rtmass_old(i) = rtmassxy(i) + stmass_old(i) = stmassxy(i) + wood_old(i) = woodxy(i) + stblcp_old(i) = stblcpxy(i) + fastcp_old(i) = fastcpxy(i) + xlai_old(i) = xlaixy(i) + xsai_old(i) = xsaixy(i) + tauss_old(i) = taussxy(i) + smcwtd_old(i) = smcwtdxy(i) + rech_old(i) = rechxy(i) + deeprech_old(i) = deeprechxy(i) + + do k = 1, km + smc_old(i,k) = smc(i,k) + stc_old(i,k) = stc(i,k) + slc_old(i,k) = slc(i,k) + smoiseq_old(i,k) = smoiseq(i,k) + end do + + do k = -2, 0 + tsno_old(i,k) = tsnoxy(i,k) + snice_old(i,k) = snicexy(i,k) + snliq_old(i,k) = snliqxy(i,k) + end do + + do k = -2, km + zsnso_old (i,k) = zsnsoxy(i,k) + end do + + end if ! dry(i) .and. flag_guess(i) + + end do ! im _old loop + + do i = 1, im + + if (flag_iter(i) .and. dry(i)) then + +! +! --- variable checks and derived fields +! + + if(vegtype(i) == isice_table ) then + if(weasd(i) < 0.1) then + weasd(i) = 0.1 + end if + end if + +! +! --- noah-mp input variables (except snow_ice_frac_old done later) +! + + i_location = i + j_location = -9999 + latitude = xlatin(i) + year_length = iyrlen + julian_day = julian + cosine_zenith = xcoszin(i) + timestep = delt + spatial_scale = -9999.0 + atmosphere_thickness = -9999.0 + soil_levels = km + soil_interface_depth = zsoil + max_snow_levels = nsnow + vegetation_frac = sigmaf(i) + max_vegetation_frac = shdmax(i) + vegetation_category = vegtype(i) + surface_type = 1 + crop_type = 0 + eq_soil_water_vol = smoiseq(i,:) ! only need for run=5 + temperature_forcing = t1(i) + air_pressure_surface = ps(i) + air_pressure_forcing = prsl1(i) + uwind_forcing = u1(i) + vwind_forcing = v1(i) + + spec_humidity_forcing = max(q1(i), 1.e-8) ! specific humidity at level 1 (kg/kg) + virtual_temperature = temperature_forcing * & + (1.0 + con_fvirt * spec_humidity_forcing) ! virtual temperature + vapor_pressure_sat = fpvs( temperature_forcing ) ! sat. vapor pressure at level 1 (Pa) + spec_humidity_sat = con_eps*vapor_pressure_sat / & + (prsl1(i) + con_epsm1*vapor_pressure_sat) ! sat. specific humidity at level 1 (kg/kg) + spec_humidity_sat = max(spec_humidity_sat, 1.e-8) ! lower limit sat. specific humidity (kg/kg) + spec_humidity_forcing = min(spec_humidity_sat,spec_humidity_forcing) ! limit specific humidity at level 1 (kg/kg) + + cloud_water_forcing = -9999.0 + sw_radiation_forcing = dswsfc(i) + radiation_lw_forcing = dlwflx(i) + precipitation_forcing = rhoh2o * tprcp(i) / delt !1000.0 * tprcp(i) / delt + precip_convective = rainc_mp(i) + precip_non_convective = rainn_mp(i) + precip_sh_convective = 0. + precip_snow = snow_mp(i) + precip_graupel = graupel_mp(i) + precip_hail = ice_mp(i) + temperature_soil_bot = tg3(i) + co2_air = co2_table * air_pressure_forcing + o2_air = o2_table * air_pressure_forcing + foliage_nitrogen = 1.0 + +! +! --- noah-mp inout variables +! + + forcing_height = zf(i) + snow_albedo_old = alboldxy(i) + snow_water_equiv_old = sneqvoxy(i) + temperature_snow_soil(-2: 0) = tsnoxy(i,:) + temperature_snow_soil( 1:km) = stc(i,:) + soil_liquid_vol = slc(i,:) + soil_moisture_vol = smc(i,:) + temperature_canopy_air = tahxy(i) + vapor_pres_canopy_air = (air_pressure_surface*spec_humidity_forcing)/(0.622+spec_humidity_forcing) + ! TODO recalculated? set to eahxy + canopy_wet_fraction = fwetxy(i) + canopy_liquid = canliqxy(i) + canopy_ice = canicexy(i) + temperature_leaf = tvxy(i) + temperature_ground = tgxy(i) + spec_humidity_surface = undefined ! doesn't need inout; should be out + snowfall = qsnowxy(i) ! doesn't need inout; should be out +! rainfall ! doesn't need inout; should be out TODO + snow_levels = nint(snowxy(i)) + interface_depth = zsnsoxy(i,:) + snow_depth = snwdph(i) * 0.001 ! convert from mm to m + snow_water_equiv = weasd(i) + if (snow_water_equiv /= 0.0 .and. snow_depth == 0.0) then !TODO this should be done elsewhere + snow_depth = 10.0 * snow_water_equiv /1000.0 + endif + snow_level_ice = snicexy(i,:) + snow_level_liquid = snliqxy(i,:) + depth_water_table = zwtxy(i) + aquifer_water = waxy(i) + saturated_water = waxy(i) ! why not wta !!! TODO + lake_water = wslakexy(i) + leaf_carbon = lfmassxy(i) + root_carbon = rtmassxy(i) + stem_carbon = stmassxy(i) + wood_carbon = woodxy(i) + soil_carbon_stable = stblcpxy(i) + soil_carbon_fast = fastcpxy(i) + leaf_area_index = xlaixy(i) + stem_area_index = xsaixy(i) + cm_noahmp = cmxy(i) + ch_noahmp = chxy(i) + snow_age = taussxy(i) +! grain_carbon ! new variable +! growing_deg_days ! new variable +! plant_growth_stage ! new variable + soil_moisture_wtd = smcwtdxy(i) + deep_recharge = deeprechxy(i) + recharge = rechxy(i) + + snow_ice_frac_old = 0.0 + do k = snow_levels+1, 0 + if(snow_level_ice(k) > 0.0 ) & + snow_ice_frac_old(k) = snow_level_ice(k) /(snow_level_ice(k)+snow_level_liquid(k)) + end do + +! +! --- some outputs for atm model? +! + density = air_pressure_forcing / (con_rd * virtual_temperature) + chh(i) = ch(i) * wind(i) * density + cmm(i) = cm(i) * wind(i) +! +! --- noah-mp additional variables +! + + soil_category = soiltyp(i) + slope_category = slopetyp(i) + soil_color_category = 4 + + call transfer_mp_parameters(vegetation_category,soil_category, & + slope_category,soil_color_category,crop_type,parameters) + + call noahmp_options(idveg ,iopt_crs, iopt_btr , iopt_run, iopt_sfc, & + iopt_frz, iopt_inf , iopt_rad, iopt_alb, & + iopt_snf, iopt_tbot, iopt_stc, & + iopt_rsf, iopt_soil, iopt_pedo, iopt_crop ) + + if ( vegetation_category == isice_table ) then + + if (precipitation_forcing > 0.0) then + if (srflag(i) > 0.0) then ! TODO rain/snow flag, one condition is enough? + snowfall = srflag(i) * precipitation_forcing/10.0 ! still use rho water? + endif + endif + + ice_flag = -1 + temperature_soil_bot = min(temperature_soil_bot,263.15) + + call noahmp_options_glacier(iopt_alb, iopt_snf, iopt_tbot, iopt_stc, iopt_gla ) + + call noahmp_glacier ( & + i_location ,1 ,cosine_zenith ,nsnow , & + nsoil ,timestep , & + temperature_forcing ,air_pressure_forcing ,uwind_forcing ,vwind_forcing , & + spec_humidity_forcing,sw_radiation_forcing ,precipitation_forcing,radiation_lw_forcing , & + temperature_soil_bot ,forcing_height ,snow_ice_frac_old ,zsoil , & + snowfall ,snow_water_equiv_old ,snow_albedo_old , & + cm_noahmp ,ch_noahmp ,snow_levels ,snow_water_equiv , & + soil_moisture_vol ,interface_depth ,snow_depth ,snow_level_ice , & + snow_level_liquid ,temperature_ground ,temperature_snow_soil,soil_liquid_vol , & + snow_age ,spec_humidity_surface,sw_absorbed_total ,sw_reflected_total , & + lw_absorbed_total ,sensible_heat_total ,latent_heat_ground ,ground_heat_total , & + temperature_radiative,evaporation_soil ,runoff_surface ,runoff_baseflow , & + sw_absorbed_ground ,albedo_total ,snowmelt_out ,snowmelt_shallow , & + snowmelt_shallow_1 ,snowmelt_shallow_2 ,temperature_bare_2m ,spec_humidity_bare_2m, & + emissivity_total ,precip_frozen_frac ,ch_bare_ground_2m ,snow_sublimation , & +#ifdef CCPP + albedo_direct ,albedo_diffuse ,errmsg ,errflg ) +#else + albedo_direct ,albedo_diffuse ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + +! +! set some non-glacier fields over the glacier +! + + snow_cover_fraction = 1.0 + temperature_leaf = undefined + canopy_ice = undefined + canopy_liquid = undefined + vapor_pres_canopy_air = undefined + temperature_canopy_air = undefined + canopy_wet_fraction = undefined + lake_water = undefined + depth_water_table = undefined + aquifer_water = undefined + saturated_water = undefined + leaf_carbon = undefined + root_carbon = undefined + stem_carbon = undefined + wood_carbon = undefined + soil_carbon_stable = undefined + soil_carbon_fast = undefined + leaf_area_index = undefined + stem_area_index = undefined + soil_moisture_wtd = 0.0 + recharge = 0.0 + deep_recharge = 0.0 + eq_soil_water_vol = soil_moisture_vol + transpiration_heat = undefined + latent_heat_canopy = undefined + z0_total = 0.002 + latent_heat_total = latent_heat_ground + t2mmp(i) = temperature_bare_2m + q2mp(i) = spec_humidity_bare_2m + + else ! not glacier + + ice_flag = 0 + + call noahmp_sflx (parameters , & + i_location ,j_location ,latitude , & + year_length ,julian_day ,cosine_zenith , & + timestep ,spatial_scale ,atmosphere_thickness , & + soil_levels ,soil_interface_depth ,max_snow_levels , & + vegetation_frac ,max_vegetation_frac ,vegetation_category , & + ice_flag ,surface_type ,crop_type , & + eq_soil_water_vol ,temperature_forcing ,air_pressure_forcing , & + air_pressure_surface ,uwind_forcing ,vwind_forcing , & + spec_humidity_forcing ,cloud_water_forcing ,sw_radiation_forcing , & + radiation_lw_forcing ,precip_convective , & + precip_non_convective ,precip_sh_convective ,precip_snow , & + precip_graupel ,precip_hail ,temperature_soil_bot , & + co2_air ,o2_air ,foliage_nitrogen , & + snow_ice_frac_old , & + forcing_height ,snow_albedo_old ,snow_water_equiv_old , & + temperature_snow_soil ,soil_liquid_vol ,soil_moisture_vol , & + temperature_canopy_air,vapor_pres_canopy_air ,canopy_wet_fraction , & + canopy_liquid ,canopy_ice ,temperature_leaf , & + temperature_ground ,spec_humidity_surface ,snowfall , & + rainfall ,snow_levels ,interface_depth , & + snow_depth ,snow_water_equiv ,snow_level_ice , & + snow_level_liquid ,depth_water_table ,aquifer_water , & + saturated_water , & + lake_water ,leaf_carbon ,root_carbon , & + stem_carbon ,wood_carbon ,soil_carbon_stable , & + soil_carbon_fast ,leaf_area_index ,stem_area_index , & + cm_noahmp ,ch_noahmp ,snow_age , & + grain_carbon ,growing_deg_days ,plant_growth_stage , & + soil_moisture_wtd ,deep_recharge ,recharge , & + z0_total ,sw_absorbed_total ,sw_reflected_total , & + lw_absorbed_total ,sensible_heat_total ,ground_heat_total , & + latent_heat_canopy ,latent_heat_ground ,transpiration_heat , & + evaporation_canopy ,transpiration ,evaporation_soil , & + temperature_radiative ,temperature_bare_grd ,temperature_veg_grd , & + temperature_veg_2m ,temperature_bare_2m ,spec_humidity_veg_2m , & + spec_humidity_bare_2m ,runoff_surface ,runoff_baseflow , & + par_absorbed ,photosynthesis ,sw_absorbed_veg , & + sw_absorbed_ground ,snow_cover_fraction ,net_eco_exchange , & + global_prim_prod ,net_prim_prod ,vegetation_fraction , & + albedo_total ,snowmelt_out ,snowmelt_shallow , & + snowmelt_shallow_1 ,snowmelt_shallow_2 ,rs_sunlit , & + rs_shaded ,albedo_direct ,albedo_diffuse , & + albedo_direct_snow ,albedo_diffuse_snow ,canopy_gap_fraction , & + incanopy_gap_fraction ,ch_vegetated ,ch_bare_ground , & + emissivity_total ,sensible_heat_grd_veg ,sensible_heat_leaf , & + sensible_heat_grd_bar ,latent_heat_grd_veg ,latent_heat_grd_bare , & + ground_heat_veg ,ground_heat_bare ,lw_absorbed_grd_veg , & + lw_absorbed_leaf ,lw_absorbed_grd_bare ,latent_heat_trans , & + latent_heat_leaf ,ch_leaf ,ch_below_canopy , & + ch_vegetated_2m ,ch_bare_ground_2m ,precip_frozen_frac , & + precip_adv_heat_veg ,precip_adv_heat_grd_v ,precip_adv_heat_grd_b , & + precip_adv_heat_total ,snow_sublimation ,lai_sunlit , & +#ifdef CCPP + lai_shaded ,leaf_air_resistance , & + errmsg ,errflg ) +#else + lai_shaded ,leaf_air_resistance ) +#endif + +#ifdef CCPP + if (errflg /= 0) return +#endif + + latent_heat_total = latent_heat_canopy + latent_heat_ground + transpiration_heat + + t2mmp(i) = temperature_veg_2m * vegetation_fraction + & + temperature_bare_2m * (1-vegetation_fraction) + q2mp(i) = spec_humidity_veg_2m * vegetation_fraction + & + spec_humidity_bare_2m * (1-vegetation_fraction) + + endif ! glacial split ends + +! +! --- noah-mp inout and out variables +! + + tsnoxy (i,:) = temperature_snow_soil(-2: 0) + stc (i,:) = temperature_snow_soil( 1:km) + hflx (i) = sensible_heat_total !note unit change below + evap (i) = latent_heat_total !note unit change below + evbs (i) = latent_heat_ground + evcw (i) = latent_heat_canopy + trans (i) = transpiration_heat + gflux (i) = -1.0*ground_heat_total ! opposite sign to be consistent with noah + snohf (i) = snowmelt_out * con_hfus ! only snow that exits pack + sbsno (i) = snow_sublimation + + cmxy (i) = cm_noahmp + chxy (i) = ch_noahmp + zorl (i) = z0_total * 100.0 ! convert to cm + + smc (i,:) = soil_moisture_vol + slc (i,:) = soil_liquid_vol + snowxy (i) = float(snow_levels) + weasd (i) = snow_water_equiv + snicexy (i,:) = snow_level_ice + snliqxy (i,:) = snow_level_liquid + snwdph (i) = snow_depth * 1000.0 ! convert from mm to m + canopy (i) = canopy_ice + canopy_liquid ! TODO check units + canliqxy (i) = canopy_liquid + canicexy (i) = canopy_ice + zwtxy (i) = depth_water_table + waxy (i) = aquifer_water + wtxy (i) = saturated_water + qsnowxy (i) = snowfall + drain (i) = runoff_baseflow + runoff (i) = runoff_surface + + lfmassxy (i) = leaf_carbon + rtmassxy (i) = root_carbon + stmassxy (i) = stem_carbon + woodxy (i) = wood_carbon + stblcpxy (i) = soil_carbon_stable + fastcpxy (i) = soil_carbon_fast + xlaixy (i) = leaf_area_index + xsaixy (i) = stem_area_index + + snowc (i) = snow_cover_fraction + sncovr1 (i) = snow_cover_fraction + ! TODO check this eqn shoud lthis be q2 not q1 why two con_cp + qsurf (i) = q1(i) + evap(i) / (con_hvap / con_cp * density * con_cp * ch(i) * wind(i)) + tskin (i) = temperature_radiative + tsurf (i) = temperature_radiative + tvxy (i) = temperature_leaf + tgxy (i) = temperature_ground + tahxy (i) = temperature_canopy_air + eahxy (i) = vapor_pres_canopy_air + emiss (i) = emissivity_total + + if(albedo_total > 0.0) then + sfalb(i) = albedo_total + albdvis(i) = albedo_direct(1) + albdnir(i) = albedo_direct(2) + albivis(i) = albedo_diffuse(1) + albinir(i) = albedo_diffuse(2) + end if + + zsnsoxy (i,:) = interface_depth + + wslakexy (i) = lake_water ! not active + fwetxy (i) = canopy_wet_fraction + taussxy (i) = snow_age + alboldxy (i) = snow_albedo_old + sneqvoxy (i) = snow_water_equiv_old + + smcwtdxy (i) = soil_moisture_wtd ! only need for run=5 + deeprechxy(i) = deep_recharge ! only need for run=5 + rechxy (i) = recharge ! only need for run=5 + smoiseq (i,:) = eq_soil_water_vol ! only need for run=5; listed as in + + stm (i) = (0.1*soil_moisture_vol(1) + & + 0.3*soil_moisture_vol(2) + & + 0.6*soil_moisture_vol(3) + & ! clean up and use depths above + 1.0*soil_moisture_vol(4))*1000.0 ! unit conversion from m to kg m-2 + + wet1 (i) = soil_moisture_vol(1) / smcmax_table(soil_category(1)) + smcwlt2(i) = smcdry_table(soil_category(1)) !!!change to wilt? + smcref2(i) = smcref_table(soil_category(1)) + +! +! --- change units for output +! + hflx(i) = hflx(i) / density / con_cp + evap(i) = evap(i) / density / con_hvap + +! +! --- calculate potential evaporation using noah code +! + potential_temperature = temperature_forcing * prslki(i) + virtual_temperature = temperature_forcing * (1.0 + 0.61*spec_humidity_forcing) + penman_radiation = sw_absorbed_total + radiation_lw_forcing + dqsdt = spec_humidity_sat * a23m4/(temperature_forcing-a4)**2 + + precip_freeze_frac_in = srflag(i) + is_snowing = .false. + is_freeze_rain = .false. + if (precipitation_forcing > 0.0) then + if (precip_freeze_frac_in > 0.0) then ! rain/snow flag, one condition is enough? + is_snowing = .true. + else + if (temperature_forcing <= 275.15) is_freeze_rain = .true. + end if + end if + + call penman (temperature_forcing, air_pressure_forcing , ch_noahmp , & + virtual_temperature, potential_temperature, precipitation_forcing, & + penman_radiation , ground_heat_total , spec_humidity_forcing, & + spec_humidity_sat , potential_evaporation, is_snowing , & + is_freeze_rain , precip_freeze_frac_in, dqsdt , & + emissivity_total , snow_cover_fraction ) + + ep(i) = potential_evaporation + + end if ! flag_iter(i) .and. dry(i) + + end do ! im loop + +! +! --- restore land-related prognostic fields for guess run TARGET FOR REMOVAL +! + + do i = 1, im + if (dry(i) .and. flag_guess(i)) then + weasd(i) = weasd_old(i) + snwdph(i) = snwdph_old(i) + tskin(i) = tskin_old(i) + canopy(i) = canopy_old(i) + tprcp(i) = tprcp_old(i) + srflag(i) = srflag_old(i) + snowxy(i) = snow_old(i) + tvxy(i) = tv_old(i) + tgxy(i) = tg_old(i) + canicexy(i) = canice_old(i) + canliqxy(i) = canliq_old(i) + eahxy(i) = eah_old(i) + tahxy(i) = tah_old(i) + fwetxy(i) = fwet_old(i) + sneqvoxy(i) = sneqvo_old(i) + alboldxy(i) = albold_old(i) + qsnowxy(i) = qsnow_old(i) + wslakexy(i) = wslake_old(i) + zwtxy(i) = zwt_old(i) + waxy(i) = wa_old(i) + wtxy(i) = wt_old(i) + lfmassxy(i) = lfmass_old(i) + rtmassxy(i) = rtmass_old(i) + stmassxy(i) = stmass_old(i) + woodxy(i) = wood_old(i) + stblcpxy(i) = stblcp_old(i) + fastcpxy(i) = fastcp_old(i) + xlaixy(i) = xlai_old(i) + xsaixy(i) = xsai_old(i) + taussxy(i) = tauss_old(i) + smcwtdxy(i) = smcwtd_old(i) + rechxy(i) = rech_old(i) + deeprechxy(i) = deeprech_old(i) + + do k = 1, km + smc(i,k) = smc_old(i,k) + stc(i,k) = stc_old(i,k) + slc(i,k) = slc_old(i,k) + smoiseq(i,k) = smoiseq_old(i,k) + end do + + do k = -2,0 + tsnoxy(i,k) = tsno_old(i,k) + snicexy(i,k) = snice_old(i,k) + snliqxy(i,k) = snliq_old(i,k) + end do + + do k = -2, km + zsnsoxy(i,k) = zsnso_old(i,k) + end do + + else + tskin(i) = tsurf(i) + + end if + end do + + return + + end subroutine noahmpdrv_run +!> @} +!----------------------------------- + +!> \ingroup NoahMP_LSM +!! \brief This subroutine fills in a derived data type of type noahmp_parameters with data +!! from the module \ref noahmp_tables. + subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & + soilcolor,croptype,parameters) + + use noahmp_tables + use module_sf_noahmplsm + + implicit none + + integer, intent(in) :: vegtype + integer, intent(in) :: soiltype(4) + integer, intent(in) :: slopetype + integer, intent(in) :: soilcolor + integer, intent(in) :: croptype + + type (noahmp_parameters), intent(out) :: parameters + + real :: refdk + real :: refkdt + real :: frzk + real :: frzfact + integer :: isoil + + parameters%iswater = iswater_table + parameters%isbarren = isbarren_table + parameters%isice = isice_table + parameters%iscrop = iscrop_table + parameters%eblforest = eblforest_table + +!-----------------------------------------------------------------------& + parameters%urban_flag = .false. + if( vegtype == isurban_table .or. vegtype == 31 & + & .or.vegtype == 32 .or. vegtype == 33) then + parameters%urban_flag = .true. + endif + +!------------------------------------------------------------------------------------------! +! transfer veg parameters +!------------------------------------------------------------------------------------------! + + parameters%ch2op = ch2op_table(vegtype) !maximum intercepted h2o per unit lai+sai (mm) + parameters%dleaf = dleaf_table(vegtype) !characteristic leaf dimension (m) + parameters%z0mvt = z0mvt_table(vegtype) !momentum roughness length (m) + parameters%hvt = hvt_table(vegtype) !top of canopy (m) + parameters%hvb = hvb_table(vegtype) !bottom of canopy (m) + parameters%den = den_table(vegtype) !tree density (no. of trunks per m2) + parameters%rc = rc_table(vegtype) !tree crown radius (m) + parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter () + parameters%scffac = scffac_table(vegtype) !snow cover factor + parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided + parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided + parameters%sla = sla_table(vegtype) !single-side leaf area per kg [m2/kg] + parameters%dilefc = dilefc_table(vegtype) !coeficient for leaf stress death [1/s] + parameters%dilefw = dilefw_table(vegtype) !coeficient for leaf stress death [1/s] + parameters%fragr = fragr_table(vegtype) !fraction of growth respiration !original was 0.3 + parameters%ltovrc = ltovrc_table(vegtype) !leaf turnover [1/s] + + parameters%c3psn = c3psn_table(vegtype) !photosynthetic pathway: 0. = c4, 1. = c3 + parameters%kc25 = kc25_table(vegtype) !co2 michaelis-menten constant at 25c (pa) + parameters%akc = akc_table(vegtype) !q10 for kc25 + parameters%ko25 = ko25_table(vegtype) !o2 michaelis-menten constant at 25c (pa) + parameters%ako = ako_table(vegtype) !q10 for ko25 + parameters%vcmx25 = vcmx25_table(vegtype) !maximum rate of carboxylation at 25c (umol co2/m**2/s) + parameters%avcmx = avcmx_table(vegtype) !q10 for vcmx25 + parameters%bp = bp_table(vegtype) !minimum leaf conductance (umol/m**2/s) + parameters%mp = mp_table(vegtype) !slope of conductance-to-photosynthesis relationship + parameters%qe25 = qe25_table(vegtype) !quantum efficiency at 25c (umol co2 / umol photon) + parameters%aqe = aqe_table(vegtype) !q10 for qe25 + parameters%rmf25 = rmf25_table(vegtype) !leaf maintenance respiration at 25c (umol co2/m**2/s) + parameters%rms25 = rms25_table(vegtype) !stem maintenance respiration at 25c (umol co2/kg bio/s) + parameters%rmr25 = rmr25_table(vegtype) !root maintenance respiration at 25c (umol co2/kg bio/s) + parameters%arm = arm_table(vegtype) !q10 for maintenance respiration + parameters%folnmx = folnmx_table(vegtype) !foliage nitrogen concentration when f(n)=1 (%) + parameters%tmin = tmin_table(vegtype) !minimum temperature for photosynthesis (k) + + parameters%xl = xl_table(vegtype) !leaf/stem orientation index + parameters%rhol = rhol_table(vegtype,:) !leaf reflectance: 1=vis, 2=nir + parameters%rhos = rhos_table(vegtype,:) !stem reflectance: 1=vis, 2=nir + parameters%taul = taul_table(vegtype,:) !leaf transmittance: 1=vis, 2=nir + parameters%taus = taus_table(vegtype,:) !stem transmittance: 1=vis, 2=nir + + parameters%mrp = mrp_table(vegtype) !microbial respiration parameter (umol co2 /kg c/ s) + parameters%cwpvt = cwpvt_table(vegtype) !empirical canopy wind parameter + + parameters%wrrat = wrrat_table(vegtype) !wood to non-wood ratio + parameters%wdpool = wdpool_table(vegtype) !wood pool (switch 1 or 0) depending on woody or not [-] + parameters%tdlef = tdlef_table(vegtype) !characteristic t for leaf freezing [k] + + parameters%nroot = nroot_table(vegtype) !number of soil layers with root present + parameters%rgl = rgl_table(vegtype) !parameter used in radiation stress function + parameters%rsmin = rs_table(vegtype) !minimum stomatal resistance [s m-1] + parameters%hs = hs_table(vegtype) !parameter used in vapor pressure deficit function + parameters%topt = topt_table(vegtype) !optimum transpiration air temperature [k] + parameters%rsmax = rsmax_table(vegtype) !maximal stomatal resistance [s m-1] + +!------------------------------------------------------------------------------------------! +! transfer rad parameters +!------------------------------------------------------------------------------------------! + + parameters%albsat = albsat_table(soilcolor,:) + parameters%albdry = albdry_table(soilcolor,:) + parameters%albice = albice_table + parameters%alblak = alblak_table + parameters%omegas = omegas_table + parameters%betads = betads_table + parameters%betais = betais_table + parameters%eg = eg_table + +!------------------------------------------------------------------------------------------! +! Transfer crop parameters +!------------------------------------------------------------------------------------------! + + if(croptype > 0) then + parameters%pltday = pltday_table(croptype) ! planting date + parameters%hsday = hsday_table(croptype) ! harvest date + parameters%plantpop = plantpop_table(croptype) ! plant density [per ha] - used? + parameters%irri = irri_table(croptype) ! irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) + parameters%gddtbase = gddtbase_table(croptype) ! base temperature for gdd accumulation [c] + parameters%gddtcut = gddtcut_table(croptype) ! upper temperature for gdd accumulation [c] + parameters%gdds1 = gdds1_table(croptype) ! gdd from seeding to emergence + parameters%gdds2 = gdds2_table(croptype) ! gdd from seeding to initial vegetative + parameters%gdds3 = gdds3_table(croptype) ! gdd from seeding to post vegetative + parameters%gdds4 = gdds4_table(croptype) ! gdd from seeding to intial reproductive + parameters%gdds5 = gdds5_table(croptype) ! gdd from seeding to pysical maturity + parameters%c3c4 = c3c4_table(croptype) ! photosynthetic pathway: 1. = c3 2. = c4 + parameters%aref = aref_table(croptype) ! reference maximum co2 assimulation rate + parameters%psnrf = psnrf_table(croptype) ! co2 assimulation reduction factor(0-1) (e.g.pests, weeds) + parameters%i2par = i2par_table(croptype) ! fraction of incoming solar radiation to photosynthetically active radiation + parameters%tassim0 = tassim0_table(croptype) ! minimum temperature for co2 assimulation [c] + parameters%tassim1 = tassim1_table(croptype) ! co2 assimulation linearly increasing until temperature reaches t1 [c] + parameters%tassim2 = tassim2_table(croptype) ! co2 assmilation rate remain at aref until temperature reaches t2 [c] + parameters%k = k_table(croptype) ! light extinction coefficient + parameters%epsi = epsi_table(croptype) ! initial light use efficiency + parameters%q10mr = q10mr_table(croptype) ! q10 for maintainance respiration + parameters%foln_mx = foln_mx_table(croptype) ! foliage nitrogen concentration when f(n)=1 (%) + parameters%lefreez = lefreez_table(croptype) ! characteristic t for leaf freezing [k] + parameters%dile_fc = dile_fc_table(croptype,:) ! coeficient for temperature leaf stress death [1/s] + parameters%dile_fw = dile_fw_table(croptype,:) ! coeficient for water leaf stress death [1/s] + parameters%fra_gr = fra_gr_table(croptype) ! fraction of growth respiration + parameters%lf_ovrc = lf_ovrc_table(croptype,:) ! fraction of leaf turnover [1/s] + parameters%st_ovrc = st_ovrc_table(croptype,:) ! fraction of stem turnover [1/s] + parameters%rt_ovrc = rt_ovrc_table(croptype,:) ! fraction of root tunrover [1/s] + parameters%lfmr25 = lfmr25_table(croptype) ! leaf maintenance respiration at 25c [umol co2/m**2 /s] + parameters%stmr25 = stmr25_table(croptype) ! stem maintenance respiration at 25c [umol co2/kg bio/s] + parameters%rtmr25 = rtmr25_table(croptype) ! root maintenance respiration at 25c [umol co2/kg bio/s] + parameters%grainmr25 = grainmr25_table(croptype) ! grain maintenance respiration at 25c [umol co2/kg bio/s] + parameters%lfpt = lfpt_table(croptype,:) ! fraction of carbohydrate flux to leaf + parameters%stpt = stpt_table(croptype,:) ! fraction of carbohydrate flux to stem + parameters%rtpt = rtpt_table(croptype,:) ! fraction of carbohydrate flux to root + parameters%grainpt = grainpt_table(croptype,:) ! fraction of carbohydrate flux to grain + parameters%bio2lai = bio2lai_table(croptype) ! leaf are per living leaf biomass [m^2/kg] + end if + +!------------------------------------------------------------------------------------------! +! transfer global parameters +!------------------------------------------------------------------------------------------! + + parameters%co2 = co2_table + parameters%o2 = o2_table + parameters%timean = timean_table + parameters%fsatmx = fsatmx_table + parameters%z0sno = z0sno_table + parameters%ssi = ssi_table + parameters%snow_ret_fac = snow_ret_fac_table + parameters%swemx = swemx_table + parameters%tau0 = tau0_table + parameters%grain_growth = grain_growth_table + parameters%extra_growth = extra_growth_table + parameters%dirt_soot = dirt_soot_table + parameters%bats_cosz = bats_cosz_table + parameters%bats_vis_new = bats_vis_new_table + parameters%bats_nir_new = bats_nir_new_table + parameters%bats_vis_age = bats_vis_age_table + parameters%bats_nir_age = bats_nir_age_table + parameters%bats_vis_dir = bats_vis_dir_table + parameters%bats_nir_dir = bats_nir_dir_table + parameters%rsurf_snow = rsurf_snow_table + parameters%rsurf_exp = rsurf_exp_table + parameters%snow_emis = snow_emis_table + +! ---------------------------------------------------------------------- +! transfer soil parameters +! ---------------------------------------------------------------------- + + do isoil = 1, size(soiltype) + parameters%bexp(isoil) = bexp_table (soiltype(isoil)) + parameters%dksat(isoil) = dksat_table (soiltype(isoil)) + parameters%dwsat(isoil) = dwsat_table (soiltype(isoil)) + parameters%psisat(isoil) = psisat_table (soiltype(isoil)) + parameters%quartz(isoil) = quartz_table (soiltype(isoil)) + parameters%smcdry(isoil) = smcdry_table (soiltype(isoil)) + parameters%smcmax(isoil) = smcmax_table (soiltype(isoil)) + parameters%smcref(isoil) = smcref_table (soiltype(isoil)) + parameters%smcwlt(isoil) = smcwlt_table (soiltype(isoil)) + end do + + parameters%f1 = f1_table(soiltype(1)) + parameters%refdk = refdk_table + parameters%refkdt = refkdt_table + +! ---------------------------------------------------------------------- +! transfer genparm parameters +! ---------------------------------------------------------------------- + parameters%csoil = csoil_table + parameters%zbot = zbot_table + parameters%czil = czil_table + + frzk = frzk_table + parameters%kdt = parameters%refkdt * parameters%dksat(1) / parameters%refdk + parameters%slope = slope_table(slopetype) + + if(parameters%urban_flag)then ! hardcoding some urban parameters for soil + parameters%smcmax = 0.45 + parameters%smcref = 0.42 + parameters%smcwlt = 0.40 + parameters%smcdry = 0.40 + parameters%csoil = 3.e6 + endif + + ! adjust frzk parameter to actual soil type: frzk * frzfact + +!-----------------------------------------------------------------------& + if(soiltype(1) /= 14) then + frzfact = (parameters%smcmax(1) / parameters%smcref(1)) * (0.412 / 0.468) + parameters%frzx = frzk * frzfact + end if + + end subroutine transfer_mp_parameters + +!> \ingroup NoahMP_LSM +!! \brief This subroutine uses a pedotransfer method to calculate soil properties. +SUBROUTINE PEDOTRANSFER_SR2006(nsoil,sand,clay,orgm,parameters) + + use module_sf_noahmplsm + use noahmp_tables + + implicit none + + integer, intent(in ) :: nsoil ! number of soil layers + real, dimension( 1:nsoil ), intent(inout) :: sand + real, dimension( 1:nsoil ), intent(inout) :: clay + real, dimension( 1:nsoil ), intent(inout) :: orgm + + real, dimension( 1:nsoil ) :: theta_1500t + real, dimension( 1:nsoil ) :: theta_1500 + real, dimension( 1:nsoil ) :: theta_33t + real, dimension( 1:nsoil ) :: theta_33 + real, dimension( 1:nsoil ) :: theta_s33t + real, dimension( 1:nsoil ) :: theta_s33 + real, dimension( 1:nsoil ) :: psi_et + real, dimension( 1:nsoil ) :: psi_e + + type(noahmp_parameters), intent(inout) :: parameters + integer :: k + + do k = 1,4 + if(sand(k) <= 0 .or. clay(k) <= 0) then + sand(k) = 0.41 + clay(k) = 0.18 + end if + if(orgm(k) <= 0 ) orgm(k) = 0.0 + end do + + theta_1500t = sr2006_theta_1500t_a*sand & + + sr2006_theta_1500t_b*clay & + + sr2006_theta_1500t_c*orgm & + + sr2006_theta_1500t_d*sand*orgm & + + sr2006_theta_1500t_e*clay*orgm & + + sr2006_theta_1500t_f*sand*clay & + + sr2006_theta_1500t_g + + theta_1500 = theta_1500t & + + sr2006_theta_1500_a*theta_1500t & + + sr2006_theta_1500_b + + theta_33t = sr2006_theta_33t_a*sand & + + sr2006_theta_33t_b*clay & + + sr2006_theta_33t_c*orgm & + + sr2006_theta_33t_d*sand*orgm & + + sr2006_theta_33t_e*clay*orgm & + + sr2006_theta_33t_f*sand*clay & + + sr2006_theta_33t_g + + theta_33 = theta_33t & + + sr2006_theta_33_a*theta_33t*theta_33t & + + sr2006_theta_33_b*theta_33t & + + sr2006_theta_33_c + + theta_s33t = sr2006_theta_s33t_a*sand & + + sr2006_theta_s33t_b*clay & + + sr2006_theta_s33t_c*orgm & + + sr2006_theta_s33t_d*sand*orgm & + + sr2006_theta_s33t_e*clay*orgm & + + sr2006_theta_s33t_f*sand*clay & + + sr2006_theta_s33t_g + + theta_s33 = theta_s33t & + + sr2006_theta_s33_a*theta_s33t & + + sr2006_theta_s33_b + + psi_et = sr2006_psi_et_a*sand & + + sr2006_psi_et_b*clay & + + sr2006_psi_et_c*theta_s33 & + + sr2006_psi_et_d*sand*theta_s33 & + + sr2006_psi_et_e*clay*theta_s33 & + + sr2006_psi_et_f*sand*clay & + + sr2006_psi_et_g + + psi_e = psi_et & + + sr2006_psi_e_a*psi_et*psi_et & + + sr2006_psi_e_b*psi_et & + + sr2006_psi_e_c + + parameters%smcwlt = theta_1500 + parameters%smcref = theta_33 + parameters%smcmax = theta_33 & + + theta_s33 & + + sr2006_smcmax_a*sand & + + sr2006_smcmax_b + + parameters%bexp = 3.816712826 / (log(theta_33) - log(theta_1500) ) + parameters%psisat = psi_e + parameters%dksat = 1930.0 * (parameters%smcmax - theta_33) ** (3.0 - 1.0/parameters%bexp) + parameters%quartz = sand + +! Units conversion + + parameters%psisat = max(0.1,parameters%psisat) ! arbitrarily impose a limit of 0.1kpa + parameters%psisat = 0.101997 * parameters%psisat ! convert kpa to m + parameters%dksat = parameters%dksat / 3600000.0 ! convert mm/h to m/s + parameters%dwsat = parameters%dksat * parameters%psisat *parameters%bexp / parameters%smcmax ! units should be m*m/s + parameters%smcdry = parameters%smcwlt + +! Introducing somewhat arbitrary limits (based on SOILPARM) to prevent bad things + + parameters%smcmax = max(0.32 ,min(parameters%smcmax, 0.50 )) + parameters%smcref = max(0.17 ,min(parameters%smcref,parameters%smcmax )) + parameters%smcwlt = max(0.01 ,min(parameters%smcwlt,parameters%smcref )) + parameters%smcdry = max(0.01 ,min(parameters%smcdry,parameters%smcref )) + parameters%bexp = max(2.50 ,min(parameters%bexp, 12.0 )) + parameters%psisat = max(0.03 ,min(parameters%psisat, 1.00 )) + parameters%dksat = max(5.e-7,min(parameters%dksat, 1.e-5)) + parameters%dwsat = max(1.e-6,min(parameters%dwsat, 3.e-5)) + parameters%quartz = max(0.05 ,min(parameters%quartz, 0.95 )) + + END SUBROUTINE PEDOTRANSFER_SR2006 + +!-----------------------------------------------------------------------& + +!> \ingroup NoahMP_LSM +!! brief Calculate potential evaporation for the current point. Various +!! partial sums/products are also calculated and passed back to the +!! calling routine for later use. + subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & + & q2,q2sat,etp,snowng,frzgra,ffrozp, & + & dqsdt2,emissi_in,sncovr) + +! etp is calcuated right after ssoil + +! ---------------------------------------------------------------------- +! subroutine penman +! ---------------------------------------------------------------------- + implicit none + logical, intent(in) :: snowng, frzgra + real, intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, & + & q2, q2sat,ssoil, sfcprs, sfctmp, & + & t2v, th2,emissi_in,sncovr + real, intent(out) :: etp + real :: epsca,flx2,rch,rr,t24 + real :: a, delta, fnet,rad,rho,emissi,elcp1,lvs + + real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6 + real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3 + real, parameter :: cpice = 2.106e+3, lsubf = 3.335e5 + real, parameter :: sigma = 5.6704e-8 + +! ---------------------------------------------------------------------- +! executable code begins here: +! ---------------------------------------------------------------------- +! ---------------------------------------------------------------------- +! prepare partial quantities for penman equation. +! ---------------------------------------------------------------------- + emissi=emissi_in +! elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc + lvs = (1.0-sncovr)*lsubc + sncovr*lsubs + + flx2 = 0.0 + delta = elcp * dqsdt2 +! delta = elcp1 * dqsdt2 + t24 = sfctmp * sfctmp * sfctmp * sfctmp + rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0 +! rr = emissi*t24 * 6.48e-8 / (sfcprs * ch) + 1.0 + rho = sfcprs / (rd * t2v) + +! ---------------------------------------------------------------------- +! adjust the partial sums / products with the latent heat +! effects caused by falling precipitation. +! ---------------------------------------------------------------------- + rch = rho * cp * ch + if (.not. snowng) then + if (prcp > 0.0) rr = rr + cph2o * prcp / rch + else +! ---- ... fractional snowfall/rainfall + rr = rr + (cpice*ffrozp+cph2o*(1.-ffrozp)) & + & *prcp/rch + end if + +! ---------------------------------------------------------------------- +! include the latent heat effects of frzng rain converting to ice on +! impact in the calculation of flx2 and fnet. +! ---------------------------------------------------------------------- +! fnet = fdown - sigma * t24- ssoil + fnet = fdown - emissi*sigma * t24- ssoil + if (frzgra) then + flx2 = - lsubf * prcp + fnet = fnet - flx2 +! ---------------------------------------------------------------------- +! finish penman equation calculations. +! ---------------------------------------------------------------------- + end if + rad = fnet / rch + th2- sfctmp + a = elcp * (q2sat - q2) +! a = elcp1 * (q2sat - q2) + epsca = (a * rr + rad * delta) / (delta + rr) + etp = epsca * rch / lsubc +! etp = epsca * rch / lvs + +! ---------------------------------------------------------------------- + end subroutine penman + + end module noahmpdrv diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f deleted file mode 100644 index 4dd419f0f..000000000 --- a/physics/sfc_noahmp_drv.f +++ /dev/null @@ -1,1257 +0,0 @@ -#define CCPP -!> \file sfc_noahmp_drv.f -!! This file contains the NoahMP land surface scheme driver. - -!>\defgroup NoahMP_LSM NoahMP LSM Model -!! \brief This is the NoahMP LSM driver module, with the functionality of -!! preparing variables to run the NoahMP LSM subroutine noahmp_sflx(), calling NoahMP LSM and post-processing -!! variables for return to the parent model suite including unit conversion, as well -!! as diagnotics calculation. - -!> This module contains the CCPP-compliant NoahMP land surface model driver. - module noahmpdrv - - implicit none - - private - - public :: noahmpdrv_init, noahmpdrv_run, noahmpdrv_finalize - - contains - -!> \ingroup NoahMP_LSM -!! \brief This subroutine is called during the CCPP initialization phase and calls set_soilveg() to -!! initialize soil and vegetation parameters for the chosen soil and vegetation data sources. -!! \section arg_table_noahmpdrv_init Argument Table -!! \htmlinclude noahmpdrv_init.html -!! - subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, - & errmsg, errflg) - - use machine, only: kind_phys - use set_soilveg_mod, only: set_soilveg - use namelist_soilveg - - implicit none - - integer, intent(in) :: me, isot, ivegsrc, nlunit - - real (kind=kind_phys), dimension(:), intent(out) :: pores, resid - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - if (ivegsrc /= 1) then - errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// - & 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if - if (isot /= 1) then - errmsg = 'The NOAHMP LSM expects that the isot physics '// - & 'namelist parameter is 1. Exiting...' - errflg = 1 - return - end if - - !--- initialize soil vegetation - call set_soilveg(me, isot, ivegsrc, nlunit) - - pores (:) = maxsmc (:) - resid (:) = drysmc (:) - - end subroutine noahmpdrv_init - - subroutine noahmpdrv_finalize - end subroutine noahmpdrv_finalize - -!> \ingroup NoahMP_LSM -!! \brief This subroutine is the main CCPP entry point for the NoahMP LSM. -!! \section arg_table_noahmpdrv_run Argument Table -!! \htmlinclude noahmpdrv_run.html -!! -!! \section general_noahmpdrv NoahMP Driver General Algorithm -!! @{ -!! - Initialize CCPP error handling variables. -!! - Set a flag to only continue with each grid cell if the fraction of land is non-zero. -!! - This driver may be called as part of an iterative loop. If called as the first "guess" run, -!! save land-related prognostic fields to restore. -!! - Initialize output variables to zero and prepare variables for input into the NoahMP LSM. -!! - Call transfer_mp_parameters() to fill a derived datatype for input into the NoahMP LSM. -!! - Call noahmp_options() to set module-level scheme options for the NoahMP LSM. -!! - If the vegetation type is ice for the grid cell, call noahmp_options_glacier() to set -!! module-level scheme options for NoahMP Glacier and call noahmp_glacier(). -!! - For other vegetation types, call noahmp_sflx(), the entry point of the NoahMP LSM. -!! - Set output variables from the output of noahmp_glacier() and/or noahmp_sflx(). -!! - Call penman() to calculate potential evaporation. -!! - Calculate the surface specific humidity and convert surface sensible and latent heat fluxes in W m-2 from their kinematic values. -!! - If a "guess" run, restore the land-related prognostic fields. -! ! -!----------------------------------- - subroutine noahmpdrv_run & -!................................... -! --- inputs: - & ( im, km, itime, ps, u1, v1, t1, q1, soiltyp, vegtype, & - & sigmaf, sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - & prsl1, prslki, zf, dry, wind, slopetyp, & - & shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & - & idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & - & iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, & - & iopt_stc, xlatin, xcoszin, iyrlen, julian, & - & rainn_mp, rainc_mp, snow_mp, graupel_mp, ice_mp, & - & con_hvap, con_cp, con_jcal, rhoh2o, con_eps, con_epsm1, & - & con_fvirt, con_rd, con_hfus, & - -! --- in/outs: - & weasd, snwdph, tskin, tprcp, srflag, smc, stc, slc, & - & canopy, trans, tsurf, zorl, & - -! --- Noah MP specific - - & snowxy, tvxy, tgxy, canicexy, canliqxy, eahxy, tahxy, cmxy,& - & chxy, fwetxy, sneqvoxy, alboldxy, qsnowxy, wslakexy, zwtxy,& - & waxy, wtxy, tsnoxy, zsnsoxy, snicexy, snliqxy, lfmassxy, & - & rtmassxy, stmassxy, woodxy, stblcpxy, fastcpxy, xlaixy, & - & xsaixy, taussxy, smoiseq, smcwtdxy, deeprechxy, rechxy, & - -! --- outputs: - & sncovr1, qsurf, gflux, drain, evap, hflx, ep, runoff, & - & cmm, chh, evbs, evcw, sbsno, snowc, stm, snohf, & - & smcwlt2, smcref2, wet1, t2mmp, q2mp, errmsg, errflg) -! -! - use machine , only : kind_phys -! use date_def, only : idate - use funcphys, only : fpvs - - use module_sf_noahmplsm - use module_sf_noahmp_glacier - use noahmp_tables, only : isice_table, co2_table, o2_table, & - & isurban_table,smcref_table,smcdry_table, & - & smcmax_table,co2_table,o2_table, & - & saim_table,laim_table - - implicit none - - real(kind=kind_phys), parameter :: a2 = 17.2693882 - real(kind=kind_phys), parameter :: a3 = 273.16 - real(kind=kind_phys), parameter :: a4 = 35.86 - real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) - - real, parameter :: undefined = -1.e36 - - real :: dz8w = undefined - real :: dx = undefined - real :: qc = undefined - real :: foln = 1.0 ! foliage - integer :: nsoil = 4 ! hardwired to Noah - integer :: nsnow = 3 ! max. snow layers - integer :: ist = 1 ! soil type, 1 soil; 2 lake; 14 is water - integer :: isc = 4 ! middle day soil color: soil 1-9 lightest - - real(kind=kind_phys), save :: zsoil(4),sldpth(4) - data zsoil / -0.1, -0.4, -1.0, -2.0 / - data sldpth /0.1, 0.3, 0.6, 1.0 / -! data dzs /0.1, 0.3, 0.6, 1.0 / - -! -! --- input: -! - - integer, intent(in) :: im, km, itime - - integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp - - real (kind=kind_phys), dimension(im), intent(in) :: ps, u1, v1, & - & t1, q1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & - & ch, prsl1, prslki, wind, shdmin, shdmax, & - & snoalb, sfalb, zf, & - & rainn_mp,rainc_mp,snow_mp,graupel_mp,ice_mp - - logical, dimension(im), intent(in) :: dry - - real (kind=kind_phys),dimension(im),intent(in) :: xlatin,xcoszin - - integer, intent(in) :: idveg, iopt_crs,iopt_btr,iopt_run, & - & iopt_sfc,iopt_frz,iopt_inf,iopt_rad, & - & iopt_alb,iopt_snf,iopt_tbot,iopt_stc - - real (kind=kind_phys), intent(in) :: julian - integer, intent(in) :: iyrlen - - - real (kind=kind_phys), intent(in) :: delt - logical, dimension(im), intent(in) :: flag_iter, flag_guess - - real (kind=kind_phys), intent(in) :: con_hvap, con_cp, con_jcal, & - & rhoh2o, con_eps, con_epsm1, con_fvirt, & - & con_rd, con_hfus - -! --- in/out: - real (kind=kind_phys), dimension(im), intent(inout) :: weasd, & - & snwdph, tskin, tprcp, srflag, canopy, trans, tsurf, zorl - - real (kind=kind_phys), dimension(im,km), intent(inout) :: & - & smc, stc, slc - - real (kind=kind_phys), dimension(im), intent(inout) :: snowxy, & - & tvxy,tgxy,canicexy,canliqxy,eahxy,tahxy, & - & cmxy,chxy,fwetxy,sneqvoxy,alboldxy,qsnowxy, & - & wslakexy,zwtxy,waxy,wtxy,lfmassxy,rtmassxy, & - & stmassxy,woodxy,stblcpxy,fastcpxy,xlaixy, & - & xsaixy,taussxy,smcwtdxy,deeprechxy,rechxy - - real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: tsnoxy - real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snicexy - real (kind=kind_phys),dimension(im,-2:0),intent(inout) :: snliqxy - real (kind=kind_phys),dimension(im,1:4), intent(inout) :: smoiseq - real (kind=kind_phys),dimension(im,-2:4),intent(inout) :: zsnsoxy - - integer, dimension(im) :: jsnowxy - real (kind=kind_phys),dimension(im) :: snodep - real (kind=kind_phys),dimension(im,-2:4) :: tsnsoxy - -! --- output: - - real (kind=kind_phys), dimension(im), intent(out) :: sncovr1, & - & qsurf, gflux, drain, evap, hflx, ep, runoff, cmm, chh, & - & evbs, evcw, sbsno, snowc, stm, snohf, smcwlt2, smcref2, wet1 - real (kind=kind_phys), dimension(:), intent(out) :: t2mmp, q2mp - -! error messages - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - -! --- locals: - real (kind=kind_phys), dimension(im) :: rch, rho, & - & q0, qs1, theta1, tv1, weasd_old, snwdph_old, & - & tprcp_old, srflag_old, tskin_old, canopy_old - - real (kind=kind_phys), dimension(km) :: et,stsoil,smsoil, slsoil - - real (kind=kind_phys),dimension(im,km) :: smc_old,stc_old,slc_old - - real (kind=kind_phys), dimension(im) :: snow_old, tv_old,tg_old, & - & canice_old,canliq_old,eah_old,tah_old,fwet_old,sneqvo_old, & - & albold_old,qsnow_old,wslake_old,zwt_old,wa_old,wt_old, & - & lfmass_old,rtmass_old,stmass_old,wood_old,stblcp_old, & - & fastcp_old,xlai_old,xsai_old,tauss_old,smcwtd_old, & - & deeprech_old,rech_old - - real(kind=kind_phys),dimension(im,1:4) :: smoiseq_old - real(kind=kind_phys),dimension(im,-2:0) :: tsno_old - real(kind=kind_phys),dimension(im,-2:0) :: snice_old - real(kind=kind_phys),dimension(im,-2:0) :: snliq_old - real(kind=kind_phys),dimension(im,-2:4) :: zsnso_old - real(kind=kind_phys),dimension(im,-2:4) :: tsnso_old - - - real (kind=kind_phys) :: alb, albedo, beta, chx, cmx, cmc, & - & dew, drip, dqsdt2, ec, edir, ett, eta, esnow, etp, & - & flx1, flx2, flx3, ffrozp, lwdn, pc, prcp, ptu, q2, & - & q2sat, solnet, rc, rcs, rct, rcq, rcsoil, rsmin, & - & runoff1, runoff2, runoff3, sfcspd, sfcprs, sfctmp, & - & sfcems, sheat, shdfac, shdmin1d, shdmax1d, smcwlt, & - & smcdry, smcref, smcmax, sneqv, snoalb1d, snowh, & - & snomlt, sncovr, soilw, soilm, ssoil, tsea, th2, & - & xlai, zlvl, swdn, tem, psfc,fdown,t2v,tbot - - real (kind=kind_phys) :: pconv,pnonc,pshcv,psnow,pgrpl,phail - real (kind=kind_phys) :: lat,cosz,uu,vv,swe - integer :: isnowx - - real (kind=kind_phys) :: tvx,tgx,canicex,canliqx,eahx, & - & tahx,fwetx,sneqvox,alboldx,qsnowx,wslakex,zwtx, & - & wax,wtx,lfmassx, rtmassx,stmassx, woodx,stblcpx, & - & fastcpx,xlaix,xsaix,taussx,smcwtdx,deeprechx,rechx, & - & qsfc1d - - real (kind=kind_phys), dimension(-2:0) :: tsnox, snicex, snliqx - real (kind=kind_phys), dimension(-2:0) :: ficeold - real (kind=kind_phys), dimension( km ) :: smoiseqx - real (kind=kind_phys), dimension(-2:4) :: zsnsox - real (kind=kind_phys), dimension(-2:4) :: tsnsox - - real (kind=kind_phys) :: z0wrf,fsa,fsr,fira,fsh,fcev,fgev, & - & fctr,ecan,etran,trad,tgb,tgv,t2mv, & - & t2mb,q2v,q2b,runsrf,runsub,apar, & - & psn,sav,sag,fsno,nee,gpp,npp,fveg, & - & qsnbot,ponding,ponding1,ponding2, & - & rssun,rssha,bgap,wgap,chv,chb,emissi, & - & shg,shc,shb,evg,evb,ghv,ghb,irg,irc, & - & irb,tr,evc,chleaf,chuc,chv2,chb2, & - & fpice,pahv,pahg,pahb,pah,co2pp,o2pp,ch2b - - integer :: i, k, ice, stype, vtype ,slope,nroot,couple - logical :: flag(im) - logical :: snowng,frzgra - - ! --- local derived constants: - - real(kind=kind_phys) :: cpinv, hvapi, convrad, elocp - - type(noahmp_parameters) :: parameters - -! -!===> ... begin here -! - cpinv = 1.0/con_cp - hvapi = 1.0/con_hvap - convrad = con_jcal*1.e4/60.0 - elocp = con_hvap/con_cp - -! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - -! --- ... set flag for land points - - do i = 1, im - flag(i) = dry(i) - enddo - -! --- ... save land-related prognostic fields for guess run - - do i = 1, im - if (flag(i) .and. flag_guess(i)) then - weasd_old(i) = weasd(i) - snwdph_old(i) = snwdph(i) - tskin_old(i) = tskin(i) - canopy_old(i) = canopy(i) - tprcp_old(i) = tprcp(i) - srflag_old(i) = srflag(i) -! -! - snow_old(i) = snowxy(i) - tv_old(i) = tvxy(i) - tg_old(i) = tgxy(i) - canice_old(i) = canicexy(i) - canliq_old(i) = canliqxy(i) - eah_old(i) = eahxy(i) - tah_old(i) = tahxy(i) - fwet_old(i) = fwetxy(i) - sneqvo_old(i) = sneqvoxy(i) - albold_old(i) = alboldxy(i) - qsnow_old(i) = qsnowxy(i) - wslake_old(i) = wslakexy(i) - zwt_old(i) = zwtxy(i) - wa_old(i) = waxy(i) - wt_old(i) = wtxy(i) - lfmass_old(i) = lfmassxy(i) - rtmass_old(i) = rtmassxy(i) - stmass_old(i) = stmassxy(i) - wood_old(i) = woodxy(i) - stblcp_old(i) = stblcpxy(i) - fastcp_old(i) = fastcpxy(i) - xlai_old(i) = xlaixy(i) - xsai_old(i) = xsaixy(i) - tauss_old(i) = taussxy(i) - smcwtd_old(i) = smcwtdxy(i) - rech_old(i) = rechxy(i) - - deeprech_old(i) = deeprechxy(i) -! - do k = 1, km - smc_old(i,k) = smc(i,k) - stc_old(i,k) = stc(i,k) - slc_old(i,k) = slc(i,k) - enddo - -! - do k = 1, km - smoiseq_old(i,k) = smoiseq(i,k) - enddo - - do k = -2,0 - tsno_old(i,k) = tsnoxy(i,k) - snice_old(i,k) = snicexy(i,k) - snliq_old(i,k) = snliqxy(i,k) - enddo - - do k = -2,4 - zsnso_old (i,k) = zsnsoxy(i,k) - enddo - - endif - enddo - -! -! call to init MP options -! -! &_________________________________________________________________ & - -! --- ... initialization block - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - ep(i) = 0.0 - evap (i) = 0.0 - hflx (i) = 0.0 - gflux(i) = 0.0 - drain(i) = 0.0 - canopy(i) = max(canopy(i), 0.0) - - evbs (i) = 0.0 - evcw (i) = 0.0 - trans(i) = 0.0 - sbsno(i) = 0.0 - snowc(i) = 0.0 - snohf(i) = 0.0 - endif - enddo - -! --- ... initialize variables - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - q0(i) = max(q1(i), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) - theta1(i) = t1(i) * prslki(i) !* adiabatic temp at level 1 (k) - - tv1(i) = t1(i) * (1.0 + con_fvirt*q0(i)) - rho(i) = prsl1(i) / (con_rd * tv1(i)) - qs1(i) = fpvs( t1(i) ) !* qs1=sat. humidity at level 1 (kg/kg) - qs1(i) = con_eps*qs1(i) / (prsl1(i) + con_epsm1*qs1(i)) - qs1(i) = max(qs1(i), 1.e-8) - q0 (i) = min(qs1(i), q0(i)) - - if (vegtype(i) == isice_table ) then - if (weasd(i) < 0.1) then - weasd(i) = 0.1 - endif - endif - - endif - enddo - -! --- ... noah: prepare variables to run noah lsm -! 1. configuration information (c): -! ------------------------------ -! couple - couple-uncouple flag (=1: coupled, =0: uncoupled) -! ffrozp - fraction for snow-rain (1.=snow, 0.=rain, 0-1 mixed)) -! ice - sea-ice flag (=1: sea-ice, =0: land) -! dt - timestep (sec) (dt should not exceed 3600 secs) = delt -! zlvl - height (m) above ground of atmospheric forcing variables -! nsoil - number of soil layers (at least 2) -! sldpth - the thickness of each soil layer (m) - - do i = 1, im - - if (flag_iter(i) .and. flag(i)) then - - - couple = 1 - - ice = 0 - nsoil = km - snowng = .false. - frzgra = .false. - - -! if (srflag(i) == 1.0) then ! snow phase -! ffrozp = 1.0 -! elseif (srflag(i) == 0.0) then ! rain phase -! ffrozp = 0.0 -! endif -! use srflag directly to allow fractional rain/snow - ffrozp = srflag(i) - - zlvl = zf(i) - -! 2. forcing data (f): -! ----------------- -! lwdn - lw dw radiation flux (w/m2) -! solnet - net sw radiation flux (dn-up) (w/m2) -! sfcprs - pressure at height zlvl above ground (pascals) -! prcp - precip rate (kg m-2 s-1) -! sfctmp - air temperature (k) at height zlvl above ground -! th2 - air potential temperature (k) at height zlvl above ground -! q2 - mixing ratio at height zlvl above ground (kg kg-1) - - lat = xlatin(i) ! in radian - cosz = xcoszin(i) - - lwdn = dlwflx(i) !..downward lw flux at sfc in w/m2 - swdn = dswsfc(i) !..downward sw flux at sfc in w/m2 - solnet = snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 - sfcems = sfcemis(i) - - sfctmp = t1(i) - sfcprs = prsl1(i) - psfc = ps(i) - prcp = rhoh2o * tprcp(i) / delt - - if (prcp > 0.0) then - if (ffrozp > 0.0) then ! rain/snow flag, one condition is enough? - snowng = .true. - qsnowxy(i) = ffrozp * prcp/10.0 !still use rho water? - else - if (sfctmp <= 275.15) frzgra = .true. - endif - endif - - th2 = theta1(i) - q2 = q0(i) - -! 3. other forcing (input) data (i): -! ------------------------------ -! sfcspd - wind speed (m s-1) at height zlvl above ground -! q2sat - sat mixing ratio at height zlvl above ground (kg kg-1) -! dqsdt2 - slope of sat specific humidity curve at t=sfctmp (kg kg-1 k-1) - - uu = u1(i) - vv = v1(i) - - sfcspd = wind(i) - q2sat = qs1(i) - dqsdt2 = q2sat * a23m4/(sfctmp-a4)**2 - -! 4. canopy/soil characteristics (s): -! -------------------------------- -! vegtyp - vegetation type (integer index) -> vtype -! soiltyp - soil type (integer index) -> stype -! slopetyp- class of sfc slope (integer index) -> slope -! shdfac - areal fractional coverage of green vegetation (0.0-1.0) -! shdmin - minimum areal fractional coverage of green vegetation -> shdmin1d -! ptu - photo thermal unit (plant phenology for annuals/crops) -! alb - backround snow-free surface albedo (fraction) -! snoalb - upper bound on maximum albedo over deep snow -> snoalb1d -! tbot - bottom soil temperature (local yearly-mean sfc air temp) - - vtype = vegtype(i) - stype = soiltyp(i) - slope = slopetyp(i) - shdfac= sigmaf(i) - - shdmin1d = shdmin(i) - shdmax1d = shdmax(i) - snoalb1d = snoalb(i) - - alb = sfalb(i) - - tbot = tg3(i) - ptu = 0.0 - - - cmc = canopy(i)/1000. ! convert from mm to m - tsea = tsurf(i) ! clu_q2m_iter - - snowh = snwdph(i) * 0.001 ! convert from mm to m - sneqv = weasd(i) * 0.001 ! convert from mm to m - - - -! 5. history (state) variables (h): -! ------------------------------ -! cmc - canopy moisture content (m) -! t1 - ground/canopy/snowpack) effective skin temperature (k) -> tsea -! stc(nsoil) - soil temp (k) -> stsoil -! smc(nsoil) - total soil moisture content (volumetric fraction) -> smsoil -! sh2o(nsoil)- unfrozen soil moisture content (volumetric fraction) -> slsoil -! snowh - actual snow depth (m) -! sneqv - liquid water-equivalent snow depth (m) -! albedo - surface albedo including snow effect (unitless fraction) -! ch - surface exchange coefficient for heat and moisture (m s-1) -> chx -! cm - surface exchange coefficient for momentum (m s-1) -> cmx - - isnowx = nint(snowxy(i)) - tvx = tvxy(i) - tgx = tgxy(i) - canliqx = canliqxy(i) !in mm - canicex = canicexy(i) - - eahxy(i) = (ps(i)*q2)/(0.622+q2) ! use q0 to reinit; - eahx = eahxy(i) - tahx = tahxy(i) - - co2pp = co2_table * sfcprs - o2pp = o2_table * sfcprs - fwetx = fwetxy(i) - - sneqvox = sneqvoxy(i) - alboldx = alboldxy(i) - - qsnowx = qsnowxy(i) - wslakex = wslakexy(i) - - zwtx = zwtxy(i) - wax = waxy(i) - wtx = waxy(i) - - do k = -2,0 - tsnsoxy(i,k) = tsnoxy(i,k) - enddo - - do k = 1,4 - tsnsoxy(i,k) = stc(i,k) - enddo - - do k = -2,0 - snicex(k) = snicexy(i,k) ! in k/m3; mm - snliqx(k) = snliqxy(i,k) ! in k/m3; mm - tsnox (k) = tsnoxy(i,k) - - ficeold(k) = 0.0 ! derived - - if (snicex(k) > 0.0 ) then - ficeold(k) = snicex(k) /(snicex(k)+snliqx(k)) - - endif - enddo - - do k = -2, km - zsnsox(k) = zsnsoxy(i,k) - tsnsox(k) = tsnsoxy(i,k) - enddo - - lfmassx = lfmassxy(i) - rtmassx = rtmassxy(i) - stmassx = stmassxy(i) - - woodx = woodxy(i) - stblcpx = stblcpxy(i) - fastcpx = fastcpxy(i) - - xsaix = xsaixy(i) - xlaix = xlaixy(i) - - taussx = taussxy(i) - - qsfc1d = undefined ! derive later, it is an in/out? - swe = weasd(i) - - do k = 1, km - smoiseqx(k) = smoiseq(i,k) - enddo - - smcwtdx = smcwtdxy(i) - rechx = rechxy(i) - deeprechx = deeprechxy(i) -!-- -! the optional details for precip -!-- - -! pconv = 0. ! convective - may introduce later -! pnonc = (1 - ffrozp) * prcp ! large scale total in mm/s; -! pshcv = 0. -! psnow = ffrozp * prcp /10.0 ! snow = qsnowx? -! pgrpl = 0. -! phail = 0. - pnonc = rainn_mp(i) - pconv = rainc_mp(i) - pshcv = 0. - psnow = snow_mp(i) - pgrpl = graupel_mp(i) - phail = ice_mp(i) -! -!-- old -! - do k = 1, km -! stsoil(k) = stc(i,k) - smsoil(k) = smc(i,k) - slsoil(k) = slc(i,k) - enddo - - snowh = snwdph(i) * 0.001 ! convert from mm to m - - if (swe /= 0.0 .and. snowh == 0.0) then - snowh = 10.0 * swe /1000.0 - endif - - chx = chxy(i) ! maybe chxy - cmx = cmxy(i) - - chh(i) = ch(i) * wind(i) * rho(i) - cmm(i) = cm(i) * wind(i) - - - - call transfer_mp_parameters(vtype,stype,slope,isc,parameters) - - call noahmp_options(idveg ,iopt_crs,iopt_btr,iopt_run,iopt_sfc, & - & iopt_frz,iopt_inf,iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc) - - if ( vtype == isice_table ) then - - ice = -1 - tbot = min(tbot,263.15) - - call noahmp_options_glacier & - & (idveg ,iopt_crs ,iopt_btr, iopt_run ,iopt_sfc ,iopt_frz, & - & iopt_inf ,iopt_rad ,iopt_alb ,iopt_snf ,iopt_tbot, iopt_stc ) - - call noahmp_glacier ( & - & i ,1 ,cosz ,nsnow ,nsoil ,delt , & ! in : time/space/model-related - & sfctmp ,sfcprs ,uu ,vv ,q2 ,swdn , & ! in : forcing - & prcp ,lwdn ,tbot ,zlvl ,ficeold ,zsoil , & ! in : forcing - & qsnowx ,sneqvox ,alboldx ,cmx ,chx ,isnowx, & ! in/out :sneqvox + alboldx -LST - & swe ,smsoil ,zsnsox ,snowh ,snicex ,snliqx , & ! in/out : sneqvx + snowhx are avgd - & tgx ,tsnsox ,slsoil ,taussx ,qsfc1d , & ! in/out : - & fsa ,fsr ,fira ,fsh ,fgev ,ssoil , & ! out : - & trad ,edir ,runsrf ,runsub ,sag ,albedo , & ! out : albedo is surface albedo - & qsnbot ,ponding ,ponding1,ponding2,t2mb ,q2b , & ! out : -#ifdef CCPP - & emissi ,fpice ,ch2b ,esnow, errmsg, errflg ) -#else - & emissi ,fpice ,ch2b ,esnow ) -#endif - -#ifdef CCPP - if (errflg /= 0) return -#endif -! -! in/out and outs -! - - fsno = 1.0 - - tvx = undefined - canicex = undefined - canliqx = undefined - eahx = undefined - tahx = undefined - - fwetx = undefined - wslakex = undefined - zwtx = undefined - wax = undefined - wtx = undefined - - lfmassx = undefined - rtmassx = undefined - stmassx = undefined - woodx = undefined - stblcpx = undefined - fastcpx = undefined - xlaix = undefined - xsaix = undefined - - smcwtdx = 0.0 - rechx = 0.0 - deeprechx = 0.0 - - do k = 1,4 - smoiseqx(k) = smsoil(k) - enddo - - fctr = undefined - fcev = undefined - - z0wrf = 0.002 - - eta = fgev - t2mmp(i) = t2mb - q2mp(i) = q2b -! -! Non-glacial case -! - else - ice = 0 - -! write(*,*)'tsnsox(1)=',tsnsox,'tgx=',tgx - call noahmp_sflx (parameters ,& - & i , 1 , lat , iyrlen , julian , cosz ,& ! in : time/space-related - & delt , dx , dz8w , nsoil , zsoil , nsnow ,& ! in : model configuration - & shdfac , shdmax1d, vtype , ice , ist ,& ! in : vegetation/soil - & smoiseqx ,& ! in - & sfctmp , sfcprs , psfc , uu , vv , q2 ,& ! in : forcing - & qc , swdn , lwdn ,& ! in : forcing - & pconv , pnonc , pshcv , psnow , pgrpl , phail ,& ! in : forcing - & tbot , co2pp , o2pp , foln , ficeold , zlvl ,& ! in : forcing - & alboldx , sneqvox ,& ! in/out : - & tsnsox , slsoil , smsoil , tahx , eahx , fwetx ,& ! in/out : - & canliqx , canicex , tvx , tgx , qsfc1d , qsnowx ,& ! in/out : - & isnowx , zsnsox , snowh , swe , snicex , snliqx ,& ! in/out : - & zwtx , wax , wtx , wslakex , lfmassx , rtmassx,& ! in/out : - & stmassx , woodx , stblcpx , fastcpx , xlaix ,xsaix ,& ! in/out : - & cmx , chx , taussx ,& ! in/out : - & smcwtdx ,deeprechx, rechx ,& ! in/out : - & z0wrf ,& ! out - & fsa , fsr , fira , fsh , ssoil , fcev ,& ! out : - & fgev , fctr , ecan , etran , edir , trad ,& ! out : - & tgb , tgv , t2mv , t2mb , q2v , q2b ,& ! out : - & runsrf , runsub , apar , psn , sav , sag ,& ! out : - & fsno , nee , gpp , npp , fveg , albedo ,& ! out : - & qsnbot , ponding , ponding1, ponding2, rssun , rssha ,& ! out : - & bgap , wgap , chv , chb , emissi ,& ! out : - & shg , shc , shb , evg , evb , ghv ,&! out : - & ghb , irg , irc , irb , tr , evc ,& ! out : - & chleaf , chuc , chv2 , chb2 , fpice , pahv ,& ! out -#ifdef CCPP - & pahg , pahb , pah , esnow, errmsg, errflg ) -#else - & pahg , pahb , pah , esnow ) -#endif - -#ifdef CCPP - if (errflg /= 0) return -#endif - - eta = fcev + fgev + fctr ! the flux w/m2 - - t2mmp(i) = t2mv*fveg+t2mb*(1-fveg) - q2mp(i) = q2v*fveg+q2b*(1-fveg) - - endif ! glacial split ends - -! -! mp in/out -! - snowxy (i) = float(isnowx) - tvxy (i) = tvx - tgxy (i) = tgx - canliqxy (i) = canliqx - canicexy (i) = canicex - eahxy (i) = eahx - tahxy (i) = tahx - - cmxy (i) = cmx - chxy (i) = chx - - fwetxy (i) = fwetx - sneqvoxy (i) = sneqvox - alboldxy (i) = alboldx - qsnowxy (i) = qsnowx - - wslakexy (i) = wslakex - zwtxy (i) = zwtx - waxy (i) = wax - wtxy (i) = wtx - - do k = -2,0 - tsnoxy (i,k) = tsnsox(k) - snicexy (i,k) = snicex (k) - snliqxy (i,k) = snliqx (k) - enddo - - do k = -2,4 - zsnsoxy (i,k) = zsnsox(k) - enddo - - lfmassxy (i) = lfmassx - rtmassxy (i) = rtmassx - stmassxy (i) = stmassx - woodxy (i) = woodx - stblcpxy (i) = stblcpx - fastcpxy (i) = fastcpx - - xlaixy (i) = xlaix - xsaixy (i) = xsaix - - taussxy (i) = taussx - - rechxy (i) = rechx - deeprechxy(i) = deeprechx - smcwtdxy(i) = smcwtdx - smoiseq(i,1:4) = smoiseqx(1:4) - -! -! generic in/outs -! - do k = 1, km - stc(i,k) = tsnsox(k) - smc(i,k) = smsoil(k) - slc(i,k) = slsoil(k) - enddo - - canopy(i) = canicex + canliqx - weasd(i) = swe - snwdph(i) = snowh * 1000.0 - -! write(*,*) 'swe,snowh,can' -! write (*,*) swe,snowh*1000.0,canopy(i) -! - smcmax = smcmax_table(stype) - smcref = smcref_table(stype) - smcwlt = smcdry_table(stype) -! -! outs -! - wet1(i) = smsoil(1) / smcmax - smcwlt2(i) = smcwlt - smcref2(i) = smcref - - runoff(i) = runsrf - drain(i) = runsub - - zorl(i) = z0wrf * 100.0 - - sncovr1(i) = fsno - snowc (i) = fsno - - sbsno(i) = esnow - gflux(i) = -1.0*ssoil - hflx(i) = fsh - evbs(i) = fgev - evcw(i) = fcev - trans(i) = fctr - evap(i) = eta - -! write(*,*) 'vtype, stype are',vtype,stype -! write(*,*) 'fsh,gflx,eta',fsh,ssoil,eta -! write(*,*) 'esnow,runsrf,runsub',esnow,runsrf,runsub -! write(*,*) 'evbs,evcw,trans',fgev,fcev,fctr -! write(*,*) 'snowc',fsno - - tsurf(i) = trad - - stm(i) = (0.1*smsoil(1)+0.3*smsoil(2)+0.6*smsoil(3)+ & - & 1.0*smsoil(4))*1000.0 ! unit conversion from m to kg m-2 -! - snohf (i) = qsnbot * con_hfus ! only part of it but is diagnostic -! write(*,*) 'snohf',snohf(i) - - fdown = fsa + lwdn - t2v = sfctmp * (1.0 + 0.61*q2) -! ssoil = -1.0 *ssoil - - call penman (sfctmp,sfcprs,chx,t2v,th2,prcp,fdown,ssoil, & - & q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno) - - ep(i) = etp - - endif ! end if_flag_iter_and_flag_block - enddo ! end do_i_loop - -! --- ... compute qsurf (specific humidity at sfc) - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - rch(i) = rho(i) * con_cp * ch(i) * wind(i) - qsurf(i) = q1(i) + evap(i) / (elocp * rch(i)) - endif - enddo - - do i = 1, im - if (flag_iter(i) .and. flag(i)) then - tem = 1.0 / rho(i) - hflx(i) = hflx(i) * tem * cpinv - evap(i) = evap(i) * tem * hvapi - endif - enddo - -! --- ... restore land-related prognostic fields for guess run - - do i = 1, im - if (flag(i)) then - if (flag_guess(i)) then - weasd(i) = weasd_old(i) - snwdph(i) = snwdph_old(i) - tskin(i) = tskin_old(i) - canopy(i) = canopy_old(i) - tprcp(i) = tprcp_old(i) - srflag(i) = srflag_old(i) - - - snowxy(i) = snow_old(i) - tvxy(i) = tv_old(i) - tgxy(i) = tg_old(i) - - canicexy(i) = canice_old(i) - canliqxy(i) = canliq_old(i) - eahxy(i) = eah_old(i) - tahxy(i) = tah_old(i) - fwetxy(i) = fwet_old(i) - sneqvoxy(i) = sneqvo_old(i) - alboldxy(i) = albold_old(i) - qsnowxy(i) = qsnow_old(i) - wslakexy(i) = wslake_old(i) - zwtxy(i) = zwt_old(i) - waxy(i) = wa_old(i) - wtxy(i) = wt_old(i) - lfmassxy(i) = lfmass_old(i) - rtmassxy(i) = rtmass_old(i) - stmassxy(i) = stmass_old(i) - woodxy(i) = wood_old(i) - stblcpxy(i) = stblcp_old(i) - fastcpxy(i) = fastcp_old(i) - xlaixy(i) = xlai_old(i) - xsaixy(i) = xsai_old(i) - taussxy(i) = tauss_old(i) - smcwtdxy(i) = smcwtd_old(i) - deeprechxy(i) = deeprech_old(i) - rechxy(i) = rech_old(i) - - do k = 1, km - smc(i,k) = smc_old(i,k) - stc(i,k) = stc_old(i,k) - slc(i,k) = slc_old(i,k) - enddo -! - do k = 1, km - smoiseq(i,k) = smoiseq_old(i,k) - enddo - - do k = -2,0 - tsnoxy(i,k) = tsno_old(i,k) - snicexy(i,k) = snice_old(i,k) - snliqxy(i,k) = snliq_old(i,k) - enddo - - do k = -2,4 - zsnsoxy(i,k) = zsnso_old(i,k) - enddo - else - tskin(i) = tsurf(i) - endif - endif - enddo -! - return -!................................... - end subroutine noahmpdrv_run -!> @} -!----------------------------------- - -!> \ingroup NoahMP_LSM -!! \brief This subroutine fills in a derived data type of type noahmp_parameters with data -!! from the module \ref noahmp_tables. - subroutine transfer_mp_parameters (vegtype,soiltype,slopetype, & - & soilcolor,parameters) - - use noahmp_tables - use module_sf_noahmplsm - - implicit none - - integer, intent(in) :: vegtype - integer, intent(in) :: soiltype - integer, intent(in) :: slopetype - integer, intent(in) :: soilcolor - - type (noahmp_parameters), intent(out) :: parameters - - real :: refdk - real :: refkdt - real :: frzk - real :: frzfact - - parameters%iswater = iswater_table - parameters%isbarren = isbarren_table - parameters%isice = isice_table - parameters%eblforest = eblforest_table - -!-----------------------------------------------------------------------& - parameters%urban_flag = .false. - if( vegtype == isurban_table .or. vegtype == 31 & - & .or.vegtype == 32 .or. vegtype == 33) then - parameters%urban_flag = .true. - endif - -!------------------------------------------------------------------------------------------! -! transfer veg parameters -!------------------------------------------------------------------------------------------! - - parameters%ch2op = ch2op_table(vegtype) !maximum intercepted h2o per unit lai+sai (mm) - parameters%dleaf = dleaf_table(vegtype) !characteristic leaf dimension (m) - parameters%z0mvt = z0mvt_table(vegtype) !momentum roughness length (m) - parameters%hvt = hvt_table(vegtype) !top of canopy (m) - parameters%hvb = hvb_table(vegtype) !bottom of canopy (m) - parameters%den = den_table(vegtype) !tree density (no. of trunks per m2) - parameters%rc = rc_table(vegtype) !tree crown radius (m) - parameters%mfsno = mfsno_table(vegtype) !snowmelt m parameter () - parameters%saim = saim_table(vegtype,:) !monthly stem area index, one-sided - parameters%laim = laim_table(vegtype,:) !monthly leaf area index, one-sided - parameters%sla = sla_table(vegtype) !single-side leaf area per kg [m2/kg] - parameters%dilefc = dilefc_table(vegtype) !coeficient for leaf stress death [1/s] - parameters%dilefw = dilefw_table(vegtype) !coeficient for leaf stress death [1/s] - parameters%fragr = fragr_table(vegtype) !fraction of growth respiration !original was 0.3 - parameters%ltovrc = ltovrc_table(vegtype) !leaf turnover [1/s] - - parameters%c3psn = c3psn_table(vegtype) !photosynthetic pathway: 0. = c4, 1. = c3 - parameters%kc25 = kc25_table(vegtype) !co2 michaelis-menten constant at 25c (pa) - parameters%akc = akc_table(vegtype) !q10 for kc25 - parameters%ko25 = ko25_table(vegtype) !o2 michaelis-menten constant at 25c (pa) - parameters%ako = ako_table(vegtype) !q10 for ko25 - parameters%vcmx25 = vcmx25_table(vegtype) !maximum rate of carboxylation at 25c (umol co2/m**2/s) - parameters%avcmx = avcmx_table(vegtype) !q10 for vcmx25 - parameters%bp = bp_table(vegtype) !minimum leaf conductance (umol/m**2/s) - parameters%mp = mp_table(vegtype) !slope of conductance-to-photosynthesis relationship - parameters%qe25 = qe25_table(vegtype) !quantum efficiency at 25c (umol co2 / umol photon) - parameters%aqe = aqe_table(vegtype) !q10 for qe25 - parameters%rmf25 = rmf25_table(vegtype) !leaf maintenance respiration at 25c (umol co2/m**2/s) - parameters%rms25 = rms25_table(vegtype) !stem maintenance respiration at 25c (umol co2/kg bio/s) - parameters%rmr25 = rmr25_table(vegtype) !root maintenance respiration at 25c (umol co2/kg bio/s) - parameters%arm = arm_table(vegtype) !q10 for maintenance respiration - parameters%folnmx = folnmx_table(vegtype) !foliage nitrogen concentration when f(n)=1 (%) - parameters%tmin = tmin_table(vegtype) !minimum temperature for photosynthesis (k) - - parameters%xl = xl_table(vegtype) !leaf/stem orientation index - parameters%rhol = rhol_table(vegtype,:) !leaf reflectance: 1=vis, 2=nir - parameters%rhos = rhos_table(vegtype,:) !stem reflectance: 1=vis, 2=nir - parameters%taul = taul_table(vegtype,:) !leaf transmittance: 1=vis, 2=nir - parameters%taus = taus_table(vegtype,:) !stem transmittance: 1=vis, 2=nir - - parameters%mrp = mrp_table(vegtype) !microbial respiration parameter (umol co2 /kg c/ s) - parameters%cwpvt = cwpvt_table(vegtype) !empirical canopy wind parameter - - parameters%wrrat = wrrat_table(vegtype) !wood to non-wood ratio - parameters%wdpool = wdpool_table(vegtype) !wood pool (switch 1 or 0) depending on woody or not [-] - parameters%tdlef = tdlef_table(vegtype) !characteristic t for leaf freezing [k] - - parameters%nroot = nroot_table(vegtype) !number of soil layers with root present - parameters%rgl = rgl_table(vegtype) !parameter used in radiation stress function - parameters%rsmin = rs_table(vegtype) !minimum stomatal resistance [s m-1] - parameters%hs = hs_table(vegtype) !parameter used in vapor pressure deficit function - parameters%topt = topt_table(vegtype) !optimum transpiration air temperature [k] - parameters%rsmax = rsmax_table(vegtype) !maximal stomatal resistance [s m-1] - -!------------------------------------------------------------------------------------------! -! transfer rad parameters -!------------------------------------------------------------------------------------------! - - parameters%albsat = albsat_table(soilcolor,:) - parameters%albdry = albdry_table(soilcolor,:) - parameters%albice = albice_table - parameters%alblak = alblak_table - parameters%omegas = omegas_table - parameters%betads = betads_table - parameters%betais = betais_table - parameters%eg = eg_table - -!------------------------------------------------------------------------------------------! -! transfer global parameters -!------------------------------------------------------------------------------------------! - - parameters%co2 = co2_table - parameters%o2 = o2_table - parameters%timean = timean_table - parameters%fsatmx = fsatmx_table - parameters%z0sno = z0sno_table - parameters%ssi = ssi_table - parameters%swemx = swemx_table - -! ---------------------------------------------------------------------- -! transfer soil parameters -! ---------------------------------------------------------------------- - - parameters%bexp = bexp_table (soiltype) - parameters%dksat = dksat_table (soiltype) - parameters%dwsat = dwsat_table (soiltype) - parameters%f1 = f1_table (soiltype) - parameters%psisat = psisat_table (soiltype) - parameters%quartz = quartz_table (soiltype) - parameters%smcdry = smcdry_table (soiltype) - parameters%smcmax = smcmax_table (soiltype) - parameters%smcref = smcref_table (soiltype) - parameters%smcwlt = smcwlt_table (soiltype) - -! ---------------------------------------------------------------------- -! transfer genparm parameters -! ---------------------------------------------------------------------- - parameters%csoil = csoil_table - parameters%zbot = zbot_table - parameters%czil = czil_table - - frzk = frzk_table - refdk = refdk_table - refkdt = refkdt_table - parameters%kdt = refkdt * parameters%dksat / refdk - parameters%slope = slope_table(slopetype) - - if(parameters%urban_flag)then ! hardcoding some urban parameters for soil - parameters%smcmax = 0.45 - parameters%smcref = 0.42 - parameters%smcwlt = 0.40 - parameters%smcdry = 0.40 - parameters%csoil = 3.e6 - endif - - ! adjust frzk parameter to actual soil type: frzk * frzfact - -!-----------------------------------------------------------------------& - if(soiltype /= 14) then - frzfact = (parameters%smcmax / parameters%smcref) & - & * (0.412 / 0.468) - parameters%frzx = frzk * frzfact - end if - - end subroutine transfer_mp_parameters - -!-----------------------------------------------------------------------& - -!> \ingroup NoahMP_LSM -!! brief Calculate potential evaporation for the current point. Various -!! partial sums/products are also calculated and passed back to the -!! calling routine for later use. - subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & - & q2,q2sat,etp,snowng,frzgra,ffrozp, & - & dqsdt2,emissi_in,sncovr) - -! etp is calcuated right after ssoil - -! ---------------------------------------------------------------------- -! subroutine penman -! ---------------------------------------------------------------------- - implicit none - logical, intent(in) :: snowng, frzgra - real, intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, & - & q2, q2sat,ssoil, sfcprs, sfctmp, & - & t2v, th2,emissi_in,sncovr - real, intent(out) :: etp - real :: epsca,flx2,rch,rr,t24 - real :: a, delta, fnet,rad,rho,emissi,elcp1,lvs - - real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6 - real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3 - real, parameter :: cpice = 2.106e+3, lsubf = 3.335e5 - real, parameter :: sigma = 5.6704e-8 - -! ---------------------------------------------------------------------- -! executable code begins here: -! ---------------------------------------------------------------------- -! ---------------------------------------------------------------------- -! prepare partial quantities for penman equation. -! ---------------------------------------------------------------------- - emissi=emissi_in -! elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc - lvs = (1.0-sncovr)*lsubc + sncovr*lsubs - - flx2 = 0.0 - delta = elcp * dqsdt2 -! delta = elcp1 * dqsdt2 - t24 = sfctmp * sfctmp * sfctmp * sfctmp - rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0 -! rr = emissi*t24 * 6.48e-8 / (sfcprs * ch) + 1.0 - rho = sfcprs / (rd * t2v) - -! ---------------------------------------------------------------------- -! adjust the partial sums / products with the latent heat -! effects caused by falling precipitation. -! ---------------------------------------------------------------------- - rch = rho * cp * ch - if (.not. snowng) then - if (prcp > 0.0) rr = rr + cph2o * prcp / rch - else -! ---- ... fractional snowfall/rainfall - rr = rr + (cpice*ffrozp+cph2o*(1.-ffrozp)) & - & *prcp/rch - end if - -! ---------------------------------------------------------------------- -! include the latent heat effects of frzng rain converting to ice on -! impact in the calculation of flx2 and fnet. -! ---------------------------------------------------------------------- -! fnet = fdown - sigma * t24- ssoil - fnet = fdown - emissi*sigma * t24- ssoil - if (frzgra) then - flx2 = - lsubf * prcp - fnet = fnet - flx2 -! ---------------------------------------------------------------------- -! finish penman equation calculations. -! ---------------------------------------------------------------------- - end if - rad = fnet / rch + th2- sfctmp - a = elcp * (q2sat - q2) -! a = elcp1 * (q2sat - q2) - epsca = (a * rr + rad * delta) / (delta + rr) - etp = epsca * rch / lsubc -! etp = epsca * rch / lvs - -! ---------------------------------------------------------------------- - end subroutine penman - - end module noahmpdrv diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 32fc2f15a..ff90fa3eb 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -171,18 +171,9 @@ kind = kind_phys intent= in optional = F -[sfcemis] - standard_name = surface_longwave_emissivity_over_land_interstitial - long_name = surface lw emissivity in fraction over land (temporary use as interstitial) - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [dlwflx] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_land - long_name = total sky surface downward longwave flux absorbed by the ground over land + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time units = W m-2 dimensions = (horizontal_loop_extent) type = real @@ -1018,6 +1009,51 @@ kind = kind_phys intent = inout optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [sncovr1] standard_name = surface_snow_area_fraction_over_land long_name = surface snow area fraction diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 1a1a8eefa..a84e9aef9 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -801,6 +801,17 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & abssmx = 1.0 abssmn = .01 abslmn = .01 + elseif (ialb ==2) then + kpdabs = kpdabs_1 + kpdalb = kpdalb_1 + alblmx = .99 + albsmx = .99 + alblmn = .01 + albsmn = .01 + abslmx = 1.0 + abssmx = 1.0 + abssmn = .01 + abslmn = .01 else kpdabs = kpdabs_0 kpdalb = kpdalb_0 @@ -876,6 +887,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo ! calbl = 0. !... albedo over land + if (ialb == 2) falbl=99999. if (falbl >= 99999.) calbl = 1. if (falbl > 0. .and. falbl < 99999) calbl = exp(-deltf/falbl) ! @@ -7212,7 +7224,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & cjfe kpd7=-1 - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then !cbosu still need facsf and facwf. read them from the production file if ( index(fnalbc2, "tileX.nc") == 0) then ! grib file call fixrdc(lugb,fnalbc2,kpdalf(1),kpd7,kpd9,slmask @@ -7401,7 +7413,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & if (nn .eq. 2) mon = mon2 !cbosu !cbosu new snowfree albedo database is monthly. - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then if ( index(fnalbc, "tileX.nc") == 0) then ! grib file kpd7=-1 do k = 1, 4 @@ -7685,7 +7697,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & mon = mon2 nn = k2 !cbosu - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then if (me == 0) print*,'bosu 2nd time in clima for month ', & mon, k1,k2 if ( index(fnalbc, "tileX.nc") == 0) then ! grib file @@ -7995,7 +8007,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil, & if (me == 0) print*,'monthly albedo weights are ', & wei1m,' for k', k1, wei2m, ' for k', k2 - if (ialb == 1) then + if (ialb == 1 .or. ialb == 2) then do k=1,4 do i=1,len albclm(i,k) = wei1m * alb(i,k,k1) + wei2m * alb(i,k,k2) From fd4ae2834b7e41b8919501ceaa932212d5f1e4f9 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 21 Feb 2021 06:07:11 -0700 Subject: [PATCH 219/274] Replace integer dimensions for four Noah MP arrays with variable standard names in physics/GFS_phys_time_vary.fv3.meta and physics/sfc_noahmp_drv.meta --- physics/GFS_phys_time_vary.fv3.meta | 8 ++++---- physics/sfc_noahmp_drv.meta | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index 62cd5e491..06192eb6a 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -813,7 +813,7 @@ standard_name = snow_layer_ice long_name = snow layer ice units = mm - dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -822,7 +822,7 @@ standard_name = snow_layer_liquid_water long_name = snow layer liquid water units = mm - dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -831,7 +831,7 @@ standard_name = snow_temperature long_name = snow_temperature units = K - dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:0) + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -849,7 +849,7 @@ standard_name = layer_bottom_depth_from_snow_surface long_name = depth from the top of the snow surface at the bottom of the layer units = m - dimensions = (horizontal_dimension, lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index ff90fa3eb..c0a6393fa 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -860,7 +860,7 @@ standard_name = snow_temperature long_name = snow_temperature units = K - dimensions = (horizontal_loop_extent, -2:0) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -869,7 +869,7 @@ standard_name = layer_bottom_depth_from_snow_surface long_name = depth from the top of the snow surface at the bottom of the layer units = m - dimensions = (horizontal_loop_extent, -2:4) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -878,7 +878,7 @@ standard_name = snow_layer_ice long_name = snow_layer_ice units = mm - dimensions = (horizontal_loop_extent, -2:0) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout @@ -887,7 +887,7 @@ standard_name = snow_layer_liquid_water long_name = snow layer liquid water units = mm - dimensions = (horizontal_loop_extent, -2:0) + dimensions = (horizontal_loop_extent,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) type = real kind = kind_phys intent = inout From be017d02cc0fc17f9c0a302693076149c9f21c8c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 22 Feb 2021 10:28:20 -0700 Subject: [PATCH 220/274] Revert change to CODEOWNERS --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 0d5230f89..b6c597371 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl @JulieSchramm +* @DomHeinzeller # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From 865d085b34c7f749a1ce0cebe281c15d2caa9bf0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 22 Feb 2021 16:42:44 -0700 Subject: [PATCH 221/274] Bugfix for uninitialized data in physics/radiation_surface.f, fix formatting in physics/rrtmg_sw_pre.F90 --- physics/radiation_surface.f | 3 +++ physics/rrtmg_sw_pre.F90 | 9 ++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 63bc4f907..11b9741c5 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -707,6 +707,9 @@ subroutine setalb & asnvb = asnvd asnnb = asnnd endif + else + asnvb = asnvd + asnnb = asnnd endif !> - Calculate direct sea surface albedo, use fanglin's zenith angle diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 89dc9acfe..b281d42a7 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,11 +12,10 @@ end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table !! \htmlinclude rrtmg_sw_pre_run.html !! - subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & - alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf,& - alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & - sfalb, nday, idxday, sfcalb1, & - sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) + subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & + alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf, & + alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & + sfalb, nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) use machine, only: kind_phys From 5f7968b2628b8ab8838d9e9d7cdb4a498f95f009 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 23 Feb 2021 01:51:19 +0000 Subject: [PATCH 222/274] 1. Fixed units inconsistency for water friendly aerosols in the computation of number concentration of liquid water. 2. Replaced dry-air density with the moist-air density for consistency with Thompson MP. --- physics/GFS_rrtmg_pre.F90 | 10 ++++++---- physics/GFS_suite_interstitial.F90 | 10 +++++----- physics/mp_thompson.F90 | 13 +++++++------ 3 files changed, 18 insertions(+), 15 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 109df3b65..ab488c687 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -288,8 +288,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & plyr(i,k1) = prsl(i,k2) * 0.01 ! pa to mb (hpa) tlyr(i,k1) = tgrs(i,k2) prslk1(i,k1) = prslk(i,k2) - rho(i,k1) = plyr(i,k1)/(con_rd*tlyr(i,k1)) - orho(i,k1) = 1.0/rho(i,k1) !> - Compute relative humidity. es = min( prsl(i,k2), fpvs( tgrs(i,k2) ) ) ! fpvs and prsl in pa @@ -636,6 +634,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do i=1,IM qvs = qgrs(i,k,ntqv) qv_mp (i,k) = qvs/(1.-qvs) + rho (i,k) = 0.622*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+0.622)) + orho (i,k) = 1.0/rho(i,k) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs) @@ -649,6 +649,8 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do i=1,IM qvs = qgrs(i,k,ntqv) qv_mp (i,k) = qvs/(1.-qvs) + rho (i,k) = 0.622*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+0.622)) + orho (i,k) = 1.0/rho(i,k) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) qs_mp (i,k) = tracer1(i,k,ntsw)/(1.-qvs) @@ -761,7 +763,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do k=1,lm do i=1,im if (ltaerosol .and. qc_mp(i,k)>1.e-12 .and. nc_mp(i,k)<100.) then - nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)) * orho(i,k) + nc_mp(i,k) = make_DropletNumber(qc_mp(i,k)*rho(i,k), nwfa(i,k)*rho(i,k)) * orho(i,k) endif if (qi_mp(i,k)>1.e-12 .and. ni_mp(i,k)<100.) then ni_mp(i,k) = make_IceNumber(qi_mp(i,k)*rho(i,k), tlyr(i,k)) * orho(i,k) @@ -774,7 +776,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & !tgs: progclduni has different limits for ice radii (10.0-150.0) than ! calc_effectRad (4.99-125.0 for WRFv3.8.1; 2.49-125.0 for WRFv4+) ! it will raise the low limit from 5 to 10, but the high limit will remain 125. - call calc_effectRad (tlyr(i,:), plyr(i,:), qv_mp(i,:), qc_mp(i,:), & + call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), & nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm ) end do diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 551f0e600..f9a26bb57 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -717,7 +717,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! local variables integer :: i,k,n,tracers - real(kind=kind_phys), dimension(im,levs) :: rho_dryair + real(kind=kind_phys), dimension(im,levs) :: rho_air real(kind=kind_phys), dimension(im,levs) :: qv_mp !< kg kg-1 (dry mixing ratio) real(kind=kind_phys), dimension(im,levs) :: qc_mp !< kg kg-1 (dry mixing ratio) real(kind=kind_phys), dimension(im,levs) :: qi_mp !< kg kg-1 (dry mixing ratio) @@ -767,16 +767,16 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to if (imp_physics == imp_physics_thompson .and. (ntlnc>0 .or. ntinc>0)) then do k=1,levs do i=1,im - !> - Density of air in kg m-3 - rho_dryair(i,k) = prsl(i,k) / (con_rd*save_tcp(i,k)) !> - Convert specific humidity to dry mixing ratio qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k)) + !> - Density of air in kg m-3 + rho_air(i,k) = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+0.622)) if (ntlnc>0) then !> - Convert moist mixing ratio to dry mixing ratio qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k)) !> - Convert number concentration from moist to dry nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k)) - nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho_dryair(i,k), nwfa(i,k)) * (one/rho_dryair(i,k))) + nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho_air(i,k), nwfa(i,k)*rho_air(i,k)) * (one/rho_air(i,k))) !> - Convert number concentrations from dry to moist gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k)) endif @@ -785,7 +785,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k)) !> - Convert number concentration from moist to dry ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) - ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho_dryair(i,k), save_tcp(i,k)) * (one/rho_dryair(i,k))) + ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho_air(i,k), save_tcp(i,k)) * (one/rho_air(i,k))) !> - Convert number concentrations from dry to moist gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k)) endif diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index ec19945b0..82ddc95be 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -159,10 +159,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! Geopotential height in m2 s-2 to height in m hgt = phil/con_g - ! Density of air in kg m-3 and inverse density of air - rho = prsl/(con_rd*tgrs) - orho = 1.0/rho - ! Prior to calling the functions: make_DropletNumber, make_IceNumber, make_RainNumber, ! the incoming mixing ratios should be converted to units of mass/num per cubic meter ! rather than per kg of air. So, to pass back to the model state variables, @@ -178,6 +174,10 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & qs_mp = qs/(1.0_kind_phys-spechum) qg_mp = qg/(1.0_kind_phys-spechum) + ! Density of air in kg m-3 and inverse density of air + rho = 0.622*prsl/(con_rd*tgrs*(qv_mp+0.622)) + orho = 1.0/rho + !> - Convert number concentrations from moist to dry ni_mp = ni/(1.0_kind_phys-spechum) nr_mp = nr/(1.0_kind_phys-spechum) @@ -304,7 +304,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! If qc is in boundary conditions but nc is not, calculate nc from qc, rho and nwfa if (maxval(qc_mp)>0.0 .and. maxval(nc_mp)==0.0) then - nc_mp = make_DropletNumber(qc_mp*rho, nwfa) * orho + nc_mp = make_DropletNumber(qc_mp*rho, nwfa*rho) * orho end if ! If nc is in boundary conditions but qc is not, reset nc to zero @@ -428,6 +428,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & ! Air density real(kind_phys) :: rho(1:ncol,1:nlev) !< kg m-3 + !rho = 0.622*prsl/(con_rd*tgrs*(qv_mp+0.622)) ! Hydrometeors real(kind_phys) :: qv_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) real(kind_phys) :: qc_mp(1:ncol,1:nlev) !< kg kg-1 (dry mixing ratio) @@ -510,7 +511,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & end if !> - Density of air in kg m-3 - rho = prsl/(con_rd*tgrs) + rho = 0.622*prsl/(con_rd*tgrs*(qv_mp+0.622)) !> - Convert omega in Pa s-1 to vertical velocity w in m s-1 w = -omega/(rho*con_g) From 9cd399d66063956ae51c52b89e0ae14972fd9040 Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Tue, 23 Feb 2021 17:40:22 +0000 Subject: [PATCH 223/274] Replace dry-air density to moist-air density in RRTMGP. Fix gthe units of water-friendly aerosols in the call to make_DropletNumber. --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index ea27f3d2b..de1fa3547 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -147,11 +147,11 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do ! Cloud particle sizes and number concentrations... ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re - rho = p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)) - orho = 1./rho do iLay = 1, nLev do iCol = 1, nCol qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) + rho(iCol,iLay) = 0.622*p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)*(qv_mp(iCol,iLay)+0.622)) + orho(iCol,iLay) = 1./rho(iCol,iLay) qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) @@ -169,7 +169,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do do iLay = 1, nLev do iCol = 1, nCol if (ltaerosol .and. qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then - nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho(iCol,iLay), nwfa(iCol,iLay)) * orho(iCol,iLay) + nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho(iCol,iLay), nwfa(iCol,iLay)*rho(iCol,iLay)) * orho(iCol,iLay) endif if (qi_mp(iCol,iLay) > 1.e-12 .and. ni_mp(iCol,iLay) < 100.) then ni_mp(iCol,iLay) = make_IceNumber(qi_mp(iCol,iLay)*rho(iCol,iLay), t_lay(iCol,iLay)) * orho(iCol,iLay) From cea4252f129058e8ea15f2d789d71e8de1def1a4 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 23 Feb 2021 18:29:42 +0000 Subject: [PATCH 224/274] Changes from code review. --- physics/GFS_rrtmgp_sw_post.F90 | 2 +- physics/GFS_rrtmgp_sw_pre.F90 | 2 +- physics/rrtmgp_lw_cloud_optics.F90 | 7 ------- physics/rrtmgp_lw_gas_optics.F90 | 3 --- physics/rrtmgp_lw_rte.F90 | 2 +- physics/rrtmgp_sw_cloud_optics.F90 | 9 --------- physics/rrtmgp_sw_gas_optics.F90 | 3 --- 7 files changed, 3 insertions(+), 25 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 14dfb798a..1f195b397 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -27,7 +27,7 @@ end subroutine GFS_rrtmgp_sw_post_init !! subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky_hr, & save_diag, fhswr, coszen, coszdg, t_lay, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, fluxswUP_allsky, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, fluxswUP_allsky, & fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & mtopa, cld_frac, cldtausw, fluxr, & nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 13b2e3a00..538d30417 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -30,7 +30,7 @@ end subroutine GFS_rrtmgp_sw_pre_init subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, & - sfc_wts, p_lay, tv_lay, relhum, p_lev, nday, idxday, coszen, coszdg, & + sfc_wts, p_lay, tv_lay, relhum, p_lev, nday, idxday, coszen, coszdg, & sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, & errmsg, errflg) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 42c14ee94..a59fe42a9 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -210,7 +210,6 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, & ! ! ####################################################################################### #ifdef MPI - call mpi_barrier(mpicomm, mpierr) if (mpirank .eq. mpiroot) then #endif ! Read in fields from file @@ -359,27 +358,21 @@ subroutine rrtmgp_lw_cloud_optics_init(doG_cldoptics, & ! ! ####################################################################################### if (doGP_cldoptics_LUT) then -!$omp critical (load_lw_cloud_props_LUTs) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_limsCLDLW, & radliq_lwrLW, radliq_uprLW, radliq_facLW, radice_lwrLW, radice_uprLW, & radice_facLW, lut_extliqLW, lut_ssaliqLW, lut_asyliqLW, lut_exticeLW, & lut_ssaiceLW, lut_asyiceLW)) -!$omp end critical (load_lw_cloud_props_LUTs) endif if (doGP_cldoptics_PADE) then -!$omp critical (load_lw_cloud_props_PADE_approx) call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_limsCLDLW, & pade_extliqLW, pade_ssaliqLW, pade_asyliqLW, pade_exticeLW, pade_ssaiceLW, & pade_asyiceLW, pade_sizereg_extliqLW, pade_sizereg_ssaliqLW, & pade_sizereg_asyliqLW, pade_sizereg_exticeLW, pade_sizereg_ssaiceLW, & pade_sizereg_asyiceLW)) -!$omp endcritical (load_lw_cloud_props_PADE_approx) endif -!$omp critical (load_lw_cloud_props_nrghice) call check_error_msg('lw_cloud_optics_init',lw_cloud_props%set_ice_roughness(nrghice)) -!$omp end critical (load_lw_cloud_props_nrghice) end subroutine rrtmgp_lw_cloud_optics_init diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 536adaaef..7f746b8f3 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -260,7 +260,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, ! ! ####################################################################################### #ifdef MPI - call mpi_barrier(mpicomm, mpierr) if (mpirank .eq. mpiroot) then #endif write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' @@ -441,7 +440,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, ! Initialize RRTMGP DDT's... ! ! ####################################################################################### -!$omp critical (load_lw_gas_optics) gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('rrtmgp_lw_gas_optics_init',lw_gas_props%load(gas_concentrations, & gas_namesLW, key_speciesLW, band2gptLW, band_limsLW, press_refLW, press_ref_tropLW,& @@ -452,7 +450,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, scaling_gas_lowerLW, scaling_gas_upperLW, scale_by_complement_lowerLW, & scale_by_complement_upperLW, kminor_start_lowerLW, kminor_start_upperLW, totplnkLW,& planck_fracLW, rayl_lowerLW, rayl_upperLW, optimal_angle_fitLW)) -!$omp end critical (load_lw_gas_optics) ! The minimum pressure allowed in GP RTE calculations. Used to bound uppermost layer ! temperature (GFS_rrtmgp_pre.F90) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index b654a0657..a9e6d1839 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -29,7 +29,7 @@ end subroutine rrtmgp_lw_rte_init !! \htmlinclude rrtmgp_lw_rte_run.html !! subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & - nLev, p_lev, sfc_emiss_byband, sources, lw_optical_props_clrsky, & + nLev, p_lev, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, sfculw_jac, errmsg, errflg) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 1b0500650..44b5e0510 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -207,7 +207,6 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! ! ####################################################################################### #ifdef MPI - call mpi_barrier(mpicomm, mpierr) if (mpirank .eq. mpiroot) then #endif if (doGP_cldoptics_LUT) then @@ -356,30 +355,23 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, ! ! ####################################################################################### if (doGP_cldoptics_LUT) then -!$omp critical (load_sw_cloud_props_LUTs) call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_limsCLDSW, & radliq_lwrSW, radliq_uprSW, radliq_facSW, radice_lwrSW, radice_uprSW, & radice_facSW, lut_extliqSW, lut_ssaliqSW, lut_asyliqSW, lut_exticeSW, & lut_ssaiceSW, lut_asyiceSW)) -!$omp end critical (load_sw_cloud_props_LUTs) endif if (doGP_cldoptics_PADE) then -!$omp critical (load_sw_cloud_props_PADE_approx) call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_limsCLDSW, & pade_extliqSW, pade_ssaliqSW, pade_asyliqSW, pade_exticeSW, pade_ssaiceSW, & pade_asyiceSW, pade_sizereg_extliqSW, pade_sizereg_ssaliqSW, & pade_sizereg_asyliqSW, pade_sizereg_exticeSW, pade_sizereg_ssaiceSW, & pade_sizereg_asyiceSW)) -!$omp end critical (load_sw_cloud_props_PADE_approx) endif -!$omp critical (load_sw_cloud_props_nrghice) call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice_fromfileSW)) -!$omp end critical (load_sw_cloud_props_nrghice) ! Initialize coefficients for rain and snow(+groupel) cloud optics -!$omp critical (load_sw_precip_props) allocate(b0r(sw_cloud_props%get_nband()),b0s(sw_cloud_props%get_nband()), & b1s(sw_cloud_props%get_nband()),c0r(sw_cloud_props%get_nband()), & c0s(sw_cloud_props%get_nband())) @@ -393,7 +385,6 @@ subroutine rrtmgp_sw_cloud_optics_init(doG_cldoptics, doGP_cldoptics_PADE, 0.944, 0.894, 0.884, 0.883, 0.883, 0.883, 0.883/) c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & 0.970, 0.970, 0.970, 0.700, 0.700, 0.700, 0.700/) -!$omp end critical (load_sw_precip_props) end subroutine rrtmgp_sw_cloud_optics_init diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 2d8afdc14..30452869d 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -265,7 +265,6 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! ! ####################################################################################### #ifdef MPI - call mpi_barrier(mpicomm, mpierr) if (mpirank .eq. mpiroot) then #endif write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' @@ -455,7 +454,6 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, ! Initialize RRTMGP DDT's... ! ! ####################################################################################### -!$omp critical (load_sw_gas_optics) gas_concentrations%gas_name(:) = active_gases_array(:) call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, & gas_namesSW, key_speciesSW, band2gptSW, band_limsSW, press_refSW, press_ref_tropSW,& @@ -467,7 +465,6 @@ subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, scale_by_complement_upperSW, kminor_start_lowerSW, kminor_start_upperSW, & solar_quietSW, solar_facularSW, solar_sunspotSW, tsi_defaultSW, mg_defaultSW, & sb_defaultSW, rayl_lowerSW, rayl_upperSW)) -!$omp end critical (load_sw_gas_optics) end subroutine rrtmgp_sw_gas_optics_init From 2a39342614d0892273bc7ac829825f17bfb02f36 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 23 Feb 2021 18:33:47 +0000 Subject: [PATCH 225/274] Fixed whitespace. --- physics/rrtmgp_sw_cloud_sampling.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index b969c50a9..40a6bf6e0 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -45,7 +45,7 @@ end subroutine rrtmgp_sw_cloud_sampling_init subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, iovr, & iovr_max, iovr_maxrand, iovr_rand, iovr_dcorr, iovr_exp, iovr_exprand, isubc_sw, & icseed_sw, cld_frac, precip_frac, cloud_overlap_param, precip_overlap_param, & - sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & + sw_optical_props_cloudsByBand, sw_optical_props_precipByBand, & sw_optical_props_clouds, sw_optical_props_precip, errmsg, errflg) ! Inputs From f21573135c977807cd9e4060ec675b757348bc92 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 23 Feb 2021 22:39:25 +0000 Subject: [PATCH 226/274] Remove mpi_bcast for unallocated fields. --- physics/rrtmgp_lw_gas_optics.F90 | 4 ---- 1 file changed, 4 deletions(-) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 7f746b8f3..ac3a8d7f0 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -388,10 +388,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, size(kminor_lowerLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(kminor_upperLW, & size(kminor_upperLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(rayl_lowerLW, & - size(rayl_lowerLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) - call mpi_bcast(rayl_upperLW, & - size(rayl_upperLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(kmajorLW, & size(kmajorLW), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, mpierr) call mpi_bcast(planck_fracLW, & From cae708d26b4a4fe3fc06c0191fbe72fb8af0674c Mon Sep 17 00:00:00 2001 From: Greg Thompson Date: Wed, 24 Feb 2021 11:27:23 -0700 Subject: [PATCH 227/274] fix for one more consistency check of ice number --- physics/module_mp_thompson.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 444e867ae..2e6331c33 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -2888,8 +2888,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & niten(k) = -ni1d(k)*odts endif xni=MAX(0.,(ni1d(k) + niten(k)*dtsave)*rho(k)) - if (xni.gt.499.E3) & - niten(k) = (499.E3-ni1d(k)*rho(k))*odts*orho + if (xni.gt.9999.E3) & + niten(k) = (9999.E3-ni1d(k)*rho(k))*odts*orho !> - Rain tendency qrten(k) = qrten(k) + (prr_wau(k) + prr_rcw(k) & From f6d5fc1352c0a93fa9876cab200e5b3af05b4ac1 Mon Sep 17 00:00:00 2001 From: Greg Thompson Date: Thu, 25 Feb 2021 09:09:29 -0700 Subject: [PATCH 228/274] small compile-time bug fixes --- physics/module_mp_thompson.F90 | 7 +++---- physics/mp_thompson.F90 | 22 +++++++++++----------- 2 files changed, 14 insertions(+), 15 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 2e6331c33..ed8309789 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1264,7 +1264,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nwfa1d(k) = 11.1E6/rho(k) nifa1d(k) = naIN1*0.01/rho(k) enddo - nwfa1 = 11.1E6 endif !> - Call mp_thompson() @@ -3717,7 +3716,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & elseif (nc1d(k)*rho(k).lt.100.) then nu_c = 15 else - nu_c = NINT(1000.E6/(nc1d(k)*rho(k)) + 2 + nu_c = NINT(1000.E6/(nc1d(k)*rho(k))) + 2 nu_c = MAX(2, MIN(nu_c+NINT(rand2), 15)) endif lamc = (am_r*ccg(2,nu_c)*ocg1(nu_c)*nc1d(k)/qc1d(k))**obmr @@ -3941,7 +3940,7 @@ subroutine qr_acr_qg CLOSE(63) RETURN ! ----- RETURN 9234 CONTINUE - write(0,*) "Error writing //qr_acr_qg_file + write(0,*) "Error writing "//qr_acr_qg_file return ENDIF ENDIF @@ -4237,7 +4236,7 @@ subroutine freezeH2O(threads) write_thompson_tables = .false. good = 0 - INQUIRE(FILE=freeze_h2o_file",EXIST=lexist) + INQUIRE(FILE=freeze_h2o_file,EXIST=lexist) #ifdef MPI call MPI_BARRIER(mpi_communicator,ierr) #endif diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index ac8437262..79994674f 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -142,14 +142,14 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & qv = spechum/(1.0_kind_phys-spechum) ! Ensure we have 1st guess ice number where mass non-zero but no number. - where(qi <= 0.0) ni=0.0 - where(qi > 0 .and. ni <= 0.0) ni = make_IceNumber(qi*rho, tgrs) * orho - where(qi = 0.0 .and. ni > 0.0) ni=0.0 + where(qi .LE. 0.0) ni=0.0 + where(qi .GT. 0 .and. ni .LE. 0.0) ni = make_IceNumber(qi*rho, tgrs) * orho + where(qi .EQ. 0.0 .and. ni .GT. 0.0) ni=0.0 ! Ensure we have 1st guess rain number where mass non-zero but no number. - where(qr <= 0.0) nr=0.0 - where(qr > 0 .and. nr <= 0.0) nr = make_RainNumber(qr*rho, tgrs) * orho - where(qr = 0.0 .and. nr > 0.0) nr=0.0 + where(qr .LE. 0.0) nr=0.0 + where(qr .GT. 0 .and. nr .LE. 0.0) nr = make_RainNumber(qr*rho, tgrs) * orho + where(qr .EQ. 0.0 .and. nr .GT. 0.0) nr=0.0 !..Check for existing aerosol data, both CCN and IN aerosols. If missing @@ -227,13 +227,13 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & endif ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number. - where(qc <= 0.0) nc=0.0 - where(qc > 0 .and. nc <= 0.0) nc = make_DropletNumber(qc*rho, nwfa*rho) * orho - where(qc = 0.0 .and. nc > 0.0) nc=0.0 + where(qc .LE. 0.0) nc=0.0 + where(qc .GT. 0 .and. nc .LE. 0.0) nc = make_DropletNumber(qc*rho, nwfa*rho) * orho + where(qc .EQ. 0.0 .and. nc .GT. 0.0) nc=0.0 ! Ensure non-negative aerosol number concentrations. - where(nwfa <= 0.0) nwfa = 1.1E6 - where(nifa <= 0.0) nifa = naIN1*0.01 + where(nwfa .LE. 0.0) nwfa = 1.1E6 + where(nifa .LE. 0.0) nifa = naIN1*0.01 else From 4f16a3e54ffa10eaff1852a9908dc6270b03f9a0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 25 Feb 2021 11:23:46 -0700 Subject: [PATCH 229/274] Fix merge conflicts in RRTMGP code --- physics/GFS_rrtmgp_sw_pre.F90 | 2 +- physics/rrtmgp_lw_pre.F90 | 4 +--- physics/rrtmgp_lw_pre.meta | 8 -------- 3 files changed, 2 insertions(+), 12 deletions(-) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 154c7ee8a..457080536 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -31,7 +31,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_ lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, & albdnir, albivis, albinir, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & - sw_gas_props, nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & + nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) ! Inputs diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 644917d8d..f4ee288f7 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -26,7 +26,7 @@ end subroutine rrtmgp_lw_pre_init !! \htmlinclude rrtmgp_lw_pre_run.html !! subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & - tsfg, tsfa, hprime, lw_gas_props, sfc_emiss_byband, emiss, semis, errmsg, errflg) + tsfg, tsfa, hprime, sfc_emiss_byband, emiss, semis, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -45,8 +45,6 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc hprime ! Standard deviation of subgrid orography real(kind_phys), dimension(:), intent(in) :: & emiss ! Surface emissivity from Noah MP - type(ty_gas_optics_rrtmgp),intent(in) :: & - lw_gas_props ! RRTMGP DDT: spectral information for LW calculation ! Outputs real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index dd4791a2b..5446580df 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -104,14 +104,6 @@ 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 - units = DDT - dimensions = () - type = ty_gas_optics_rrtmgp - intent = in - optional = F [emiss] standard_name = surface_emissivity_lsm long_name = surface emissivity from lsm From f2d2b123a60830ee257801c76b33d79b1f74076b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 25 Feb 2021 11:24:16 -0700 Subject: [PATCH 230/274] Append _kind_phys to all reals that are used in the Noah MP initialization --- physics/GFS_phys_time_vary.fv3.F90 | 160 ++++++++++++++--------------- 1 file changed, 80 insertions(+), 80 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 052c6ef63..94fc5e36b 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -424,39 +424,39 @@ subroutine GFS_phys_time_vary_init ( tgxy(ix) = tsfcl(ix) tahxy(ix) = tsfcl(ix) - if (snowd(ix) > 0.01 .and. tsfcl(ix) > con_t0c ) tvxy(ix) = con_t0c - if (snowd(ix) > 0.01 .and. tsfcl(ix) > con_t0c ) tgxy(ix) = con_t0c - if (snowd(ix) > 0.01 .and. tsfcl(ix) > con_t0c ) tahxy(ix) = con_t0c + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tvxy(ix) = con_t0c + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tgxy(ix) = con_t0c + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tahxy(ix) = con_t0c - canicexy(ix) = 0.0 + canicexy(ix) = 0.0_kind_phys canliqxy(ix) = canopy(ix) - eahxy(ix) = 2000.0 + eahxy(ix) = 2000.0_kind_phys ! eahxy = psfc*qv/(0.622+qv); qv is mixing ratio, converted from sepcific ! humidity specific humidity /(1.0 - specific humidity) - cmxy(ix) = 0.0 - chxy(ix) = 0.0 - fwetxy(ix) = 0.0 + cmxy(ix) = zero + chxy(ix) = zero + fwetxy(ix) = zero sneqvoxy(ix) = weasd(ix) ! mm - alboldxy(ix) = 0.65 - qsnowxy(ix) = 0.0 + alboldxy(ix) = 0.65_kind_phys + qsnowxy(ix) = zero ! if (srflag(ix) > 0.001) qsnowxy(ix) = tprcp(ix)/dtp ! already set to 0.0 - wslakexy(ix) = 0.0 - taussxy(ix) = 0.0 - albdvis(ix) = 0.2 - albdnir(ix) = 0.2 - albivis(ix) = 0.2 - albinir(ix) = 0.2 - emiss(ix) = 0.95 + wslakexy(ix) = zero + taussxy(ix) = zero + albdvis(ix) = 0.2_kind_phys + albdnir(ix) = 0.2_kind_phys + albivis(ix) = 0.2_kind_phys + albinir(ix) = 0.2_kind_phys + emiss(ix) = 0.95_kind_phys - waxy(ix) = 4900.0 + waxy(ix) = 4900.0_kind_phys wtxy(ix) = waxy(ix) - zwtxy(ix) = (25.0 + 2.0) - waxy(ix) / 1000.0 /0.2 + zwtxy(ix) = (25.0_kind_phys + 2.0_kind_phys) - waxy(ix) / 1000.0_kind_phys / 0.2_kind_phys vegtyp = vtype(ix) if (vegtyp == 0) vegtyp = 7 @@ -464,81 +464,81 @@ subroutine GFS_phys_time_vary_init ( if ((vegtyp == isbarren_table) .or. (vegtyp == isice_table) .or. (vegtyp == isurban_table) .or. (vegtyp == iswater_table)) then - xlaixy(ix) = 0.0 - xsaixy(ix) = 0.0 + xlaixy(ix) = zero + xsaixy(ix) = zero - lfmassxy(ix) = 0.0 - stmassxy(ix) = 0.0 - rtmassxy(ix) = 0.0 + lfmassxy(ix) = zero + stmassxy(ix) = zero + rtmassxy(ix) = zero - woodxy (ix) = 0.0 - stblcpxy (ix) = 0.0 - fastcpxy (ix) = 0.0 + woodxy (ix) = zero + stblcpxy (ix) = zero + fastcpxy (ix) = zero else - xlaixy(ix) = max(laim_table(vegtyp, imn),0.05) + xlaixy(ix) = max(laim_table(vegtyp, imn),0.05_kind_phys) ! xsaixy(ix) = max(saim_table(vegtyp, imn),0.05) - xsaixy(ix) = max(xlaixy(ix)*0.1,0.05) + xsaixy(ix) = max(xlaixy(ix)*0.1_kind_phys,0.05_kind_phys) - masslai = 1000.0 / max(sla_table(vegtyp),1.0) + masslai = 1000.0_kind_phys / max(sla_table(vegtyp),one) lfmassxy(ix) = xlaixy(ix)*masslai - masssai = 1000.0 / 3.0 + masssai = 1000.0_kind_phys / 3.0_kind_phys stmassxy(ix) = xsaixy(ix)* masssai - rtmassxy(ix) = 500.0 + rtmassxy(ix) = 500.0_kind_phys - woodxy(ix) = 500.0 - stblcpxy(ix) = 1000.0 - fastcpxy(ix) = 1000.0 + woodxy(ix) = 500.0_kind_phys + stblcpxy(ix) = 1000.0_kind_phys + fastcpxy(ix) = 1000.0_kind_phys endif ! non urban ... if (vegtyp == isice_table) then do is = 1,lsoil - stc(ix,is) = min(stc(ix,is),min(tg3(ix),263.15)) - smc(ix,is) = 1 - slc(ix,is) = 0 + stc(ix,is) = min(stc(ix,is),min(tg3(ix),263.15_kind_phys)) + smc(ix,is) = one + slc(ix,is) = zero enddo endif - snd = snowd(ix)/1000.0 ! go to m from snwdph + snd = snowd(ix)/1000.0_kind_phys ! go to m from snwdph - if (weasd(ix) /= 0.0 .and. snd == 0.0 ) then + if (weasd(ix) /= zero .and. snd == zero ) then snd = weasd(ix)/1000.0 endif if (vegtyp == 15) then ! land ice in MODIS/IGBP - if (weasd(ix) < 0.1) then - weasd(ix) = 0.1 - snd = 0.01 + if (weasd(ix) < 0.1_kind_phys) then + weasd(ix) = 0.1_kind_phys + snd = 0.01_kind_phys endif endif - if (snd < 0.025 ) then - snowxy(ix) = 0.0 - dzsno(-2:0) = 0.0 - elseif (snd >= 0.025 .and. snd <= 0.05 ) then - snowxy(ix) = -1.0 + if (snd < 0.025_kind_phys ) then + snowxy(ix) = zero + dzsno(-2:0) = zero + elseif (snd >= 0.025_kind_phys .and. snd <= 0.05_kind_phys ) then + snowxy(ix) = -1.0_kind_phys dzsno(0) = snd - elseif (snd > 0.05 .and. snd <= 0.10 ) then - snowxy(ix) = -2.0 - dzsno(-1) = 0.5*snd - dzsno(0) = 0.5*snd - elseif (snd > 0.10 .and. snd <= 0.25 ) then - snowxy(ix) = -2.0 - dzsno(-1) = 0.05 - dzsno(0) = snd - 0.05 - elseif (snd > 0.25 .and. snd <= 0.45 ) then - snowxy(ix) = -3.0 - dzsno(-2) = 0.05 - dzsno(-1) = 0.5*(snd-0.05) - dzsno(0) = 0.5*(snd-0.05) - elseif (snd > 0.45) then - snowxy(ix) = -3.0 - dzsno(-2) = 0.05 - dzsno(-1) = 0.20 - dzsno(0) = snd - 0.05 - 0.20 + elseif (snd > 0.05_kind_phys .and. snd <= 0.10_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.5_kind_phys*snd + dzsno(0) = 0.5_kind_phys*snd + elseif (snd > 0.10_kind_phys .and. snd <= 0.25_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.05_kind_phys + dzsno(0) = snd - 0.05_kind_phys + elseif (snd > 0.25_kind_phys .and. snd <= 0.45_kind_phys ) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.5_kind_phys*(snd-0.05_kind_phys) + dzsno(0) = 0.5_kind_phys*(snd-0.05_kind_phys) + elseif (snd > 0.45_kind_phys) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.20_kind_phys + dzsno(0) = snd - 0.05_kind_phys - 0.20_kind_phys else errmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization' errflg = 1 @@ -548,17 +548,17 @@ subroutine GFS_phys_time_vary_init ( ! Now we have the snowxy field ! snice + snliq + tsno allocation and compute them from what we have - tsnoxy(ix,:) = 0.0 - snicexy(ix,:) = 0.0 - snliqxy(ix,:) = 0.0 - zsnsoxy(ix,:) = 0.0 + tsnoxy(ix,:) = zero + snicexy(ix,:) = zero + snliqxy(ix,:) = zero + zsnsoxy(ix,:) = zero isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 do is = isnow,0 tsnoxy(ix,is) = tgxy(ix) - snliqxy(ix,is) = 0.0 - snicexy(ix,is) = 1.00 * dzsno(is) * weasd(ix)/snd + snliqxy(ix,is) = zero + snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd enddo ! !zsnsoxy, all negative ? @@ -592,28 +592,28 @@ subroutine GFS_phys_time_vary_init ( endif if (vegtyp == isurban_table) then - smcmax = 0.45 - smcwlt = 0.40 + smcmax = 0.45_kind_phys + smcwlt = 0.40_kind_phys endif - if ((bexp > 0.0) .and. (smcmax > 0.0) .and. (-psisat > 0.0 )) then + if ((bexp > zero) .and. (smcmax > zero) .and. (-psisat > zero)) then do is = 1, lsoil if ( is == 1 )then - ddz = -zs(is+1) * 0.5 + ddz = -zs(is+1) * 0.5_kind_phys elseif ( is < lsoil ) then - ddz = ( zs(is-1) - zs(is+1) ) * 0.5 + ddz = ( zs(is-1) - zs(is+1) ) * 0.5_kind_phys else ddz = zs(is-1) - zs(is) endif - smoiseq(ix,is) = min(max(find_eq_smc(bexp, dwsat, dksat, ddz, smcmax),1.e-4),smcmax*0.99) + smoiseq(ix,is) = min(max(find_eq_smc(bexp, dwsat, dksat, ddz, smcmax),1.e-4_kind_phys),smcmax*0.99_kind_phys) enddo else ! bexp <= 0.0 smoiseq(ix,1:4) = smcmax endif ! end the bexp condition smcwtdxy(ix) = smcmax - deeprechxy(ix) = 0.0 - rechxy(ix) = 0.0 + deeprechxy(ix) = zero + rechxy(ix) = zero endif From a2d800b1136af477f3982766e2ee8ac94a2b6fd6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 25 Feb 2021 12:09:14 -0700 Subject: [PATCH 231/274] Update submodule pointer for physics/rte-rrtmgp --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 5a9d2567d2cee270cf60e9fcdf35eed64105d4ca Mon Sep 17 00:00:00 2001 From: tanyasmirnova Date: Thu, 25 Feb 2021 19:17:34 +0000 Subject: [PATCH 232/274] Update submodule pointer for physics/rte-rrtmgp --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 98f53cf5c4eef30890998926b59f510a41445f5a Mon Sep 17 00:00:00 2001 From: barlage Date: Thu, 25 Feb 2021 18:21:42 -0700 Subject: [PATCH 233/274] resolve some TODO in noahmp driver --- physics/sfc_noahmp_drv.F90 | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/physics/sfc_noahmp_drv.F90 b/physics/sfc_noahmp_drv.F90 index 475520473..392e29071 100644 --- a/physics/sfc_noahmp_drv.F90 +++ b/physics/sfc_noahmp_drv.F90 @@ -141,7 +141,7 @@ subroutine noahmpdrv_run & real(kind=kind_phys), parameter :: a4 = 35.86 real(kind=kind_phys), parameter :: a23m4 = a2*(a3-a4) - real, parameter :: undefined = -1.e36 ! TODO change to smaller value + real, parameter :: undefined = 9.99e20_kind_phys integer, parameter :: nsoil = 4 ! hardwired to Noah integer, parameter :: nsnow = 3 ! max. snow layers @@ -657,7 +657,7 @@ subroutine noahmpdrv_run & cloud_water_forcing = -9999.0 sw_radiation_forcing = dswsfc(i) radiation_lw_forcing = dlwflx(i) - precipitation_forcing = rhoh2o * tprcp(i) / delt !1000.0 * tprcp(i) / delt + precipitation_forcing = 1000.0 * tprcp(i) / delt precip_convective = rainc_mp(i) precip_non_convective = rainn_mp(i) precip_sh_convective = 0. @@ -681,8 +681,7 @@ subroutine noahmpdrv_run & soil_liquid_vol = slc(i,:) soil_moisture_vol = smc(i,:) temperature_canopy_air = tahxy(i) - vapor_pres_canopy_air = (air_pressure_surface*spec_humidity_forcing)/(0.622+spec_humidity_forcing) - ! TODO recalculated? set to eahxy + vapor_pres_canopy_air = eahxy(i) canopy_wet_fraction = fwetxy(i) canopy_liquid = canliqxy(i) canopy_ice = canicexy(i) @@ -690,19 +689,19 @@ subroutine noahmpdrv_run & temperature_ground = tgxy(i) spec_humidity_surface = undefined ! doesn't need inout; should be out snowfall = qsnowxy(i) ! doesn't need inout; should be out -! rainfall ! doesn't need inout; should be out TODO + rainfall = -9999.0 ! doesn't need inout; should be out snow_levels = nint(snowxy(i)) interface_depth = zsnsoxy(i,:) snow_depth = snwdph(i) * 0.001 ! convert from mm to m snow_water_equiv = weasd(i) - if (snow_water_equiv /= 0.0 .and. snow_depth == 0.0) then !TODO this should be done elsewhere + if (snow_water_equiv /= 0.0 .and. snow_depth == 0.0) then snow_depth = 10.0 * snow_water_equiv /1000.0 endif snow_level_ice = snicexy(i,:) snow_level_liquid = snliqxy(i,:) depth_water_table = zwtxy(i) aquifer_water = waxy(i) - saturated_water = waxy(i) ! why not wta !!! TODO + saturated_water = wtxy(i) lake_water = wslakexy(i) leaf_carbon = lfmassxy(i) root_carbon = rtmassxy(i) @@ -753,8 +752,8 @@ subroutine noahmpdrv_run & if ( vegetation_category == isice_table ) then if (precipitation_forcing > 0.0) then - if (srflag(i) > 0.0) then ! TODO rain/snow flag, one condition is enough? - snowfall = srflag(i) * precipitation_forcing/10.0 ! still use rho water? + if (srflag(i) > 0.0) then + snowfall = srflag(i) * precipitation_forcing ! need snowfall for glacier snow age endif endif @@ -926,7 +925,7 @@ subroutine noahmpdrv_run & snicexy (i,:) = snow_level_ice snliqxy (i,:) = snow_level_liquid snwdph (i) = snow_depth * 1000.0 ! convert from mm to m - canopy (i) = canopy_ice + canopy_liquid ! TODO check units + canopy (i) = canopy_ice + canopy_liquid canliqxy (i) = canopy_liquid canicexy (i) = canopy_ice zwtxy (i) = depth_water_table @@ -947,8 +946,7 @@ subroutine noahmpdrv_run & snowc (i) = snow_cover_fraction sncovr1 (i) = snow_cover_fraction - ! TODO check this eqn shoud lthis be q2 not q1 why two con_cp - qsurf (i) = q1(i) + evap(i) / (con_hvap / con_cp * density * con_cp * ch(i) * wind(i)) + qsurf (i) = q1(i) + evap(i) / (con_hvap / con_cp * density * ch(i) * wind(i)) tskin (i) = temperature_radiative tsurf (i) = temperature_radiative tvxy (i) = temperature_leaf From bfba6d744278a00e4cd8c9440e5a488f28c012b8 Mon Sep 17 00:00:00 2001 From: barlage Date: Thu, 25 Feb 2021 18:22:33 -0700 Subject: [PATCH 234/274] change czil in table to more reasonable value --- physics/noahmp_tables.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/noahmp_tables.f90 b/physics/noahmp_tables.f90 index 84a5775a5..6341ae61a 100644 --- a/physics/noahmp_tables.f90 +++ b/physics/noahmp_tables.f90 @@ -735,7 +735,7 @@ module noahmp_tables real :: refkdt_table = 3.0 !parameter in the surface runoff parameterization real :: frzk_table =0.15 !frozen ground parameter real :: zbot_table = -8.0 !depth [m] of lower boundary soil temperature - real :: czil_table = 0.01 !parameter used in the calculation of the roughness length for heat + real :: czil_table = 0.1 !parameter used in the calculation of the roughness length for heat ! mptable.tbl radiation parameters From 4c74498e664b912a46df829bb828893a05c12ade Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 26 Feb 2021 07:24:07 -0700 Subject: [PATCH 235/274] Bugfixes, performance improvements and formatting updates in physics/GFS_suite_interstitial.F90 and physics/GFS_rrtmgp_thompsonmp_pre.F90 --- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 140 +++++++++++++------------- physics/GFS_suite_interstitial.F90 | 11 +- 2 files changed, 74 insertions(+), 77 deletions(-) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index de1fa3547..58e1bddea 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -16,24 +16,24 @@ module GFS_rrtmgp_thompsonmp_pre make_RainNumber use rrtmgp_lw_cloud_optics, only: radliq_lwr, radliq_upr, radice_lwr, radice_upr implicit none - + ! Parameters specific to THOMPSON MP scheme. real(kind_phys), parameter :: & rerain_def = 1000.0 ! Default rain radius to 1000 microns - + public GFS_rrtmgp_thompsonmp_pre_init, GFS_rrtmgp_thompsonmp_pre_run, GFS_rrtmgp_thompsonmp_pre_finalize - -contains + +contains ! ###################################################################################### ! ###################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_init() end subroutine GFS_rrtmgp_thompsonmp_pre_init - + ! ###################################################################################### ! ###################################################################################### !! \section arg_table_GFS_rrtmgp_thompsonmp_pre_run !! \htmlinclude GFS_rrtmgp_thompsonmp_pre_run.html -!! +!! subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, doLWrad, & i_cldliq, i_cldice, i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, & i_cldice_nc, i_twa, effr_in, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, & @@ -42,14 +42,14 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do imfdeepcnv_gf, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, errmsg, errflg) - - ! Inputs + + ! Inputs integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers ncnd, & ! Number of cloud condensation types. - nTracers, & ! Number of tracers from model. - i_cldliq, & ! Index into tracer array for cloud liquid amount. + nTracers, & ! Number of tracers from model. + i_cldliq, & ! Index into tracer array for cloud liquid amount. i_cldice, & ! cloud ice amount. i_cldrain, & ! cloud rain amount. i_cldsnow, & ! cloud snow amount. @@ -61,9 +61,9 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do imfdeepcnv, & ! Choice of mass-flux deep convection scheme imfdeepcnv_gf ! Flag for Grell-Freitas deep convection scheme logical, intent(in) :: & - doSWrad, & ! Call SW radiation? - doLWrad, & ! Call LW radiation - effr_in, & ! Use cloud effective radii provided by model? + doSWrad, & ! Call SW radiation? + doLWrad, & ! Call LW radiation + effr_in, & ! Use cloud effective radii provided by model? uni_cld, & ! Use provided cloud-fraction? lmfshal, & ! Flag for mass-flux shallow convection scheme used by Xu-Randall lmfdeep2, & ! Flag for some scale-aware mass-flux convection scheme active @@ -75,7 +75,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do con_g, & ! Physical constant: gravitational constant con_rd ! Physical constant: gas-constant for dry air - real(kind_phys), dimension(nCol,nLev), intent(in) :: & + real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) t_lay, & ! Temperature (K) qs_lay, & ! Saturation vapor pressure (Pa) @@ -83,13 +83,13 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do relhum, & ! Relative humidity p_lay, & ! Pressure at model-layers (Pa) cld_frac_mg ! Cloud-fraction from MG scheme. WTF????? - real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & p_lev ! Pressure at model-level interfaces (Pa) real(kind_phys), dimension(nCol, nLev, nTracers),intent(in) :: & - tracer ! Cloud condensate amount in layer by type () - + tracer ! Cloud condensate amount in layer by type () + ! In/Outs - real(kind_phys), dimension(nCol,nLev), intent(inout) :: & + real(kind_phys), dimension(nCol,nLev), intent(inout) :: & cld_frac, & ! Total cloud fraction cld_lwp, & ! Cloud liquid water path cld_reliq, & ! Cloud liquid effective radius @@ -97,31 +97,32 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do cld_reice, & ! Cloud ice effecive radius cld_swp, & ! Cloud snow water path cld_resnow, & ! Cloud snow effective radius - cld_rwp, & ! Cloud rain water path + cld_rwp, & ! Cloud rain water path cld_rerain, & ! Cloud rain effective radius precip_frac, & ! Precipitation fraction effrin_cldliq, & ! Effective radius for liquid cloud-particles (microns) effrin_cldice, & ! Effective radius for ice cloud-particles (microns) - effrin_cldsnow ! Effective radius for snow cloud-particles (microns) - - ! Outputs + effrin_cldsnow ! Effective radius for snow cloud-particles (microns) + + ! Outputs character(len=*), intent(out) :: & errmsg ! Error message - integer, intent(out) :: & + integer, intent(out) :: & errflg ! Error flag - + ! Local variables real(kind_phys) :: alpha0, pfac, tem1, cld_mr real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate integer :: iCol,iLay,l - real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, rho, orho, re_cloud, re_ice,& + real(kind_phys) :: rho, orho + real(kind_phys), dimension(nCol,nLev) :: deltaP, deltaZ, re_cloud, re_ice,& re_snow, qv_mp, qc_mp, qi_mp, qs_mp, nc_mp, ni_mp, nwfa logical :: top_at_1 - + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - + if (.not. (doSWrad .or. doLWrad)) return ! Cloud condensate @@ -129,29 +130,30 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do cld_condensate(1:nCol,1:nLev,2) = tracer(1:nCol,1:nLev,i_cldice) ! -ice water cld_condensate(1:nCol,1:nLev,3) = tracer(1:nCol,1:nLev,i_cldrain) ! -rain water cld_condensate(1:nCol,1:nLev,4) = tracer(1:nCol,1:nLev,i_cldsnow) + &! -snow + grapuel - tracer(1:nCol,1:nLev,i_cldgrpl) - + tracer(1:nCol,1:nLev,i_cldgrpl) + ! Cloud water path (g/m2) - deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. + deltaP = abs(p_lev(:,2:nLev+1)-p_lev(:,1:nLev))/100. do iLay = 1, nLev do iCol = 1, nCol - ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) + ! Compute liquid/ice condensate path from mixing ratios (kg/kg)->(g/m2) tem1 = (1.0e5/con_g) * deltaP(iCol,iLay) cld_lwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,1) * tem1) cld_iwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,2) * tem1) cld_rwp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,3) * tem1) - cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) + cld_swp(iCol,iLay) = max(0., cld_condensate(iCol,iLay,4) * tem1) enddo - enddo - + enddo + ! Cloud particle sizes and number concentrations... - - ! First, prepare cloud mixing-ratios and number concentrations for Calc_Re + + ! Prepare cloud mixing-ratios and number concentrations for calc_effectRad, + ! and update number concentrations, consistent with sub-grid clouds do iLay = 1, nLev - do iCol = 1, nCol + do iCol = 1, nCol qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) - rho(iCol,iLay) = 0.622*p_lay(1:nCol,1:nLev)/(con_rd*t_lay(1:nCol,1:nLev)*(qv_mp(iCol,iLay)+0.622)) - orho(iCol,iLay) = 1./rho(iCol,iLay) + rho = 0.622*p_lay(iCol,iLay)/(con_rd*t_lay(iCol,iLay)*(qv_mp(iCol,iLay)+0.622)) + orho = 1./rho qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) qs_mp(iCol,iLay) = tracer(iCol,iLay,i_cldsnow) / (1.-q_lay(iCol,iLay)) @@ -159,24 +161,18 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do ni_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice_nc) / (1.-q_lay(iCol,iLay)) if (ltaerosol) then nwfa(iCol,iLay) = tracer(iCol,iLay,i_twa) + if (qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then + nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho, nwfa(iCol,iLay)*rho) * orho + endif else - nc_mp(iCol,iLay) = nt_c*orho(iCol,iLay) - endif - enddo - enddo - - ! Update number concentration, consistent with sub-grid clouds - do iLay = 1, nLev - do iCol = 1, nCol - if (ltaerosol .and. qc_mp(iCol,iLay) > 1.e-12 .and. nc_mp(iCol,iLay) < 100.) then - nc_mp(iCol,iLay) = make_DropletNumber(qc_mp(iCol,iLay)*rho(iCol,iLay), nwfa(iCol,iLay)*rho(iCol,iLay)) * orho(iCol,iLay) + nc_mp(iCol,iLay) = nt_c*orho endif if (qi_mp(iCol,iLay) > 1.e-12 .and. ni_mp(iCol,iLay) < 100.) then - ni_mp(iCol,iLay) = make_IceNumber(qi_mp(iCol,iLay)*rho(iCol,iLay), t_lay(iCol,iLay)) * orho(iCol,iLay) + ni_mp(iCol,iLay) = make_IceNumber(qi_mp(iCol,iLay)*rho, t_lay(iCol,iLay)) * orho endif enddo enddo - + ! Compute effective radii for liquid/ice/snow using subgrid scale clouds ! Call Thompson's subroutine to compute effective radii do iCol=1,nCol @@ -184,14 +180,14 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) enddo - - ! Scale Thompson's effective radii from meter to micron + + ! Scale Thompson's effective radii from meter to micron effrin_cldliq(1:nCol,1:nLev) = re_cloud(1:nCol,1:nLev)*1.e6 effrin_cldice(1:nCol,1:nLev) = re_ice(1:nCol,1:nLev)*1.e6 effrin_cldsnow(1:nCol,1:nLev) = re_snow(1:nCol,1:nLev)*1.e6 - - ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from - ! 2.5 - 21.5 microns for liquid clouds, + + ! Bound effective radii for RRTMGP, LUT's for cloud-optics go from + ! 2.5 - 21.5 microns for liquid clouds, ! 10 - 180 microns for ice-clouds if (doGP_cldoptics_PADE .or. doGP_cldoptics_LUT) then where(effrin_cldliq .lt. radliq_lwr) effrin_cldliq = radliq_lwr @@ -205,32 +201,32 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do cld_reice(1:nCol,1:nLev) = effrin_cldice(1:nCol,1:nLev) cld_resnow(1:nCol,1:nLev) = effrin_cldsnow(1:nCol,1:nLev) cld_rerain(1:nCol,1:nLev) = rerain_def - + ! Compute cloud-fraction. Else, use value provided - if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv + if(.not. do_mynnedmf .or. imfdeepcnv .ne. imfdeepcnv_gf ) then ! MYNN PBL or GF conv ! Cloud-fraction if (uni_cld) then - cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) + cld_frac(1:nCol,1:nLev) = cld_frac_mg(1:nCol,1:nLev) else if( lmfshal) alpha0 = 100. ! Default (from GATE simulations) if(.not. lmfshal) alpha0 = 2000. - ! Xu-Randall (1996) cloud-fraction + ! Xu-Randall (1996) cloud-fraction do iLay = 1, nLev do iCol = 1, nCol cld_mr = cld_condensate(iCol,iLay,1) + cld_condensate(iCol,iLay,2) + & cld_condensate(iCol,iLay,4) - cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & - qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0) + cld_frac(iCol,iLay) = cld_frac_XuRandall(p_lay(iCol,iLay), & + qs_lay(iCol,iLay), relhum(iCol,iLay), cld_mr, alpha0) enddo enddo endif endif - + ! Precipitation fraction (Hack. For now use cloud-fraction) precip_frac(1:nCol,1:nLev) = cld_frac(1:nCol,1:nLev) - + end subroutine GFS_rrtmgp_thompsonmp_pre_run - + ! ###################################################################################### ! ###################################################################################### subroutine GFS_rrtmgp_thompsonmp_pre_finalize() @@ -241,11 +237,11 @@ end subroutine GFS_rrtmgp_thompsonmp_pre_finalize ! Xu-Randall(1996) A Semiempirical Cloudiness Parameterization for Use in Climate Models ! https://doi.org/10.1175/1520-0469(1996)053<3084:ASCPFU>2.0.CO;2 ! - ! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P + ! cld_frac = {1-exp[-alpha*cld_mr/((1-relhum)*qs_lay)**lambda]}*relhum**P ! ! ###################################################################################### function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) - + ! Inputs real(kind_phys), intent(in) :: & p_lay, & ! Pressure (Pa) @@ -253,7 +249,7 @@ function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) relhum, & ! Relative humidity cld_mr, & ! Total cloud mixing ratio alpha ! Scheme parameter (default=100) - + ! Outputs real(kind_phys) :: cld_frac_XuRandall @@ -262,21 +258,21 @@ function cld_frac_XuRandall(p_lay, qs_lay, relhum, cld_mr, alpha) ! Parameters real(kind_phys) :: & - lambda = 0.50, & ! + lambda = 0.50, & ! P = 0.25 - + clwt = 1.0e-6 * (p_lay*0.001) if (cld_mr > clwt) then onemrh = max(1.e-10, 1.0 - relhum) tem1 = alpha / min(max((onemrh*qs_lay)**lambda,0.0001),1.0) tem2 = max(min(tem1*(cld_mr - clwt), 50.0 ), 0.0 ) tem3 = sqrt(sqrt(relhum)) ! This assumes "p" = 0.25. Identical, but cheaper than relhum**p - ! + ! cld_frac_XuRandall = max( tem3*(1.0-exp(-tem2)), 0.0 ) else cld_frac_XuRandall = 0.0 endif - + return end function end module GFS_rrtmgp_thompsonmp_pre diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 464ede8cc..b51b6f9c8 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -692,7 +692,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ! local variables integer :: i,k,n,tracers - real(kind=kind_phys), dimension(im,levs) :: rho_air + real(kind=kind_phys) :: rho, orho real(kind=kind_phys), dimension(im,levs) :: qv_mp !< kg kg-1 (dry mixing ratio) real(kind=kind_phys), dimension(im,levs) :: qc_mp !< kg kg-1 (dry mixing ratio) real(kind=kind_phys), dimension(im,levs) :: qi_mp !< kg kg-1 (dry mixing ratio) @@ -744,14 +744,15 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to do i=1,im !> - Convert specific humidity to dry mixing ratio qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k)) - !> - Density of air in kg m-3 - rho_air(i,k) = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+0.622)) + !> - Density of air in kg m-3 and inverse density + rho = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+0.622)) + orho = one/rho if (ntlnc>0) then !> - Convert moist mixing ratio to dry mixing ratio qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k)) !> - Convert number concentration from moist to dry nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k)) - nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho_air(i,k), nwfa(i,k)*rho_air(i,k)) * (one/rho_air(i,k))) + nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) !> - Convert number concentrations from dry to moist gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k)) endif @@ -760,7 +761,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k)) !> - Convert number concentration from moist to dry ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) - ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho_air(i,k), save_tcp(i,k)) * (one/rho_air(i,k))) + ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) !> - Convert number concentrations from dry to moist gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k)) endif From a13ef16702a01b971192c319afe812e46a40b3f9 Mon Sep 17 00:00:00 2001 From: Greg Thompson Date: Fri, 26 Feb 2021 15:07:12 -0700 Subject: [PATCH 236/274] adopt moist air density in place of dry air density --- physics/mp_thompson.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 79994674f..84c30a18e 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -126,10 +126,6 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! Geopotential height in m2 s-2 to height in m hgt = phil/con_g - ! Density of air in kg m-3 and inverse density of air - rho = prsl/(con_rd*tgrs) - orho = 1.0/rho - ! Ensure non-negative mass mixing ratios of all water variables where(spechum<0) spechum = 1.0E-10 ! COMMENT, gthompsn, spechum should *never* be identically zero. where(qc<0) qc = 0.0 @@ -141,6 +137,10 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! Convert specific humidity to water vapor mixing ratio qv = spechum/(1.0_kind_phys-spechum) + ! Density of moist air in kg m-3 and inverse density of air + rho = 0.622*prsl/(con_rd*tgrs*(qv+0.622)) + orho = 1.0/rho + ! Ensure we have 1st guess ice number where mass non-zero but no number. where(qi .LE. 0.0) ni=0.0 where(qi .GT. 0 .and. ni .LE. 0.0) ni = make_IceNumber(qi*rho, tgrs) * orho From c6f1cab8cc644c803739047aa238c7155102c0ef Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 1 Mar 2021 07:32:32 -0700 Subject: [PATCH 237/274] Fix bug due to merge in physics/mp_thompson.F90 --- physics/mp_thompson.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 337161140..fbfbe72a9 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -431,7 +431,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & end if !> - Density of air in kg m-3 - rho = 0.622*prsl/(con_rd*tgrs*(qv_mp+0.622)) + rho = 0.622*prsl/(con_rd*tgrs*(qv+0.622)) !> - Convert omega in Pa s-1 to vertical velocity w in m s-1 w = -omega/(rho*con_g) From 2a2d75076ab43f60b7ea7776f5e3b0e7dc98d9dd Mon Sep 17 00:00:00 2001 From: Greg Thompson Date: Mon, 1 Mar 2021 08:40:16 -0700 Subject: [PATCH 238/274] finalze the correct min,max aerosol numbers with regard to air density --- physics/module_mp_thompson.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index ed8309789..09bb5c939 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1261,8 +1261,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & else do k = kts, kte nc1d(k) = Nt_c/rho(k) - nwfa1d(k) = 11.1E6/rho(k) - nifa1d(k) = naIN1*0.01/rho(k) + nwfa1d(k) = 11.1E6 + nifa1d(k) = naIN1*0.01 enddo endif @@ -1785,8 +1785,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & qv(k) = MAX(1.E-10, qv1d(k)) pres(k) = p1d(k) rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622)) - nwfa(k) = MAX(11.1E6, MIN(9999.E6, nwfa1d(k)*rho(k))) - nifa(k) = MAX(naIN1*0.01, MIN(9999.E6, nifa1d(k)*rho(k))) + nwfa(k) = MAX(11.1E6*rho(k), MIN(9999.E6*rho(k), nwfa1d(k)*rho(k))) + nifa(k) = MAX(naIN1*0.01*rho(k), MIN(9999.E6*rho(k), nifa1d(k)*rho(k))) mvd_r(k) = D0r mvd_c(k) = D0c @@ -2987,7 +2987,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ocp(k) = 1./(Cp*(1.+0.887*qv(k))) lvt2(k)=lvap(k)*lvap(k)*ocp(k)*oRv*otemp*otemp - nwfa(k) = MAX(11.1E6, (nwfa1d(k) + nwfaten(k)*DT)*rho(k)) + nwfa(k) = MAX(11.1E6*rho(k), (nwfa1d(k) + nwfaten(k)*DT)*rho(k)) enddo do k = kts, kte From 162a47a8ddd0f0c6828543ecccda552f3f55b5f0 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Mon, 1 Mar 2021 14:27:34 -0700 Subject: [PATCH 239/274] revert testing changes to CMakeLists.txt --- CMakeLists.txt | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 4dedf715a..441f047f6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -72,8 +72,7 @@ set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) if(TYPEDEFS) message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") else(TYPEDEFS) - #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) - include(./CCPP_TYPEDEFS.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_TYPEDEFS.cmake) message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") endif(TYPEDEFS) @@ -89,8 +88,7 @@ set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") else(SCHEMES) - #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) - include(./CCPP_SCHEMES.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_SCHEMES.cmake) message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") endif(SCHEMES) @@ -99,8 +97,7 @@ set(CAPS $ENV{CCPP_CAPS}) if(CAPS) message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") else(CAPS) - #include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) - include(./CCPP_CAPS.cmake) + include(${CMAKE_CURRENT_BINARY_DIR}/CCPP_CAPS.cmake) message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") endif(CAPS) From 8010a66d7f7724d4df896995dc26196e199c0c1e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 2 Mar 2021 10:52:05 -0700 Subject: [PATCH 240/274] fix Doxygen 'file' comments --- physics/GFS_rad_time_vary.scm.F90 | 2 +- physics/GFS_time_vary_pre.scm.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rad_time_vary.scm.F90 b/physics/GFS_rad_time_vary.scm.F90 index 38b9c9508..d7d4cda26 100644 --- a/physics/GFS_rad_time_vary.scm.F90 +++ b/physics/GFS_rad_time_vary.scm.F90 @@ -1,4 +1,4 @@ -!>\file GFS_rad_time_vary.F90 +!>\file GFS_rad_time_vary.scm.F90 !! Contains code related to GFS physics suite setup (radiation part of time_vary_step) module GFS_rad_time_vary diff --git a/physics/GFS_time_vary_pre.scm.F90 b/physics/GFS_time_vary_pre.scm.F90 index 365bd2c56..c4c235f61 100644 --- a/physics/GFS_time_vary_pre.scm.F90 +++ b/physics/GFS_time_vary_pre.scm.F90 @@ -1,4 +1,4 @@ -!> \file GFS_time_vary_pre.F90 +!> \file GFS_time_vary_pre.scm.F90 !! Contains code related to GFS physics suite setup (generic part of time_vary_step) module GFS_time_vary_pre From eaab868187a34adbc42e84a08c3df1bc5fa90e77 Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Wed, 3 Mar 2021 13:48:56 -0600 Subject: [PATCH 241/274] point to correct branch of rrtmgp --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 67c46a8de3793cd2b085fb417d82100e657d0771 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Wed, 3 Mar 2021 19:40:19 -0500 Subject: [PATCH 242/274] adding updated RAS --- physics/rascnv.F90 | 185 +++++++++++++++++++++++--------------------- physics/rascnv.meta | 4 +- 2 files changed, 98 insertions(+), 91 deletions(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 1c311e4cf..9c47144ac 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -8,7 +8,7 @@ module rascnv implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private - logical :: is_initialized = .False. + logical, save :: is_initialized = .False. ! integer, parameter :: kp = kind_phys integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s @@ -34,17 +34,20 @@ module rascnv &, facmb = 0.01_kp & ! conversion factor from Pa to hPa (or mb) &, cmb2pa = 100.0_kp ! Conversion from hPa to Pa ! - real(kind=kind_phys), parameter :: frac=0.5_kp, crtmsf=0.0_kp & - &, rhfacs=0.75_kp, rhfacl=0.75_kp & - &, face=5.0_kp, delx=10000.0_kp& - &, ddfac=face*delx*0.001_kp & - &, max_neg_bouy=0.15_kp & -! &, max_neg_bouy=pt25_kp & - &, testmb=0.1_kp, testmbi=one/testmb & - &, dpd=0.5_kp, rknob=1.0_kp, eknob=1.0_kp +! real (kind=kind_phys), parameter :: frac=0.5_kp, crtmsf=0.0_kp & + real (kind=kind_phys), parameter :: frac=0.1_kp, crtmsf=0.0_kp & + &, tfrac_max=0.15_kp & + &, rhfacs=0.75_kp, rhfacl=0.75_kp & + &, face=5.0_kp, delx=10000.0_kp & + &, ddfac=face*delx*0.001_kp & + &, max_neg_bouy=0.15_kp & +! &, max_neg_bouy=pt25_kp & + &, testmb=0.1_kp, testmbi=one/testmb & + &, dpd=0.5_kp, rknob=1.0_kp, eknob=1.0_kp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - logical, parameter :: do_aw=.true., cumfrc=.true. & +! logical, parameter :: aw_scal=.false., cumfrc=.true. & + logical, parameter :: aw_scal=.true., cumfrc=.true. & &, updret=.false., vsmooth=.false. & &, wrkfun=.false., crtfun=.true. & &, calkbl=.true., botop=.true., revap=.true. & @@ -67,24 +70,24 @@ module rascnv ! ! For Tilting Angle Specification ! - real(kind=kind_phys) REFP(6), REFR(6), TLAC(8), PLAC(8), TLBPL(7) & - &, drdp(5) + real(kind=kind_phys), save :: REFP(6), REFR(6), TLAC(8), PLAC(8), & + TLBPL(7), drdp(5) ! DATA PLAC/100.0, 200.0, 300.0, 400.0, 500.0, 600.0, 700.0, 800.0/ DATA TLAC/ 35.0, 25.0, 20.0, 17.5, 15.0, 12.5, 10.0, 7.5/ DATA REFP/500.0, 300.0, 250.0, 200.0, 150.0, 100.0/ DATA REFR/ 1.0, 2.0, 3.0, 4.0, 6.0, 8.0/ ! - real(kind=kind_phys) AC(16), AD(16) + real(kind=kind_phys), save :: AC(16), AD(16) ! integer, parameter :: nqrp=500001 - real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & - &, TBQRB(NQRP) + real(kind=kind_phys), save :: C1XQRP, C2XQRP, TBQRP(NQRP), & + TBQRA(NQRP), TBQRB(NQRP) ! integer, parameter :: nvtp=10001 - real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) + real(kind=kind_phys), save :: C1XVTP, C2XVTP, TBVTP(NVTP) ! - real(kind=kind_phys) afc, facdt, & + real(kind=kind_phys), save :: afc, facdt, & grav, cp, alhl, alhf, rgas, rkap, nu, pi, & t0c, rv, cvap, cliq, csol, ttp, eps, epsm1,& ! @@ -118,12 +121,13 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & con_g, con_cp, con_rd, con_rv, con_hvap, & con_hfus, con_fvirt, con_t0c, con_cvap, con_cliq, & con_csol, con_ttp, con_eps, con_epsm1 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! real(kind=kind_phys), parameter :: actp=1.7_kp, facm=1.00_kp ! - real(kind=kind_phys) PH(15), A(15) + real(kind=kind_phys) :: PH(15), A(15) ! DATA PH/150.0, 200.0, 250.0, 300.0, 350.0, 400.0, 450.0, 500.0 & &, 550.0, 600.0, 650.0, 700.0, 750.0, 800.0, 850.0/ @@ -134,8 +138,6 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & ! real(kind=kind_phys) tem, actop, tem1, tem2 integer i, l - logical first - data first/.true./ ! ! Initialize CCPP error handling variables errmsg = '' @@ -169,6 +171,12 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & ! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 ! AFC = -(1.01097e-4_kp*DT)*(3600.0_kp/DT)**0.57777778_kp +! + if (fix_ncld_hr) then + facdt = delt_c / dt + else + facdt = one / 3600.0_kp + endif ! grav = con_g ; cp = con_cp ; alhl = con_hvap alhf = con_hfus ; rgas = con_rd @@ -186,9 +194,9 @@ subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & picon = half*pi*onebg ; zfac = 0.28888889e-4_kp * ONEBG testmboalhl = testmb/alhl ! - rvi = one/rv ; facw=CVAP-CLIQ - faci = CVAP-CSOL ; hsub=alhl+alhf - tmix = TTP-20.0_kp ; DEN=one/(TTP-TMIX) + rvi = one / rv ; facw = CVAP - CLIQ + faci = CVAP - CSOL ; hsub = alhl + alhf + tmix = TTP - 20.0_kp ; DEN = one / (TTP-TMIX) ! if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & @@ -286,7 +294,7 @@ end subroutine rascnv_finalize !! \section arg_table_rascnv_run Argument Table !! \htmlinclude rascnv_run.html !! - subroutine rascnv_run(IM, k, ntr, dt, dtf & + subroutine rascnv_run(IM, k, ntr, dt, dtf & &, ccwf, area, dxmin, dxinv & &, psauras, prauras, wminras, dlqf, flipv & &, me, rannum, nrcm, mp_phys, mp_phys_mg & @@ -329,10 +337,12 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & &, psauras(2), prauras(2) & &, wminras(2), dlqf(2) ! - real(kind=kind_phys), dimension(im,k) :: tin, qin, uin, vin & - &, prsl, prslk, phil real(kind=kind_phys), dimension(im,k+1) :: prsi, prsik, phii - real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, dt_mf & + + real(kind=kind_phys), dimension(im,k) :: tin, qin, uin, vin & + &, prsl, prslk, phil & + + &, ud_mf, dd_mf, dt_mf & &, rhc, qlcn, qicn, w_upi & &, cnv_mfd & &, cnv_dqldt, clcn & @@ -344,7 +354,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & real(kind=kind_phys) ccin(im,k,ntr+2) real(kind=kind_phys) trcmin(ntr+2) - real(kind=kind_phys) DT, dtf, qw0, qi0 + real(kind=kind_phys) DT, dtf ! ! Added for aerosol scavenging for GOCART ! @@ -380,13 +390,13 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & &, kblmn, ksfc, ncrnd - real(kind=kind_phys) sgcs(k,im) + real(kind=kind_phys) sgcs(k) ! ! Scavenging related parameters ! real fscav_(ntr+2) ! Fraction scavenged per km ! - fscav_ = zero ! By default no scavenging + fscav_ = zero ! By default no scavenging if (ntr > 0) then do i=1,ntr fscav_(i) = fscav(i) @@ -425,7 +435,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & endif ! !!!!! initialization for microphysics ACheng - if(mp_phys == 10) then + if(mp_phys == mp_phys_mg) then do l=1,K do i=1,im QLCN(i,l) = zero @@ -482,11 +492,12 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & KFMAX = KRMAX kblmx = 1 kblmn = 1 + sgcs(k) = one DO L=1,KM1 ll = l if (flipv) ll = kp1 -l ! Input variables are bottom to top! SGC = prsl(ipt,ll) * tem - sgcs(l,ipt) = sgc + sgcs(l) = sgc IF (SGC <= 0.050_kp) KRMIN = L ! IF (SGC <= 0.700_kp) KRMAX = L ! IF (SGC <= 0.800_kp) KRMAX = L @@ -500,6 +511,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ENDDO krmin = max(krmin,2) +! if (kdt == 1 .and. ipt == 1) write(0,*)' kblmn=',kblmn,kblmx ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 @@ -510,10 +522,8 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/360) + 0.50001 ! & + 0.50001 ! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * min(1.0,DTF/360) + 0.1 - facdt = delt_c / dt else NCRND = min(nrcmax, (KRMAX-KRMIN+1)) - facdt = one / 3600.0_kp endif NCRND = min(nrcm,max(NCRND, 1)) ! @@ -779,6 +789,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! IB = IC(NC) ! cloud top level index if (ib > kbl-1) cycle +! ! !**************************************************************************** @@ -858,12 +869,12 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & rainp = rain CALL CLOUD(K, KP1, IB, ntrc, kblmx, kblmn & - &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & + &, FRAC, MAX_NEG_BOUY, vsmooth, aw_scal & &, REVAP, WRKFUN, CALKBL, CRTFUN & &, DT, KDT, TLA, DPD & &, ALFINT, rhfacl, rhfacs, area(ipt) & &, ccwfac, CDRAG(ipt), trcfac & - &, alfind, rhc_l, phi_l, phi_h, PRS, PRSM,sgcs(1,ipt) & + &, alfind, rhc_l, phi_l, phi_h, PRS, PRSM,sgcs & &, TOI, QOI, UVI, QLI, QII, KBL, DDVEL(ipt) & &, TCU, QCU, RCU, PCU, FLX, FLXD, RAIN, WFNC, fscav_ & &, trcmin, ntk-2, c0, wminras(1), c0i, wminras(2) & @@ -880,15 +891,15 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ll = kp1 - ib dt_mf(ipt,ll) = dt_mf(ipt,ll) + flx(ib) - if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 + if (mp_phys == mp_phys_mg) then ! Anning Cheng for microphysics 11/14/2015 CNV_MFD(ipt,ll) = CNV_MFD(ipt,ll) + flx(ib)/dt -! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) -! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +!! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) +!! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* & & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt -! & max(0.,(QLI(ib)+QII(ib)))/dt/3. +!! & max(0.,(QLI(ib)+QII(ib)))/dt/3. if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & & ,ipt,ll endif @@ -901,16 +912,17 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & enddo dt_mf(ipt,ib) = dt_mf(ipt,ib) + flx(ib) - if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 + if (mp_phys == mp_phys_mg) then ! Anning Cheng for microphysics 11/14/2015 CNV_MFD(ipt,ib) = CNV_MFD(ipt,ib) + flx(ib)/dt -! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) -! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +!! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) +!! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & & max(zero,(QLI(ib)+QII(ib)-qiid-qlid))/dt -! & max(0.,(QLI(ib)+QII(ib)))/dt/3. +!! & max(0.,(QLI(ib)+QII(ib)))/dt/3. if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & & ,ipt,ib endif + endif ! ! @@ -944,9 +956,9 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! clw(i) = max(clw(i), zero) ! cli(i) = max(cli(i), zero) - if (sgcs(l,ipt) < 0.93_kp .and. abs(tcu(l)) > one_m10) then -! if (sgcs(l,ipt) < 0.90_kp .and. tcu(l) .ne. zero) then -! if (sgcs(l,ipt) < 0.85_kp .and. tcu(l) .ne. zero) then + if (sgcs(l) < 0.93_kp .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l) < 0.90_kp .and. tcu(l) .ne. zero) then +! if (sgcs(l) < 0.85_kp .and. tcu(l) .ne. zero) then kcnv(ipt) = 1 endif ! New test for convective clouds ! added in 08/21/96 @@ -967,7 +979,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & vin(ipt,ll) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables - if (mp_phys == 10) then + if (mp_phys == mp_phys_mg) then if (advcld) then QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) @@ -1018,7 +1030,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & vin(ipt,l) = uvi(l,ntr+2) ! V momentum !! for 2M microphysics, always output these variables - if (mp_phys == 10) then + if (mp_phys == mp_phys_mg) then if (advcld) then QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) @@ -1071,7 +1083,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & end subroutine rascnv_run SUBROUTINE CLOUD( & & K, KP1, KD, NTRC, KBLMX, kblmn & - &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & + &, FRACBL, MAX_NEG_BOUY, vsmooth, aw_scal & &, REVAP, WRKFUN, CALKBL, CRTFUN & &, DT, KDT, TLA, DPD & &, ALFINT, RHFACL, RHFACS, area, ccwf, cd, trcfac & @@ -1145,15 +1157,18 @@ SUBROUTINE CLOUD( & &, RHRAM=0.05_kp & ! PBL RELATIVE HUMIDITY RAMP ! &, RHRAM=0.15_kp !& ! PBL RELATIVE HUMIDITY RAMP &, HCRITD=4000.0_kp & ! Critical Moist Static Energy for Deep clouds - &, HCRITS=2000.0_kp & ! Critical Moist Static Energy for Shallow clouds +! &, HCRITS=2000.0_kp & ! Critical Moist Static Energy for Shallow clouds + &, HCRITS=2500.0_kp & ! Critical Moist Static Energy for Shallow clouds &, pcrit_lcl=250.0_kp & ! Critical pressure difference between boundary layer top - ! layer top and lifting condensation level (hPa) -! &, hpert_fac=1.01_kp !& ! Perturbation on hbl when ctei=.true. -! &, hpert_fac=1.005_kp !& ! Perturbation on hbl when ctei=.true. + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01_kp & ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005_kp & ! Perturbation on hbl when ctei=.true. &, qudfac=quad_lam*half & &, shalfac=3.0_kp & ! &, qudfac=quad_lam*pt25, shalfac=3.0_kp !& ! Yogesh's - &, c0ifac=0.07_kp & ! following Han et al, 2016 MWR +! &, c0ifac=0.07_kp & ! following Han et al, 2016 MWR +! &, c0ifac=0.001_kp & ! following Han et al, 2017 Weather and Forecasting + &, c0ifac=0.0_kp & &, dpnegcr = 150.0_kp ! &, dpnegcr = 100.0_kp ! &, dpnegcr = 200.0_kp @@ -1172,7 +1187,7 @@ SUBROUTINE CLOUD( & ! LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP, ctei LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP - logical vsmooth, do_aw + logical vsmooth, aw_scal INTEGER K, KP1, KD, NTRC, kblmx, kblmn, ntk @@ -1405,7 +1420,8 @@ SUBROUTINE CLOUD( & hmax = hol(kmax) elseif (kmax < k) then do l=kmax+1,k - if (abs(hol(kmax)-hol(l)) > half * hcrit) then +! if (abs(hol(kmax)-hol(l)) > half * hcrit) then + if (abs(hol(kmax)-hol(l)) > hcrit) then kmxb = l - 1 exit endif @@ -1435,7 +1451,6 @@ SUBROUTINE CLOUD( & endif enddo endif - ! klcl = kd1 if (kmax > kd1) then @@ -1446,7 +1461,6 @@ SUBROUTINE CLOUD( & endif enddo endif -! if (klcl == kd .or. klcl < ktem) return ! This is to handle mid-level convection from quasi-uniform h @@ -1464,7 +1478,6 @@ SUBROUTINE CLOUD( & tem = min(50.0_kp,max(10.0_kp,(prl(kmaxp1)-prl(kd))*0.10_kp)) if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii - if (kbl .ne. ii) then if (PRL(kmaxp1)-PRL(KBL) > bldmax) kbl = max(kbl,ii) endif @@ -1494,7 +1507,6 @@ SUBROUTINE CLOUD( & ! endif ! if (kbl == kblmx .and. kmax >= km1) kbl = k - 1 !!! - KPBL = KBL ELSE @@ -1504,12 +1516,10 @@ SUBROUTINE CLOUD( & KBL = min(kmax,MAX(KBL,KD+2)) KB1 = KBL - 1 !! - if (PRL(Kmaxp1)-PRL(KBL) > bldmax .or. kb1 <= kd ) then ! & .or. PRL(Kmaxp1)-PRL(KBL) < bldmin) then return endif -! ! PRIS = ONE / (PRL(KP1)-PRL(KBL)) PRISM = ONE / (PRL(Kmaxp1)-PRL(KBL)) @@ -1606,7 +1616,7 @@ SUBROUTINE CLOUD( & ENDDO ENDDO ! -! if (ntk > 0 .and. do_aw) then +! if (ntk > 0 .and. aw_scal) then if (ntk > 0) then if (rbl(ntk) > zero) then wcbase = min(two, max(wcbase, sqrt(twoo3*rbl(ntk)))) @@ -1671,7 +1681,8 @@ SUBROUTINE CLOUD( & QLL(KD ) = ALHF * GAF(KD) * QIL(KD) + ONE ! st1 = qil(kd) - st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,zero)) + st2 = c0i * st1 + if (c0ifac > 1.0e-6_kp) st2 = st2 * exp(c0ifac*min(tol(kd)-t0c,zero)) tem = c0 * (one-st1) tem2 = st2*qi0 + tem*qw0 ! @@ -1693,7 +1704,8 @@ SUBROUTINE CLOUD( & AKC(L) = one / AKT(L) ! st1 = half * (qil(l)+qil(lp1)) - st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,zero)) + st2 = c0i * st1 + if (c0ifac > 1.0e-6_kp) st2 = st2 * exp(c0ifac*min(tol(lp1)-t0c,zero)) tem = c0 * (one-st1) tem2 = st2*qi0 + tem*qw0 ! @@ -1710,6 +1722,7 @@ SUBROUTINE CLOUD( & qi00 = qi0 ii = 0 777 continue + ! ep_wfn = .false. RNN(KBL) = zero @@ -1734,7 +1747,6 @@ SUBROUTINE CLOUD( & ALM = ALHF*QIL(KD) - LTL(KD) * VTF(KD) ! HSU = HST(KD) + LTL(KD) * NU * (QOL(KD)-QST(KD)) - ! !===> VERTICAL INTEGRALS NEEDED TO COMPUTE THE ENTRAINMENT PARAMETER ! @@ -1787,10 +1799,8 @@ SUBROUTINE CLOUD( & if (tem1 > almax) tem1 = -100.0_kp if (tem2 > almax) tem2 = -100.0_kp alm = max(tem1,tem2) - endif endif - ! ! CLIP CASE: ! NON-ENTRAINIG CLOUD DETRAINS IN LOWER HALF OF TOP LAYER. @@ -1887,7 +1897,6 @@ SUBROUTINE CLOUD( & ETAI(L) = one / ETA(L) ENDDO ETAI(KBL) = one - ! !===> CLOUD WORKFUNCTION ! @@ -2046,7 +2055,6 @@ SUBROUTINE CLOUD( & TEM = max(0.05_kp, MIN(CD*200.0_kp, MAX_NEG_BOUY)) IF (.not. cnvflg .and. WFN > ACR .and. & & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. - ! !===> IF NO SOUNDING MEETS THIRD CONDITION, RETURN ! @@ -2118,7 +2126,6 @@ SUBROUTINE CLOUD( & ENDDO ENDIF - ! !===> CALCULATE GAMMAS i.e. TENDENCIES PER UNIT CLOUD BASE MASSFLUX ! Includes downdraft terms! @@ -2145,7 +2152,6 @@ SUBROUTINE CLOUD( & GMS(KD) = (DS + st1 - tem1*det*alhl-tem*alhf) * PRI(KD) GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOS + DH) - ! ! TENDENCY FOR SUSPENDED ENVIRONMENTAL ICE AND/OR LIQUID WATER ! @@ -2185,7 +2191,6 @@ SUBROUTINE CLOUD( & GMH(L) = DH * PRI(L) GMS(L) = DS * PRI(L) - ! GHD(L) = TEM5 * PRI(L) GSD(L) = (TEM5 - ALHL * TEM6) * PRI(L) @@ -2225,7 +2230,6 @@ SUBROUTINE CLOUD( & GMS(K) = GMS(K) + TEM2 GHD(K) = GHD(K) + TEM1 GSD(K) = GSD(K) + TEM2 - ! avh = avh + gmh(K)*(prs(KP1)-prs(K)) ! @@ -2241,7 +2245,7 @@ SUBROUTINE CLOUD( & ! avh = avh + tx1*(prs(l+1)-prs(l)) ENDDO - +! ! !*********************************************************************** !*********************************************************************** @@ -2304,7 +2308,6 @@ SUBROUTINE CLOUD( & ! qbl = qbl * hpert_fac ! endif - !*********************************************************************** !===> CLOUD WORKFUNCTION FOR MODIFIED SOUNDING, THEN KERNEL (AKM) @@ -2400,7 +2403,7 @@ SUBROUTINE CLOUD( & ! tx1 = one - amb * eta(kd) / (rho(kd)*wvl(kd)) ! sigf(kd) = max(zero, min(one, tx1 * tx1)) ! endif - if (do_aw) then + if (aw_scal) then tx1 = (0.2_kp / max(alm, 1.0e-5_kp)) tx2 = one - min(one, pi * tx1 * tx1 / area) @@ -2426,6 +2429,9 @@ SUBROUTINE CLOUD( & else sigf(kd:k) = one endif + + tx1 = max(1.0e-3_kp, abs(gms(kd) * onebcp * sigf(kd))) + amb = min(tx1*amb, tfrac_max*toi(kd)) / tx1 ! avt = zero avq = zero @@ -2511,7 +2517,6 @@ SUBROUTINE CLOUD( & ! enddo ! endif -! ! TX1 = zero TX2 = zero @@ -2576,7 +2581,6 @@ SUBROUTINE CLOUD( & & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778_kp )) ACTEVAP = MIN(TX1, TEM4*CLFRAC) - if (tx1 < rainmin*dt) actevap = min(tx1, potevap) ! tem4 = zero @@ -2593,7 +2597,7 @@ SUBROUTINE CLOUD( & ! ST1 = ST1 * ELOCP - TOI(L) = TOI(L) - ST1 + TOI(L) = TOI(L) - ST1 TCU(L) = TCU(L) - ST1 ENDIF ENDIF @@ -2606,7 +2610,6 @@ SUBROUTINE CLOUD( & ENDDO CUP = CUP + TX1 + DOF * AMB * sigf(kbl) ENDIF - ! ! Convective transport (mixing) of passive tracers ! @@ -2639,10 +2642,11 @@ SUBROUTINE CLOUD( & HOD(L) = HB ENDIF ENDDO - + DO L=KB1,KD,-1 HCC = HCC + (ETA(L)-ETA(L+1))*HOL(L) ENDDO + ! ! Scavenging -- fscav - fraction scavenged [km-1] ! delz - distance from the entrainment to detrainment layer [km] @@ -2690,7 +2694,7 @@ SUBROUTINE CLOUD( & RCU(L,N) = RCU(L,N) + ST1 st2 = zero endif - + ENDDO ENDDO ! Tracer loop NTRC endif @@ -3300,6 +3304,7 @@ SUBROUTINE DDRFT( & ! endif ELSE ERRQ = TX2 ! Further iteration ! + ! if (itr == itrmu .and. ERRQ > ERRMIN*10 & ! & .and. ntla == 1) ERRQ = 10.0 ENDIF @@ -3462,8 +3467,6 @@ SUBROUTINE DDRFT( & VT(1) = GMS(L-1) * QRPF(QRP(L-1)) RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) -! - ! TEM = MAX(ALM, 2.5E-4) * MAX(ETA(L), 1.0) TEM = MAX(ALM,ONE_M6) * MAX(ETA(L), ONE) ! TEM = MAX(ALM, 1.0E-5) * MAX(ETA(L), 1.0) @@ -3559,7 +3562,7 @@ SUBROUTINE DDRFT( & TEM2 = TX8 ST1 = zero ENDIF -! + st2 = tx5 TEM = ROR(L)*WVL(L) - ROR(L-1)*WVL(L-1) if (tem > zero) then @@ -3620,6 +3623,7 @@ SUBROUTINE DDRFT( & ENDIF ERRH = HOD(L) - TEM1 ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) + DOF = DDZ VT(2) = QQQ ! @@ -3678,6 +3682,7 @@ SUBROUTINE DDRFT( & ! Compute Buoyancy TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & & * onebcp + TEM1 = TEM1 * (one + NU*QOD(L)) ROR(L) = CMPOR * PRL(L) / TEM1 TEM1 = TEM1 * DOFW @@ -3689,6 +3694,7 @@ SUBROUTINE DDRFT( & TEM1 = WVL(L) WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) +! ! if (wvl(l) < zero) then ! WVL(L) = max(wvl(l), 0.1*tem1) @@ -3709,7 +3715,9 @@ SUBROUTINE DDRFT( & ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.2_kp) THEN + ROR(L) = BUD(KD) ETD(L) = zero WVL(L) = zero @@ -3878,7 +3886,6 @@ SUBROUTINE DDRFT( & if (tx5 > zero) idnm = idnm + 1 endif ENDIF - ! ! If downdraft properties are not obtainable, (i.e.solution does ! not converge) , no downdraft is assumed @@ -4095,7 +4102,7 @@ end subroutine qrabf SUBROUTINE SETVTP implicit none - real(kind=kind_phys), parameter :: vtpexp=-0.3636_kp, one=1.0_kp + real(kind=kind_phys), parameter :: vtpexp=-0.3636_kp real(kind=kind_phys) xinc,x,xmax,xmin integer jx ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/physics/rascnv.meta b/physics/rascnv.meta index f0ab36f19..4babf620d 100644 --- a/physics/rascnv.meta +++ b/physics/rascnv.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rascnv type = scheme - dependencies = + dependencies = funcphys.f90,machine.F ######################################################################## [ccpp-arg-table] @@ -422,7 +422,7 @@ standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers units = kg kg-1 - dimensions = (horizontal_loop_extent,vertical_dimension,tracer_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers_for_convective_transport) type = real kind = kind_phys intent = inout From 3f2c4e5f3278e88934ebc5119c8e20707feb9e02 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 4 Mar 2021 11:56:26 -0700 Subject: [PATCH 243/274] Make convert_dry_rho an input argument, fix a bug in the non-aerosol-aware version (nc not allocated), reduce noise written to stdout --- physics/module_mp_thompson.F90 | 11 +++--- physics/mp_thompson.F90 | 62 ++++++++++++++++++++++++++++------ physics/mp_thompson.meta | 16 +++++++++ 3 files changed, 72 insertions(+), 17 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 09bb5c939..25466f412 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -423,9 +423,7 @@ MODULE module_mp_thompson !..If SIONlib isn't used, write Thompson tables with master MPI task !.. after computing them in thompson_init -#ifndef SION LOGICAL:: thompson_table_writer -#endif !+---+ !+---+-----------------------------------------------------------------+ @@ -767,7 +765,7 @@ SUBROUTINE thompson_init(mpicomm, mpirank, mpiroot, & precomputed_tables = .false. if (mpirank==mpiroot) write(0,*) "An error occurred reading Thompson tables from disk, recalculate" end if -#else +#endif ! Standard tables are only written by master MPI task; ! (physics init cannot be called by multiple threads, ! hence no need to test for a specific thread number) @@ -776,7 +774,6 @@ SUBROUTINE thompson_init(mpicomm, mpirank, mpiroot, & else thompson_table_writer = .false. end if -#endif precomputed_tables_1: if (.not.precomputed_tables) then @@ -3847,7 +3844,7 @@ subroutine qr_acr_qg #ifndef SION if (thompson_table_writer) write_thompson_tables = .true. #endif - write(0,*) "ThompMP: computing qr_acr_qg" + if (thompson_table_writer) write(0,*) "ThompMP: computing qr_acr_qg" do n2 = 1, nbr ! vr(n2) = av_r*Dr(n2)**bv_r * DEXP(-fv_r*Dr(n2)) vr(n2) = -0.1021 + 4.932E3*Dr(n2) - 0.9551E6*Dr(n2)*Dr(n2) & @@ -4029,7 +4026,7 @@ subroutine qr_acr_qs #ifndef SION if (thompson_table_writer) write_thompson_tables = .true. #endif - write(0,*) "ThompMP: computing qr_acr_qs" + if (thompson_table_writer) write(0,*) "ThompMP: computing qr_acr_qs" do n2 = 1, nbr ! vr(n2) = av_r*Dr(n2)**bv_r * DEXP(-fv_r*Dr(n2)) vr(n2) = -0.1021 + 4.932E3*Dr(n2) - 0.9551E6*Dr(n2)*Dr(n2) & @@ -4284,7 +4281,7 @@ subroutine freezeH2O(threads) #ifndef SION if (thompson_table_writer) write_thompson_tables = .true. #endif - write(0,*) "ThompMP: computing freezeH2O" + if (thompson_table_writer) write(0,*) "ThompMP: computing freezeH2O" orho_w = 1./rho_w diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index fbfbe72a9..252944b77 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -21,7 +21,6 @@ module mp_thompson private logical :: is_initialized = .False. - logical :: convert_dry_rho = .False. contains @@ -31,6 +30,7 @@ module mp_thompson !! subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & imp_physics, imp_physics_thompson, & + convert_dry_rho, & spechum, qc, qr, qi, qs, qg, ni, nr, & is_aerosol_aware, nc, nwfa2d, nifa2d, & nwfa, nifa, tgrs, prsl, phil, area, & @@ -48,6 +48,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & integer, intent(in ) :: imp_physics integer, intent(in ) :: imp_physics_thompson ! Hydrometeors + logical, intent(in ) :: convert_dry_rho real(kind_phys), intent(inout) :: spechum(:,:) real(kind_phys), intent(inout) :: qc(:,:) real(kind_phys), intent(inout) :: qr(:,:) @@ -83,10 +84,11 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & integer, intent( out) :: errflg ! - real(kind_phys) :: qv(1:ncol,1:nlev) ! kg kg-1 (water vapor mixing ratio) - real(kind_phys) :: hgt(1:ncol,1:nlev) ! m - real(kind_phys) :: rho(1:ncol,1:nlev) ! kg m-3 - real(kind_phys) :: orho(1:ncol,1:nlev) ! m3 kg-1 + real(kind_phys) :: qv(1:ncol,1:nlev) ! kg kg-1 (water vapor mixing ratio) + real(kind_phys) :: hgt(1:ncol,1:nlev) ! m + real(kind_phys) :: rho(1:ncol,1:nlev) ! kg m-3 + real(kind_phys) :: orho(1:ncol,1:nlev) ! m3 kg-1 + real(kind_phys) :: nc_local(1:ncol,1:nlev) ! needed because nc is only allocated if is_aerosol_aware is true ! real (kind=kind_phys) :: h_01, airmass, niIN3, niCCN3 integer :: i, k @@ -134,9 +136,28 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & where(qs<0) qs = 0.0 where(qg<0) qg = 0.0 - ! Convert specific humidity to water vapor mixing ratio + !> - Convert specific humidity to water vapor mixing ratio. + !> - Also, hydrometeor variables are mass or number mixing ratio + !> - either kg of species per kg of dry air, or per kg of (dry + vapor). + qv = spechum/(1.0_kind_phys-spechum) + if (convert_dry_rho) then + qc = qc/(1.0_kind_phys-spechum) + qr = qr/(1.0_kind_phys-spechum) + qi = qi/(1.0_kind_phys-spechum) + qs = qs/(1.0_kind_phys-spechum) + qg = qg/(1.0_kind_phys-spechum) + + ni = ni/(1.0_kind_phys-spechum) + nr = nr/(1.0_kind_phys-spechum) + if (is_aerosol_aware) then + nc = nc/(1.0_kind_phys-spechum) + nwfa = nwfa/(1.0_kind_phys-spechum) + nifa = nifa/(1.0_kind_phys-spechum) + end if + end if + ! Density of moist air in kg m-3 and inverse density of air rho = 0.622*prsl/(con_rd*tgrs*(qv+0.622)) orho = 1.0/rho @@ -229,17 +250,20 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! Ensure we have 1st guess cloud droplet number where mass non-zero but no number. where(qc .LE. 0.0) nc=0.0 where(qc .GT. 0 .and. nc .LE. 0.0) nc = make_DropletNumber(qc*rho, nwfa*rho) * orho - where(qc .EQ. 0.0 .and. nc .GT. 0.0) nc=0.0 + where(qc .EQ. 0.0 .and. nc .GT. 0.0) nc = 0.0 ! Ensure non-negative aerosol number concentrations. where(nwfa .LE. 0.0) nwfa = 1.1E6 where(nifa .LE. 0.0) nifa = naIN1*0.01 + ! Copy to local array for calculating cloud effective radii below + nc_local = nc + else ! Constant droplet concentration for single moment cloud water as in ! module_mp_thompson.F90, only needed for effective radii calculation - nc = Nt_c/rho + nc_local = Nt_c/rho end if @@ -247,8 +271,8 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & if (present(re_cloud) .and. present(re_ice) .and. present(re_snow)) then ! Effective radii [m] are now intent(out), bounds applied in calc_effectRad do i = 1, ncol - call calc_effectRad (tgrs(i,:), prsl(i,:), qv(i,:), qc(i,:), & - nc(i,:), qi(i,:), ni(i,:), qs(i,:), & + call calc_effectRad (tgrs(i,:), prsl(i,:), qv(i,:), qc(i,:), & + nc_local(i,:), qi(i,:), ni(i,:), qs(i,:), & re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) do k = 1, nlev re_cloud(i,k) = MAX(re_qc_min, MIN(re_cloud(i,k), re_qc_max)) @@ -271,6 +295,22 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & return end if + if (convert_dry_rho) then + !qc = qc/(1.0_kind_phys+qv) + !qr = qr/(1.0_kind_phys+qv) + !qi = qi/(1.0_kind_phys+qv) + !qs = qs/(1.0_kind_phys+qv) + !qg = qg/(1.0_kind_phys+qv) + + ni = ni/(1.0_kind_phys+qv) + nr = nr/(1.0_kind_phys+qv) + if (is_aerosol_aware) then + nc = nc/(1.0_kind_phys+qv) + nwfa = nwfa/(1.0_kind_phys+qv) + nifa = nifa/(1.0_kind_phys+qv) + end if + end if + is_initialized = .true. end subroutine mp_thompson_init @@ -283,6 +323,7 @@ end subroutine mp_thompson_init !>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & + convert_dry_rho, & spechum, qc, qr, qi, qs, qg, ni, nr, & is_aerosol_aware, nc, nwfa, nifa, & nwfa2d, nifa2d, & @@ -303,6 +344,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(in ) :: con_g real(kind_phys), intent(in ) :: con_rd ! Hydrometeors + logical, intent(in ) :: convert_dry_rho real(kind_phys), intent(inout) :: spechum(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qc(1:ncol,1:nlev) real(kind_phys), intent(inout) :: qr(1:ncol,1:nlev) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 4cfee6afc..ed54f8d02 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -65,6 +65,14 @@ type = integer intent = in optional = F +[convert_dry_rho] + standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air + long_name = flag for converting hydrometeors from moist to dry air + units = flag + dimensions = () + type = logical + intent = in + optional = F [spechum] standard_name = water_vapor_specific_humidity long_name = water vapor specific humidity @@ -341,6 +349,14 @@ kind = kind_phys intent = in optional = F +[convert_dry_rho] + standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air + long_name = flag for converting hydrometeors from moist to dry air + units = flag + dimensions = () + type = logical + intent = in + optional = F [spechum] standard_name = water_vapor_specific_humidity_updated_by_physics long_name = water vapor specific humidity From 15f1aa751a67aa2593f1700f951265f49d735947 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 5 Mar 2021 10:15:27 -0700 Subject: [PATCH 244/274] More bugfixes for Thompson MP: set is_aerosol_aware in mp_thompson_init -> init_thompson, apply bounds after calls to calc_effectRad in radiation, set intent(out) variables in calc_effectRad --- physics/GFS_rrtmg_pre.F90 | 16 ++++++++++++---- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 11 +++++++++-- physics/module_mp_thompson.F90 | 20 +++++++++++++++++++- physics/mp_thompson.F90 | 9 +++++---- 4 files changed, 45 insertions(+), 11 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index ab488c687..fee9b8815 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -68,10 +68,13 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & use surface_perturbation, only: cdfnor ! For Thompson MP - use module_mp_thompson, only: calc_effectRad, Nt_c - use module_mp_thompson_make_number_concentrations, only: & - make_IceNumber, & - make_DropletNumber, & + use module_mp_thompson, only: calc_effectRad, Nt_c, & + re_qc_min, re_qc_max, & + re_qi_min, re_qi_max, & + re_qs_min, re_qs_max + use module_mp_thompson_make_number_concentrations, only: & + make_IceNumber, & + make_DropletNumber, & make_RainNumber implicit none @@ -779,6 +782,11 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & call calc_effectRad (tlyr(i,:), plyr(i,:)*100., qv_mp(i,:), qc_mp(i,:), & nc_mp(i,:), qi_mp(i,:), ni_mp(i,:), qs_mp(i,:), & re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, lm ) + do k=1,lm + re_cloud(i,k) = MAX(re_qc_min, MIN(re_cloud(i,k), re_qc_max)) + re_ice(i,k) = MAX(re_qi_min, MIN(re_ice(i,k), re_qi_max)) + re_snow(i,k) = MAX(re_qs_min, MIN(re_snow(i,k), re_qs_max)) + end do end do ! Scale Thompson's effective radii from meter to micron do k=1,lm diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index 58e1bddea..08cc1b292 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -8,8 +8,10 @@ module GFS_rrtmgp_thompsonmp_pre use rrtmgp_aux, only: & check_error_msg use module_mp_thompson, only: & - calc_effectRad, & - Nt_c + calc_effectRad, Nt_c, & + re_qc_min, re_qc_max, & + re_qi_min, re_qi_max, & + re_qs_min, re_qs_max use module_mp_thompson_make_number_concentrations, only: & make_IceNumber, & make_DropletNumber, & @@ -179,6 +181,11 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do call calc_effectRad (t_lay(iCol,:), p_lay(iCol,:), qv_mp(iCol,:), qc_mp(iCol,:), & nc_mp(iCol,:), qi_mp(iCol,:), ni_mp(iCol,:), qs_mp(iCol,:), & re_cloud(iCol,:), re_ice(iCol,:), re_snow(iCol,:), 1, nLev ) + do iLay = 1, nLev + re_cloud(iCol,iLay) = MAX(re_qc_min, MIN(re_cloud(iCol,iLay), re_qc_max)) + re_ice(iCol,iLay) = MAX(re_qi_min, MIN(re_ice(iCol,iLay), re_qi_max)) + re_snow(iCol,iLay) = MAX(re_qs_min, MIN(re_snow(iCol,iLay), re_qs_max)) + end do enddo ! Scale Thompson's effective radii from meter to micron diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 25466f412..8ba269388 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -438,11 +438,13 @@ MODULE module_mp_thompson !! lookup tables in Thomspson scheme. !>\section gen_thompson_init thompson_init General Algorithm !> @{ - SUBROUTINE thompson_init(mpicomm, mpirank, mpiroot, & + SUBROUTINE thompson_init(is_aerosol_aware_in, & + mpicomm, mpirank, mpiroot, & threads, errmsg, errflg) IMPLICIT NONE + LOGICAL, INTENT(IN) :: is_aerosol_aware_in INTEGER, INTENT(IN) :: mpicomm, mpirank, mpiroot INTEGER, INTENT(IN) :: threads CHARACTER(len=*), INTENT(INOUT) :: errmsg @@ -458,6 +460,16 @@ SUBROUTINE thompson_init(mpicomm, mpirank, mpiroot, & LOGICAL, PARAMETER :: precomputed_tables = .FALSE. #endif +! Set module variable is_aerosol_aware + is_aerosol_aware = is_aerosol_aware_in + if (mpirank==mpiroot) then + if (is_aerosol_aware) then + write (0,'(a)') 'Using aerosol-aware version of Thompson microphysics' + else + write (0,'(a)') 'Using non-aerosol-aware version of Thompson microphysics' + end if + end if + micro_init = .FALSE. !> - Allocate space for lookup tables (J. Michalakes 2009Jun08). @@ -5218,6 +5230,8 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & lamc = (nc(k)*am_r*g_ratio(inu_c)/rc(k))**obmr re_qc1d(k) = SNGL(0.5D0 * DBLE(3.+inu_c)/lamc) enddo + else + re_qc1d(:) = 0.0D0 endif if (has_qi) then @@ -5226,6 +5240,8 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi re_qi1d(k) = SNGL(0.5D0 * DBLE(3.+mu_i)/lami) enddo + else + re_qi1d(:) = 0.0D0 endif if (has_qs) then @@ -5266,6 +5282,8 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & smoc = a_ * smo2**b_ re_qs1d(k) = 0.5*(smoc/smob) enddo + else + re_qs1d(:) = 0.0D0 endif end subroutine calc_effectRad diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 252944b77..5d5e631f5 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -115,8 +115,9 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & end if ! Call Thompson init - call thompson_init(mpicomm=mpicomm, mpirank=mpirank, mpiroot=mpiroot, & - threads=threads, errmsg=errmsg, errflg=errflg) + call thompson_init(is_aerosol_aware_in=is_aerosol_aware, mpicomm=mpicomm, & + mpirank=mpirank, mpiroot=mpiroot, threads=threads, & + errmsg=errmsg, errflg=errflg) if (errflg /= 0) return ! For restart runs, the init is done here @@ -276,8 +277,8 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & re_cloud(i,:), re_ice(i,:), re_snow(i,:), 1, nlev) do k = 1, nlev re_cloud(i,k) = MAX(re_qc_min, MIN(re_cloud(i,k), re_qc_max)) - re_ice(i,k) = MAX(re_qi_min, MIN(re_ice(i,k), re_qi_max)) - re_snow(i,k) = MAX(re_qs_min, MIN(re_snow(i,k), re_qs_max)) + re_ice(i,k) = MAX(re_qi_min, MIN(re_ice(i,k), re_qi_max)) + re_snow(i,k) = MAX(re_qs_min, MIN(re_snow(i,k), re_qs_max)) end do end do !! Convert to micron: required for bit-for-bit identical restarts; From 8b947ba5de1de7e047df672678dde4a29c7b01ac Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 5 Mar 2021 14:46:36 -0500 Subject: [PATCH 245/274] updating MGx routines and SW main for some potential issues and fixes --- physics/m_micro.F90 | 9 ++++++ physics/micro_mg2_0.F90 | 20 ++++++------ physics/micro_mg3_0.F90 | 20 ++++++------ physics/radsw_main.F90 | 72 ++++++++++++++++++++++++++++++++--------- 4 files changed, 87 insertions(+), 34 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 77b51ed62..8e6d6698e 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -542,16 +542,19 @@ subroutine m_micro_run( im, lm, flipv, dt_i & & NCPI(I,K), qc_min) if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero + rnw(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kp), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero + snw(i,k) = zero elseif (ncps(i,k) <= nmin) then ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero + qgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif @@ -1696,16 +1699,19 @@ subroutine m_micro_run( im, lm, flipv, dt_i & QI_TOT(I,K) = QILS(I,K) + QICN(I,K) if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero + rnw(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kp), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero + snw(i,k) = zero elseif (ncps(i,k) <= nmin) then ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero + qgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif @@ -1736,16 +1742,19 @@ subroutine m_micro_run( im, lm, flipv, dt_i & ! if (rnw(i,k) <= qc_min(1)) then ncpr(i,k) = zero + rnw(i,k) = zero elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0_kp), nmin) endif if (snw(i,k) <= qc_min(2)) then ncps(i,k) = zero + snw(i,k) = zero elseif (ncps(i,k) <= nmin) then ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif if (qgl(i,k) <= qc_min(2)) then ncgl(i,k) = zero + qgl(i,k) = zero elseif (ncgl(i,k) <= nmin) then ncgl(i,k) = max(qgl(i,k) / (fourb3 * PI *RL_cub*500.0_kp), nmin) endif diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index 744b46ebc..73c46392d 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -1792,7 +1792,7 @@ subroutine micro_mg_tend ( & nnucct(i,k) = ratio * nnucct(i,k) npsacws(i,k) = ratio * npsacws(i,k) nsubc(i,k) = ratio * nsubc(i,k) - end if + endif mnuccri(i,k) = zero nnuccri(i,k) = zero @@ -1800,15 +1800,17 @@ subroutine micro_mg_tend ( & if (do_cldice) then ! freezing of rain to produce ice if mean rain size is smaller than Dcs - if (lamr(i,k) > qsmall .and. one/lamr(i,k) < Dcs) then - mnuccri(i,k) = mnuccr(i,k) - nnuccri(i,k) = nnuccr(i,k) - mnuccr(i,k) = zero - nnuccr(i,k) = zero - end if - end if + if (lamr(i,k) > qsmall) then + if (one/lamr(i,k) < Dcs) then + mnuccri(i,k) = mnuccr(i,k) + nnuccri(i,k) = nnuccr(i,k) + mnuccr(i,k) = zero + nnuccr(i,k) = zero + endif + endif + endif - end do + enddo do i=1,mgncol diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 636293b86..dde143c4d 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -2448,7 +2448,7 @@ subroutine micro_mg_tend ( & nnucct(i,k) = ratio * nnucct(i,k) npsacws(i,k) = ratio * npsacws(i,k) nsubc(i,k) = ratio * nsubc(i,k) - end if + endif mnuccri(i,k) = zero nnuccri(i,k) = zero @@ -2456,15 +2456,17 @@ subroutine micro_mg_tend ( & if (do_cldice) then ! freezing of rain to produce ice if mean rain size is smaller than Dcs - if (lamr(i,k) > qsmall .and. one/lamr(i,k) < Dcs) then - mnuccri(i,k) = mnuccr(i,k) - nnuccri(i,k) = nnuccr(i,k) - mnuccr(i,k) = zero - nnuccr(i,k) = zero - end if - end if + if (lamr(i,k) > qsmall) then + if (one/lamr(i,k) < Dcs) then + mnuccri(i,k) = mnuccr(i,k) + nnuccri(i,k) = nnuccr(i,k) + mnuccr(i,k) = zero + nnuccr(i,k) = zero + endif + endif + endif - end do + enddo do i=1,mgncol diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index 8ebbb3ab1..724ea6c6b 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -2946,8 +2946,13 @@ subroutine spcvrtc & else ! for non-conservative scattering za1 = zgam1*zgam4 + zgam2*zgam3 za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk + zrk = (zgam1 - zgam2) * (zgam1 + zgam2) + if (zrk > eps1) then + zrk = sqrt(zrk) + else + zrk = f_zero + endif + zrk2= zrk + zrk zrp = zrk * cosz zrp1 = f_one + zrp @@ -2993,7 +2998,8 @@ subroutine spcvrtc & ze1r45 = zr4*zexp1 + zr5*zexm1 ! ... collimated beam - if (ze1r45>=-eps1 .and. ze1r45<=eps1) then +! if (ze1r45>=-eps1 .and. ze1r45<=eps1) then + if (abs(ze1r45) <= eps1) then zrefb(kp) = eps1 ztrab(kp) = zexm2 else @@ -3005,7 +3011,11 @@ subroutine spcvrtc & endif ! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) + if (abs(ze1r45) >= eps1) then + zden1 = zr4 / (ze1r45 * zrkg1) + else + zden1 = f_zero + endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) @@ -3171,8 +3181,13 @@ subroutine spcvrtc & else ! for non-conservative scattering za1 = zgam1*zgam4 + zgam2*zgam3 za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk + zrk = (zgam1 - zgam2) * (zgam1 + zgam2) + if (zrk > eps1) then + zrk = sqrt(zrk) + else + zrk = f_zero + endif + zrk2= zrk + zrk zrp = zrk * cosz zrp1 = f_one + zrp @@ -3218,7 +3233,8 @@ subroutine spcvrtc & ze1r45 = zr4*zexp1 + zr5*zexm1 ! ... collimated beam - if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then +! if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then + if ( abs(ze1r45) <= eps1 ) then zrefb(kp) = eps1 ztrab(kp) = zexm2 else @@ -3230,7 +3246,11 @@ subroutine spcvrtc & endif ! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) + if (abs(ze1r45) >= eps1) then + zden1 = zr4 / (ze1r45 * zrkg1) + else + zden1 = f_zero + endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) @@ -3723,8 +3743,13 @@ subroutine spcvrtm & else ! for non-conservative scattering za1 = zgam1*zgam4 + zgam2*zgam3 za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk + zrk = (zgam1 - zgam2) * (zgam1 + zgam2) + if (zrk > eps1) then + zrk = sqrt(zrk) + else + zrk = f_zero + endif + zrk2= zrk + zrk zrp = zrk * cosz zrp1 = f_one + zrp @@ -3770,7 +3795,8 @@ subroutine spcvrtm & ze1r45 = zr4*zexp1 + zr5*zexm1 ! ... collimated beam - if (ze1r45>=-eps1 .and. ze1r45<=eps1) then +! if (ze1r45>=-eps1 .and. ze1r45<=eps1) then + if (abs(ze1r45) <= eps1) then zrefb(kp) = eps1 ztrab(kp) = zexm2 else @@ -3782,7 +3808,11 @@ subroutine spcvrtm & endif ! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) + if (abs(ze1r45) >= eps1) then + zden1 = zr4 / (ze1r45 * zrkg1) + else + zden1 = f_zero + endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) @@ -3935,8 +3965,13 @@ subroutine spcvrtm & else ! for non-conservative scattering za1 = zgam1*zgam4 + zgam2*zgam3 za2 = zgam1*zgam3 + zgam2*zgam4 - zrk = sqrt ( (zgam1 - zgam2) * (zgam1 + zgam2) ) - zrk2= 2.0 * zrk + zrk = (zgam1 - zgam2) * (zgam1 + zgam2) + if (zrk > eps1) then + zrk = sqrt(zrk) + else + zrk = f_zero + endif + zrk2= zrk + zrk zrp = zrk * cosz zrp1 = f_one + zrp @@ -3982,7 +4017,8 @@ subroutine spcvrtm & ze1r45 = zr4*zexp1 + zr5*zexm1 ! ... collimated beam - if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then +! if ( ze1r45>=-eps1 .and. ze1r45<=eps1 ) then + if ( abs(ze1r45) <= eps1 ) then zrefb(kp) = eps1 ztrab(kp) = zexm2 else @@ -3994,7 +4030,11 @@ subroutine spcvrtm & endif ! ... diffuse beam - zden1 = zr4 / (ze1r45 * zrkg1) + if (abs(ze1r45) >= eps1) then + zden1 = zr4 / (ze1r45 * zrkg1) + else + zden1 = f_zero + endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) ztrad(kp) = max(f_zero, min(f_one, zrk2*zden1 )) From 1f664cfaa1f31bc57e62d8b12af6ff7bd44f531e Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Fri, 5 Mar 2021 15:26:47 -0700 Subject: [PATCH 246/274] update GFS_phys_time_vary.scm for NoahMP init changes and UGWP v1 --- physics/GFS_phys_time_vary.scm.F90 | 481 +++++++++++++++++-- physics/GFS_phys_time_vary.scm.meta | 693 +++++++++++++++++++++++++++- 2 files changed, 1136 insertions(+), 38 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index a1acc3fa0..dabd53e94 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -2,8 +2,8 @@ !! Contains code related to GFS physics suite setup (physics part of time_vary_step) !>\defgroup mod_GFS_phys_time_vary GFS Physics Time Update -!! This module contains GFS physics time vary subroutines including ozone, stratospheric water vapor, -!! aerosol, IN&CCN and surface properties updates. +!! This module contains GFS physics time vary subroutines including ozone, stratospheric water vapor, +!! aerosol, IN&CCN and surface properties updates. !> @{ module GFS_phys_time_vary @@ -23,10 +23,19 @@ module GFS_phys_time_vary use iccn_def, only : ciplin, ccnin, ci_pres use iccninterp, only : read_cidata, setindxci, ciinterpol -#if 0 + use cires_tauamf_data, only: cires_indx_ugwp, read_tau_amf, tau_amf_interp + use cires_tauamf_data, only: tau_limb, days_limb, ugwp_taulat + !--- variables needed for calculating 'sncovr' use namelist_soilveg, only: salp_data, snupx -#endif + use set_soilveg_mod, only: set_soilveg + + ! --- needed for Noah MP init + use noahmp_tables, only: laim_table,saim_table,sla_table, & + bexp_table,smcmax_table,smcwlt_table, & + dwsat_table,dksat_table,psisat_table, & + isurban_table,isbarren_table, & + isice_table,iswater_table implicit none @@ -36,9 +45,13 @@ module GFS_phys_time_vary logical :: is_initialized = .false. - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys + real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys + real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys + real(kind=kind_phys), parameter :: missing_value = 9.99e20_kind_phys + real(kind=kind_phys), parameter :: drythresh = 1.e-4_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys + real(kind=kind_phys), parameter :: one = 1.0_kind_phys contains @@ -52,7 +65,14 @@ subroutine GFS_phys_time_vary_init ( jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, imap, jmap, & - errmsg, errflg) + do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau, & + isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & + fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & + tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& + qsnowxy, wslakexy, albdvis, albdnir, albivis, albinir, emiss, taussxy, waxy, wtxy, & + zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & + smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & + slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, nthrds, errmsg, errflg) implicit none @@ -71,12 +91,85 @@ subroutine GFS_phys_time_vary_init ( integer, intent(inout) :: jindx1_ci(:), jindx2_ci(:), iindx1_ci(:), iindx2_ci(:) real(kind_phys), intent(inout) :: ddy_ci(:), ddx_ci(:) integer, intent(inout) :: imap(:), jmap(:) - + logical, intent(in) :: do_ugwp_v1 + real(kind_phys), intent(inout) :: ddy_j1tau(:), ddy_j2tau(:) + integer, intent(inout) :: jindx1_tau(:), jindx2_tau(:) + + integer, intent(in) :: isot, ivegsrc, nlunit + real(kind_phys), intent(inout) :: sncovr(:), sncovr_ice(:) + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc + real(kind_phys), intent(in) :: min_seaice, fice(:) + real(kind_phys), intent(in) :: landfrac(:), vtype(:) + real(kind_phys), intent(inout) :: weasd(:) + + ! NoahMP - only allocated when NoahMP is used + integer, intent(in) :: lsoil, lsnow_lsm_lbound, lsnow_lsm_ubound + real(kind_phys), intent(in) :: zs(:) + real(kind_phys), intent(in) :: dzs(:) + real(kind_phys), intent(inout) :: tvxy(:) + real(kind_phys), intent(inout) :: tgxy(:) + real(kind_phys), intent(inout) :: tahxy(:) + real(kind_phys), intent(inout) :: canicexy(:) + real(kind_phys), intent(inout) :: canliqxy(:) + real(kind_phys), intent(inout) :: eahxy(:) + real(kind_phys), intent(inout) :: cmxy(:) + real(kind_phys), intent(inout) :: chxy(:) + real(kind_phys), intent(inout) :: fwetxy(:) + real(kind_phys), intent(inout) :: sneqvoxy(:) + real(kind_phys), intent(inout) :: alboldxy(:) + real(kind_phys), intent(inout) :: qsnowxy(:) + real(kind_phys), intent(inout) :: wslakexy(:) + real(kind_phys), intent(inout) :: albdvis(:) + real(kind_phys), intent(inout) :: albdnir(:) + real(kind_phys), intent(inout) :: albivis(:) + real(kind_phys), intent(inout) :: albinir(:) + real(kind_phys), intent(inout) :: emiss(:) + real(kind_phys), intent(inout) :: taussxy(:) + real(kind_phys), intent(inout) :: waxy(:) + real(kind_phys), intent(inout) :: wtxy(:) + real(kind_phys), intent(inout) :: zwtxy(:) + real(kind_phys), intent(inout) :: xlaixy(:) + real(kind_phys), intent(inout) :: xsaixy(:) + real(kind_phys), intent(inout) :: lfmassxy(:) + real(kind_phys), intent(inout) :: stmassxy(:) + real(kind_phys), intent(inout) :: rtmassxy(:) + real(kind_phys), intent(inout) :: woodxy(:) + real(kind_phys), intent(inout) :: stblcpxy(:) + real(kind_phys), intent(inout) :: fastcpxy(:) + real(kind_phys), intent(inout) :: smcwtdxy(:) + real(kind_phys), intent(inout) :: deeprechxy(:) + real(kind_phys), intent(inout) :: rechxy(:) + real(kind_phys), intent(inout) :: snowxy(:) + real(kind_phys), intent(inout) :: snicexy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: snliqxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: tsnoxy (:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: smoiseq(:,:) + real(kind_phys), intent(inout) :: zsnsoxy(:,lsnow_lsm_lbound:) + real(kind_phys), intent(inout) :: slc(:,:) + real(kind_phys), intent(inout) :: smc(:,:) + real(kind_phys), intent(inout) :: stc(:,:) + real(kind_phys), intent(in) :: tsfcl(:) + real(kind_phys), intent(in) :: snowd(:) + real(kind_phys), intent(in) :: canopy(:) + real(kind_phys), intent(in) :: tg3(:) + real(kind_phys), intent(in) :: stype(:) + real(kind_phys), intent(in) :: con_t0c + + integer, intent(in) :: nthrds character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables - integer :: i, j, ix + integer :: i, j, ix, vegtyp + real(kind_phys) :: rsnow + + !--- Noah MP + integer :: soiltyp, isnow, is, imn + real(kind=kind_phys) :: masslai, masssai, snd + real(kind=kind_phys) :: bexp, ddz, smcmax, smcwlt, dwsat, dksat, psisat + + real(kind=kind_phys), dimension(:), allocatable :: dzsno + real(kind=kind_phys), dimension(:), allocatable :: dzsnso ! Initialize CCPP error handling variables errmsg = '' @@ -153,6 +246,14 @@ subroutine GFS_phys_time_vary_init ( ! hardcoded in module iccn_def.F and GFS_typedefs.F90 endif +!> - Call tau_amf dats for ugwp_v1 + if (do_ugwp_v1) then + call read_tau_amf(me, master, errmsg, errflg) + endif + +!> - Initialize soil vegetation (needed for sncovr calculation further down) + call set_soilveg(me, isot, ivegsrc, nlunit) + !> - Call setindxoz() to initialize ozone data if (ntoz > 0) then call setindxoz (im, xlat_d, jindx1_o3, jindx2_o3, ddy_o3) @@ -178,6 +279,12 @@ subroutine GFS_phys_time_vary_init ( iindx1_ci, iindx2_ci, ddx_ci) endif +!> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that can resolve GWs + if (do_ugwp_v1) then + call cires_indx_ugwp (im, me, master, xlat_d, jindx1_tau, jindx2_tau, & + ddy_j1tau, ddy_j2tau) + endif + !--- initial calculation of maps local ix -> global i and j ix = 0 do j = 1,ny @@ -188,32 +295,319 @@ subroutine GFS_phys_time_vary_init ( enddo enddo -#if 0 - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - ! if (first_time_step) then - ! if (nint(Sfcprop%sncovr(1)) == -9999) then - ! !--- compute sncovr from existing variables - ! !--- code taken directly from read_fix.f - ! do ix = 1, im - ! Sfcprop%sncovr(ix) = 0.0 - ! if (Sfcprop%slmsk(ix) > 0.001) then - ! vegtyp = Sfcprop%vtype(ix) - ! if (vegtyp == 0) vegtyp = 7 - ! rsnow = 0.001*Sfcprop%weasd(ix)/snupx(vegtyp) - ! if (0.001*Sfcprop%weasd(ix) < snupx(vegtyp)) then - ! Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - ! else - ! Sfcprop%sncovr(ix) = 1.0 - ! endif - ! endif - ! enddo - ! ! DH* 20201104: don't forget snocvr_ice for RUC LSM (see FV3GFS_io.F90) - ! endif - ! endif -#endif + !--- if sncovr does not exist in the restart, need to create it + if (all(sncovr < zero)) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: compute sncovr from weasd and soil vegetation parameters' + !--- compute sncovr from existing variables + !--- code taken directly from read_fix.f + sncovr(:) = zero + do ix=1,im + if (landfrac(ix) >= drythresh .or. fice(ix) >= min_seaice) then + vegtyp = vtype(ix) + if (vegtyp == 0) vegtyp = 7 + rsnow = 0.001_kind_phys*weasd(ix)/snupx(vegtyp) + if (0.001_kind_phys*weasd(ix) < snupx(vegtyp)) then + sncovr(ix) = one - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) + else + sncovr(ix) = one + endif + endif + enddo + endif + + !--- For RUC LSM: create sncovr_ice from sncovr + if (lsm == lsm_ruc) then + if (all(sncovr_ice < zero)) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: fill sncovr_ice with sncovr for RUC LSM' + sncovr_ice(:) = sncovr(:) + endif + endif + + if (lsm == lsm_noahmp) then + if (all(tvxy < zero)) then + + allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) + allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) + dzsno(:) = missing_value + dzsnso(:) = missing_value + + tvxy(:) = missing_value + tgxy(:) = missing_value + tahxy(:) = missing_value + canicexy(:) = missing_value + canliqxy(:) = missing_value + eahxy(:) = missing_value + cmxy(:) = missing_value + chxy(:) = missing_value + fwetxy(:) = missing_value + sneqvoxy(:) = missing_value + alboldxy(:) = missing_value + qsnowxy(:) = missing_value + wslakexy(:) = missing_value + albdvis(:) = missing_value + albdnir(:) = missing_value + albivis(:) = missing_value + albinir(:) = missing_value + emiss(:) = missing_value + taussxy(:) = missing_value + waxy(:) = missing_value + wtxy(:) = missing_value + zwtxy(:) = missing_value + xlaixy(:) = missing_value + xsaixy(:) = missing_value + + lfmassxy(:) = missing_value + stmassxy(:) = missing_value + rtmassxy(:) = missing_value + woodxy(:) = missing_value + stblcpxy(:) = missing_value + fastcpxy(:) = missing_value + smcwtdxy(:) = missing_value + deeprechxy(:) = missing_value + rechxy(:) = missing_value + + snowxy (:) = missing_value + snicexy(:,:) = missing_value + snliqxy(:,:) = missing_value + tsnoxy (:,:) = missing_value + smoiseq(:,:) = missing_value + zsnsoxy(:,:) = missing_value + + do ix=1,im + if (landfrac(ix) >= drythresh) then + tvxy(ix) = tsfcl(ix) + tgxy(ix) = tsfcl(ix) + tahxy(ix) = tsfcl(ix) + + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tvxy(ix) = con_t0c + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tgxy(ix) = con_t0c + if (snowd(ix) > 0.01_kind_phys .and. tsfcl(ix) > con_t0c ) tahxy(ix) = con_t0c + + canicexy(ix) = 0.0_kind_phys + canliqxy(ix) = canopy(ix) + + eahxy(ix) = 2000.0_kind_phys + +! eahxy = psfc*qv/(0.622+qv); qv is mixing ratio, converted from sepcific +! humidity specific humidity /(1.0 - specific humidity) + + cmxy(ix) = zero + chxy(ix) = zero + fwetxy(ix) = zero + sneqvoxy(ix) = weasd(ix) ! mm + alboldxy(ix) = 0.65_kind_phys + qsnowxy(ix) = zero + +! if (srflag(ix) > 0.001) qsnowxy(ix) = tprcp(ix)/dtp + ! already set to 0.0 + wslakexy(ix) = zero + taussxy(ix) = zero + albdvis(ix) = 0.2_kind_phys + albdnir(ix) = 0.2_kind_phys + albivis(ix) = 0.2_kind_phys + albinir(ix) = 0.2_kind_phys + emiss(ix) = 0.95_kind_phys + + + waxy(ix) = 4900.0_kind_phys + wtxy(ix) = waxy(ix) + zwtxy(ix) = (25.0_kind_phys + 2.0_kind_phys) - waxy(ix) / 1000.0_kind_phys / 0.2_kind_phys + + vegtyp = vtype(ix) + if (vegtyp == 0) vegtyp = 7 + imn = idate(2) + + if ((vegtyp == isbarren_table) .or. (vegtyp == isice_table) .or. (vegtyp == isurban_table) .or. (vegtyp == iswater_table)) then + + xlaixy(ix) = zero + xsaixy(ix) = zero + + lfmassxy(ix) = zero + stmassxy(ix) = zero + rtmassxy(ix) = zero + + woodxy (ix) = zero + stblcpxy (ix) = zero + fastcpxy (ix) = zero + + else + + xlaixy(ix) = max(laim_table(vegtyp, imn),0.05_kind_phys) +! xsaixy(ix) = max(saim_table(vegtyp, imn),0.05) + xsaixy(ix) = max(xlaixy(ix)*0.1_kind_phys,0.05_kind_phys) + + masslai = 1000.0_kind_phys / max(sla_table(vegtyp),one) + lfmassxy(ix) = xlaixy(ix)*masslai + masssai = 1000.0_kind_phys / 3.0_kind_phys + stmassxy(ix) = xsaixy(ix)* masssai + + rtmassxy(ix) = 500.0_kind_phys + + woodxy(ix) = 500.0_kind_phys + stblcpxy(ix) = 1000.0_kind_phys + fastcpxy(ix) = 1000.0_kind_phys + + endif ! non urban ... + + if (vegtyp == isice_table) then + do is = 1,lsoil + stc(ix,is) = min(stc(ix,is),min(tg3(ix),263.15_kind_phys)) + smc(ix,is) = one + slc(ix,is) = zero + enddo + endif + + snd = snowd(ix)/1000.0_kind_phys ! go to m from snwdph + + if (weasd(ix) /= zero .and. snd == zero ) then + snd = weasd(ix)/1000.0 + endif + + if (vegtyp == 15) then ! land ice in MODIS/IGBP + if (weasd(ix) < 0.1_kind_phys) then + weasd(ix) = 0.1_kind_phys + snd = 0.01_kind_phys + endif + endif + + if (snd < 0.025_kind_phys ) then + snowxy(ix) = zero + dzsno(-2:0) = zero + elseif (snd >= 0.025_kind_phys .and. snd <= 0.05_kind_phys ) then + snowxy(ix) = -1.0_kind_phys + dzsno(0) = snd + elseif (snd > 0.05_kind_phys .and. snd <= 0.10_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.5_kind_phys*snd + dzsno(0) = 0.5_kind_phys*snd + elseif (snd > 0.10_kind_phys .and. snd <= 0.25_kind_phys ) then + snowxy(ix) = -2.0_kind_phys + dzsno(-1) = 0.05_kind_phys + dzsno(0) = snd - 0.05_kind_phys + elseif (snd > 0.25_kind_phys .and. snd <= 0.45_kind_phys ) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.5_kind_phys*(snd-0.05_kind_phys) + dzsno(0) = 0.5_kind_phys*(snd-0.05_kind_phys) + elseif (snd > 0.45_kind_phys) then + snowxy(ix) = -3.0_kind_phys + dzsno(-2) = 0.05_kind_phys + dzsno(-1) = 0.20_kind_phys + dzsno(0) = snd - 0.05_kind_phys - 0.20_kind_phys + else + errmsg = 'Error in GFS_phys_time_vary.fv3.F90: Problem with the logic assigning snow layers in Noah MP initialization' + errflg = 1 + return + endif + +! Now we have the snowxy field +! snice + snliq + tsno allocation and compute them from what we have + + tsnoxy(ix,:) = zero + snicexy(ix,:) = zero + snliqxy(ix,:) = zero + zsnsoxy(ix,:) = zero + + isnow = nint(snowxy(ix))+1 ! snowxy <=0.0, dzsno >= 0.0 + + do is = isnow,0 + tsnoxy(ix,is) = tgxy(ix) + snliqxy(ix,is) = zero + snicexy(ix,is) = one * dzsno(is) * weasd(ix)/snd + enddo +! +!zsnsoxy, all negative ? +! + do is = isnow,0 + dzsnso(is) = -dzsno(is) + enddo + + do is = 1,4 + dzsnso(is) = -dzs(is) + enddo +! +! Assign to zsnsoxy +! + zsnsoxy(ix,isnow) = dzsnso(isnow) + do is = isnow+1,4 + zsnsoxy(ix,is) = zsnsoxy(ix,is-1) + dzsnso(is) + enddo +! +! smoiseq +! Init water table related quantities here +! + soiltyp = stype(ix) + if (soiltyp /= 0) then + bexp = bexp_table(soiltyp) + smcmax = smcmax_table(soiltyp) + smcwlt = smcwlt_table(soiltyp) + dwsat = dwsat_table(soiltyp) + dksat = dksat_table(soiltyp) + psisat = -psisat_table(soiltyp) + endif + + if (vegtyp == isurban_table) then + smcmax = 0.45_kind_phys + smcwlt = 0.40_kind_phys + endif + + if ((bexp > zero) .and. (smcmax > zero) .and. (-psisat > zero)) then + do is = 1, lsoil + if ( is == 1 )then + ddz = -zs(is+1) * 0.5_kind_phys + elseif ( is < lsoil ) then + ddz = ( zs(is-1) - zs(is+1) ) * 0.5_kind_phys + else + ddz = zs(is-1) - zs(is) + endif + smoiseq(ix,is) = min(max(find_eq_smc(bexp, dwsat, dksat, ddz, smcmax),1.e-4_kind_phys),smcmax*0.99_kind_phys) + enddo + else ! bexp <= 0.0 + smoiseq(ix,1:4) = smcmax + endif ! end the bexp condition + + smcwtdxy(ix) = smcmax + deeprechxy(ix) = zero + rechxy(ix) = zero + + endif + + enddo ! ix + + deallocate(dzsno) + deallocate(dzsnso) + + endif + endif !if Noah MP cold start ends is_initialized = .true. + contains + +! +! Use newton-raphson method to find eq soil moisture +! + function find_eq_smc(bexp, dwsat, dksat, ddz, smcmax) result(smc) + implicit none + real(kind=kind_phys), intent(in) :: bexp, dwsat, dksat, ddz, smcmax + real(kind=kind_phys) :: smc + real(kind=kind_phys) :: expon, aa, bb, func, dfunc, dx + integer :: iter + ! + expon = bexp + 1. + aa = dwsat / ddz + bb = dksat / smcmax ** expon + smc = 0.5 * smcmax + ! + do iter = 1,100 + func = (smc - smcmax) * aa + bb * smc ** expon + dfunc = aa + bb * expon * smc ** bexp + dx = func / dfunc + smc = smc - dx + if ( abs (dx) < 1.e-6_kind_phys) return + enddo + end function find_eq_smc + end subroutine GFS_phys_time_vary_init !! @} @@ -228,7 +622,8 @@ subroutine GFS_phys_time_vary_timestep_init ( jindx1_o3, jindx2_o3, ddy_o3, ozpl, jindx1_h, jindx2_h, ddy_h, h2opl, & jindx1_aer, jindx2_aer, ddy_aer, iindx1_aer, iindx2_aer, ddx_aer, aer_nm, & jindx1_ci, jindx2_ci, ddy_ci, iindx1_ci, iindx2_ci, ddx_ci, in_nm, ccn_nm, & - imap, jmap, prsl, seed0, rann, errmsg, errflg) + imap, jmap, prsl, seed0, rann, do_ugwp_v1, jindx1_tau, jindx2_tau, ddy_j1tau, ddy_j2tau,& + tau_amf, errmsg, errflg) implicit none @@ -252,7 +647,11 @@ subroutine GFS_phys_time_vary_timestep_init ( real(kind_phys), intent(in) :: prsl(:,:) integer, intent(in) :: seed0 real(kind_phys), intent(inout) :: rann(:,:) - ! + + logical, intent(in) :: do_ugwp_v1 + integer, intent(in) :: jindx1_tau(:), jindx2_tau(:) + real(kind_phys), intent(in) :: ddy_j1tau(:), ddy_j2tau(:) + real(kind_phys), intent(inout) :: tau_amf(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -347,6 +746,13 @@ subroutine GFS_phys_time_vary_timestep_init ( levs, prsl, in_nm, ccn_nm) endif +!> - Call cires_indx_ugwp to read monthly-mean GW-tau diagnosed from FV3GFS-runs that resolve GW-activ + if (do_ugwp_v1) then + call tau_amf_interp(me, master, im, idate, fhour, & + jindx1_tau, jindx2_tau, & + ddy_j1tau, ddy_j2tau, tau_amf) + endif + ! Not needed for SCM: !> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs !if (nscyc > 0) then @@ -423,6 +829,11 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) if (allocated(ccnin) ) deallocate(ccnin) if (allocated(ci_pres) ) deallocate(ci_pres) + ! Deallocate UGWP-input arrays + if (allocated(ugwp_taulat)) deallocate(ugwp_taulat) + if (allocated(tau_limb )) deallocate(tau_limb) + if (allocated(days_limb )) deallocate(days_limb) + is_initialized = .false. end subroutine GFS_phys_time_vary_finalize diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index cf0b3afbd..1edaa32c8 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -1,7 +1,8 @@ [ccpp-table-properties] name = GFS_phys_time_vary type = scheme - dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f,namelist_soilveg.f,ozinterp.f90,ozne_def.f + dependencies = aerclm_def.F,aerinterp.F90,h2o_def.f,h2ointerp.f90,iccn_def.F,iccninterp.F90,machine.F,mersenne_twister.f + dependencies = namelist_soilveg.f,set_soilveg.f,ozinterp.f90,ozne_def.f,cires_tauamf_data.F90,noahmp_tables.f90 ######################################################################## [ccpp-arg-table] @@ -307,6 +308,641 @@ type = integer intent = inout optional = F +[do_ugwp_v1] + standard_name = flag_for_ugwp_version_1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[jindx1_tau] + standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index1 for weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[jindx2_tau] + standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index2 for weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddy_j1tau] + standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = inout + kind = kind_phys + optional = F +[ddy_j2tau] + standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = inout + kind = kind_phys + optional = F +[isot] + standard_name = soil_type_dataset_choice + long_name = soil type dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[ivegsrc] + standard_name = vegetation_type_dataset_choice + long_name = land use dataset choice + units = index + dimensions = () + type = integer + intent = in + optional = F +[nlunit] + standard_name = iounit_namelist + long_name = fortran unit number for file opens + units = none + dimensions = () + type = integer + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[weasd] + standard_name = water_equivalent_accumulated_snow_depth + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lsoil] + standard_name = soil_vertical_dimension + long_name = number of soil layers + units = count + dimensions = () + type = integer + intent = in + optional = F +[zs] + standard_name = depth_of_soil_levels_for_land_surface_model + long_name = depth of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = in + optional = F +[dzs] + standard_name = thickness_of_soil_levels_for_land_surface_model + long_name = thickness of soil levels for land surface model + units = m + dimensions = (soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = in + optional = F +[lsnow_lsm_lbound] + standard_name = lower_bound_of_snow_vertical_dimension_for_land_surface_model + long_name = lower bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[lsnow_lsm_ubound] + standard_name = upper_bound_of_snow_vertical_dimension_for_land_surface_model + long_name = upper bound of of snow-related arrays for land surface model + units = count + dimensions = () + type = integer + intent = in + optional = F +[tvxy] + standard_name = vegetation_temperature + long_name = vegetation temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tgxy] + standard_name = ground_temperature_for_noahmp + long_name = ground temperature for noahmp + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tahxy] + standard_name = canopy_air_temperature + long_name = canopy air temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canicexy] + standard_name = canopy_intercepted_ice_mass + long_name = canopy intercepted ice mass + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[canliqxy] + standard_name = canopy_intercepted_liquid_water + long_name = canopy intercepted liquid water + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[eahxy] + standard_name = canopy_air_vapor_pressure + long_name = canopy air vapor pressure + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cmxy] + standard_name = surface_drag_coefficient_for_momentum_for_noahmp + long_name = surface drag coefficient for momentum for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[chxy] + standard_name = surface_drag_coefficient_for_heat_and_moisture_for_noahmp + long_name = surface exchange coeff heat & moisture for noahmp + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fwetxy] + standard_name = area_fraction_of_wet_canopy + long_name = area fraction of canopy that is wetted/snowed + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sneqvoxy] + standard_name = snow_mass_at_previous_time_step + long_name = snow mass at previous time step + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[alboldxy] + standard_name = snow_albedo_at_previous_time_step + long_name = snow albedo at previous time step + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qsnowxy] + standard_name = snow_precipitation_rate_at_surface + long_name = snow precipitation rate at surface + units = mm s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wslakexy] + standard_name = lake_water_storage + long_name = lake water storage + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[taussxy] + standard_name = nondimensional_snow_age + long_name = non-dimensional snow age + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[waxy] + standard_name = water_storage_in_aquifer + long_name = water storage in aquifer + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[wtxy] + standard_name = water_storage_in_aquifer_and_saturated_soil + long_name = water storage in aquifer and saturated soil + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[zwtxy] + standard_name = water_table_depth + long_name = water table depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xlaixy] + standard_name = leaf_area_index + long_name = leaf area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[xsaixy] + standard_name = stem_area_index + long_name = stem area index + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[lfmassxy] + standard_name = leaf_mass + long_name = leaf mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stmassxy] + standard_name = stem_mass + long_name = stem mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtmassxy] + standard_name = fine_root_mass + long_name = fine root mass + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[woodxy] + standard_name = wood_mass + long_name = wood mass including woody roots + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stblcpxy] + standard_name = slow_soil_pool_mass_content_of_carbon + long_name = stable carbon in deep soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fastcpxy] + standard_name = fast_soil_pool_mass_content_of_carbon + long_name = short-lived carbon in shallow soil + units = g m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smcwtdxy] + standard_name = soil_water_content_between_soil_bottom_and_water_table + long_name = soil water content between the bottom of the soil and the water table + units = m3 m-3 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[deeprechxy] + standard_name = water_table_recharge_when_deep + long_name = recharge to or from the water table when deep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rechxy] + standard_name = water_table_recharge_when_shallow + long_name = recharge to or from the water table when shallow + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdvis] + standard_name = surface_albedo_direct_visible + long_name = direct surface albedo visible band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir] + standard_name = surface_albedo_direct_NIR + long_name = direct surface albedo NIR band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis] + standard_name = surface_albedo_diffuse_visible + long_name = diffuse surface albedo visible band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir] + standard_name = surface_albedo_diffuse_NIR + long_name = diffuse surface albedo NIR band + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss] + standard_name = surface_emissivity_lsm + long_name = surface emissivity from lsm + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snowxy] + standard_name = number_of_snow_layers + long_name = number of snow layers + units = count + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[snicexy] + standard_name = snow_layer_ice + long_name = snow layer ice + units = mm + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[snliqxy] + standard_name = snow_layer_liquid_water + long_name = snow layer liquid water + units = mm + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[tsnoxy] + standard_name = snow_temperature + long_name = snow_temperature + units = K + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:upper_bound_of_snow_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[smoiseq] + standard_name = equilibrium_soil_water_content + long_name = equilibrium soil water content + units = m3 m-3 + dimensions = (horizontal_dimension,soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[zsnsoxy] + standard_name = layer_bottom_depth_from_snow_surface + long_name = depth from the top of the snow surface at the bottom of the layer + units = m + dimensions = (horizontal_dimension,lower_bound_of_snow_vertical_dimension_for_land_surface_model:soil_vertical_dimension_for_land_surface_model) + type = real + kind = kind_phys + intent = inout + optional = F +[slc] + standard_name = volume_fraction_of_unfrozen_soil_moisture + long_name = liquid soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[smc] + standard_name = volume_fraction_of_soil_moisture + long_name = total soil moisture + units = frac + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[stc] + standard_name = soil_temperature + long_name = soil temperature + units = K + dimensions = (horizontal_dimension,soil_vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tsfcl] + standard_name = surface_skin_temperature_over_land + long_name = surface skin temperature over land + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[canopy] + standard_name = canopy_water_amount + long_name = canopy water amount + units = kg m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stype] + standard_name = soil_type_classification_real + long_name = soil type for lsm + units = index + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[nthrds] + standard_name = omp_threads + long_name = number of OpenMP threads available for physics schemes + units = count + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -442,7 +1078,7 @@ [nsswr] standard_name = number_of_timesteps_between_shortwave_radiation_calls long_name = number of timesteps between shortwave radiation calls - units = + units = dimensions = () type = integer intent = in @@ -775,6 +1411,57 @@ kind = kind_phys intent = inout optional = F +[do_ugwp_v1] + standard_name = flag_for_ugwp_version_1 + long_name = flag to activate ver 1 CIRES UGWP + units = flag + dimensions = () + type = logical + intent = in + optional = F +[jindx1_tau] + standard_name = lower_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index1 for weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[jindx2_tau] + standard_name = upper_latitude_index_of_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag_for_interpolation + long_name = index2 for weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[ddy_j1tau] + standard_name = latitude_interpolation_weight_complement_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight1 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = F +[ddy_j2tau] + standard_name = latitude_interpolation_weight_for_absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = interpolation weight2 for tau NGWs + units = none + dimensions = (horizontal_dimension) + type = real + intent = in + kind = kind_phys + optional = F +[tau_amf] + standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag + long_name = ngw_absolute_momentum_flux + units = various + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -813,4 +1500,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F From 4d8f7f4117d5695c534580bdf6350c39eb95c2ad Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 5 Mar 2021 17:30:51 -0700 Subject: [PATCH 247/274] Bugfix of my own bugfix in physics/module_mp_thompson.F90: always initialize cloud effective radii --- physics/module_mp_thompson.F90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 8ba269388..dfe31f375 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -5204,6 +5204,10 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & has_qi = .false. has_qs = .false. + re_qc1d(:) = 0.0D0 + re_qi1d(:) = 0.0D0 + re_qs1d(:) = 0.0D0 + do k = kts, kte rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) rc(k) = MAX(R1, qc1d(k)*rho(k)) @@ -5230,8 +5234,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & lamc = (nc(k)*am_r*g_ratio(inu_c)/rc(k))**obmr re_qc1d(k) = SNGL(0.5D0 * DBLE(3.+inu_c)/lamc) enddo - else - re_qc1d(:) = 0.0D0 endif if (has_qi) then @@ -5240,8 +5242,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi re_qi1d(k) = SNGL(0.5D0 * DBLE(3.+mu_i)/lami) enddo - else - re_qi1d(:) = 0.0D0 endif if (has_qs) then @@ -5282,8 +5282,6 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & smoc = a_ * smo2**b_ re_qs1d(k) = 0.5*(smoc/smob) enddo - else - re_qs1d(:) = 0.0D0 endif end subroutine calc_effectRad From a4833690876d007304276838c5470355dc634be9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 7 Mar 2021 21:28:04 -0500 Subject: [PATCH 248/274] fixing radsw_main --- physics/radsw_main.F90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/physics/radsw_main.F90 b/physics/radsw_main.F90 index 724ea6c6b..77fd61fcc 100644 --- a/physics/radsw_main.F90 +++ b/physics/radsw_main.F90 @@ -3011,10 +3011,10 @@ subroutine spcvrtc & endif ! ... diffuse beam - if (abs(ze1r45) >= eps1) then - zden1 = zr4 / (ze1r45 * zrkg1) + if (ze1r45 >= f_zero) then + zden1 = zr4 / max(eps1, ze1r45*zrkg1) else - zden1 = f_zero + zden1 = zr4 / min(-eps1, ze1r45*zrkg1) endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) @@ -3246,10 +3246,10 @@ subroutine spcvrtc & endif ! ... diffuse beam - if (abs(ze1r45) >= eps1) then - zden1 = zr4 / (ze1r45 * zrkg1) + if (ze1r45 >= f_zero) then + zden1 = zr4 / max(eps1, ze1r45*zrkg1) else - zden1 = f_zero + zden1 = zr4 / min(-eps1, ze1r45*zrkg1) endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) @@ -3808,10 +3808,10 @@ subroutine spcvrtm & endif ! ... diffuse beam - if (abs(ze1r45) >= eps1) then - zden1 = zr4 / (ze1r45 * zrkg1) + if (ze1r45 >= f_zero) then + zden1 = zr4 / max(eps1, ze1r45*zrkg1) else - zden1 = f_zero + zden1 = zr4 / min(-eps1, ze1r45*zrkg1) endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) @@ -4030,10 +4030,10 @@ subroutine spcvrtm & endif ! ... diffuse beam - if (abs(ze1r45) >= eps1) then - zden1 = zr4 / (ze1r45 * zrkg1) + if (ze1r45 >= f_zero) then + zden1 = zr4 / max(eps1, ze1r45*zrkg1) else - zden1 = f_zero + zden1 = zr4 / min(-eps1, ze1r45*zrkg1) endif zrefd(kp) = max(f_zero, min(f_one, & & zgam2*(zexp1 - zexm1)*zden1 )) From b55e3827beb90625839ef323891f9cd7db1e741d Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 9 Mar 2021 10:16:49 -0600 Subject: [PATCH 249/274] resolved the conflicts in GFS_phys_time_vary.fv3.F90 --- physics/GFS_phys_time_vary.fv3.F90 | 301 +++-------------------------- physics/rte-rrtmgp | 2 +- 2 files changed, 26 insertions(+), 277 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 801c73ad9..57d253083 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -166,9 +166,7 @@ subroutine GFS_phys_time_vary_init ( integer, intent(out) :: errflg ! Local variables - integer :: nb, nblks, nt - integer :: i, j, ix, iamin, iamax, jamin, jamax, vegtyp - logical :: non_uniform_blocks + integer :: i, j, ix, vegtyp, iamin, iamax, jamin, jamax real(kind_phys) :: rsnow !--- Noah MP @@ -188,43 +186,13 @@ subroutine GFS_phys_time_vary_init ( iamax=-999 jamin=999 jamax=-999 - nblks = size(Model%blksz) - - ! Non-uniform blocks require special handling: instead - ! of nthrds elements of the Interstitial array, there are - ! nthrds+1 elements. The extra Interstitial(nthrds+1) is - ! allocated for the smaller block length of the last block, - ! while all other elements are allocated to the maximum - ! block length (which is the same for all blocks except - ! the last block). - if (minval(Model%blksz)==maxval(Model%blksz)) then - non_uniform_blocks = .false. - else - non_uniform_blocks = .true. - end if - - ! Consistency check - number of threads passed in via the argument list - ! has to match the size of the Interstitial data type. - if (.not. non_uniform_blocks .and. nthrds/=size(Interstitial)) then - write(errmsg,'(*(a))') 'Logic error: nthrds does not match size of Interstitial variable' - errflg = 1 - return - else if (non_uniform_blocks .and. nthrds+1/=size(Interstitial)) then - write(errmsg,'(*(a))') 'Logic error: nthrds+1 does not match size of Interstitial variable ' // & - '(including extra last element for shorter blocksizes)' - errflg = 1 - return - end if -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nt,nb) & +!$OMP parallel num_threads(nthrds) default(none) & !$OMP shared (me,master,ntoz,h2o_phys,im,nx,ny,idate) & -!$OMP shared (Model,Data,Interstitial,errmsg,errflg) & -!$OMP shared (xlat_d,xlon_d,imap,jmap) & +!$OMP shared (xlat_d,xlon_d,imap,jmap,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres,ozpl) & !$OMP shared (levh2o,h2o_coeff,h2o_pres,h2opl) & -!$OMP shared (iamin, iamax, jamin, jamax) & -!$OMP shared (nblks,nthrds,non_uniform_blocks) +!$OMP shared (iamin, iamax, jamin, jamax) & !$OMP shared (iaerclm,ntrcaer,aer_nm,iflip,iccn) & !$OMP shared (jindx1_o3,jindx2_o3,ddy_o3,jindx1_h,jindx2_h,ddy_h) & !$OMP shared (jindx1_aer,jindx2_aer,ddy_aer,iindx1_aer,iindx2_aer,ddx_aer) & @@ -233,16 +201,10 @@ subroutine GFS_phys_time_vary_init ( !$OMP shared (isot,ivegsrc,nlunit,sncovr,sncovr_ice,lsm,lsm_ruc) & !$OMP shared (min_seaice,fice,landfrac,vtype,weasd,snupx,salp_data) & !$OMP private (ix,i,j,rsnow,vegtyp) -!$OMP sections - -#ifdef OPENMP - nt = omp_get_thread_num()+1 -#else - nt = 1 -#endif -======= +!$OMP sections +!$OMP section !> - Call read_o3data() to read ozone data call read_o3data (ntoz, me, master) @@ -343,28 +305,20 @@ subroutine GFS_phys_time_vary_init ( call setindxh2o (im, xlat_d, jindx1_h, jindx2_h, ddy_h) endif -!$OMP section !> - Call setindxaer() to initialize aerosols data - if (Model%iaerclm) then -!$OMP single -!!!!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call setindxaer (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_aer, & - Data(nb)%Grid%jindx2_aer, Data(nb)%Grid%ddy_aer, Data(nb)%Grid%xlon_d, & - Data(nb)%Grid%iindx1_aer, Data(nb)%Grid%iindx2_aer, Data(nb)%Grid%ddx_aer, & - Model%me, Model%master) - iamin=min(minval(Data(nb)%Grid%iindx1_aer), iamin) - iamax=max(maxval(Data(nb)%Grid%iindx2_aer), iamax) - jamin=min(minval(Data(nb)%Grid%jindx1_aer), jamin) - jamax=max(maxval(Data(nb)%Grid%jindx2_aer), jamax) - enddo -!!!!$OMP end do - call read_aerdataf (iamin, iamax, jamin, jamax, Model%me,Model%master,Model%iflip, & - Model%idate,errmsg,errflg) -!$OMP end single +!$OMP section + if (iaerclm) then + call setindxaer (im, xlat_d, jindx1_aer, & + jindx2_aer, ddy_aer, xlon_d, & + iindx1_aer, iindx2_aer, ddx_aer, & + me, master) + iamin=min(minval(iindx1_aer), iamin) + iamax=max(maxval(iindx2_aer), iamax) + jamin=min(minval(jindx1_aer), jamin) + jamax=max(maxval(jindx2_aer), jamax) endif - !$OMP section + !> - Call setindxci() to initialize IN and CCN data if (iccn == 1) then call setindxci (im, xlat_d, jindx1_ci, & @@ -422,6 +376,10 @@ subroutine GFS_phys_time_vary_init ( !$OMP end sections !$OMP end parallel + if (iaerclm) then + call read_aerdataf (iamin, iamax, jamin, jamax, me,master,iflip, & + idate,errmsg,errflg) + endif if (lsm == lsm_noahmp) then if (all(tvxy < zero)) then @@ -859,10 +817,10 @@ subroutine GFS_phys_time_vary_timestep_init ( !> - Call ciinterpol() to make IN and CCN data interpolation if (iccn == 1) then - call ciinterpol (me, im, idate, fhour, & - jindx1_ci, jindx2_ci, & - ddy_ci, iindx1_ci, & - iindx2_ci, ddx_ci, & + call ciinterpol (me, im, idate, fhour, & + jindx1_ci, jindx2_ci, & + ddy_ci, iindx1_ci, & + iindx2_ci, ddx_ci, & levs, prsl, in_nm, ccn_nm) endif @@ -957,214 +915,5 @@ subroutine GFS_phys_time_vary_finalize(errmsg, errflg) end subroutine GFS_phys_time_vary_finalize - -!> \section arg_table_GFS_phys_time_vary_run Argument Table -!! \htmlinclude GFS_phys_time_vary_run.html -!! -!>\section gen_GFS_phys_time_vary_run GFS_phys_time_vary_run General Algorithm -!> @{ - subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, errflg) - - use mersenne_twister, only: random_setseed, random_number - use machine, only: kind_phys - use GFS_typedefs, only: GFS_control_type, GFS_data_type - - implicit none - - ! Interface variables - type(GFS_data_type), intent(inout) :: Data(:) - type(GFS_control_type), intent(inout) :: Model - integer, intent(in) :: nthrds - logical, intent(in) :: first_time_step - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Local variables - real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys - real(kind=kind_phys), parameter :: con_99 = 99.0_kind_phys - real(kind=kind_phys), parameter :: con_100 = 100.0_kind_phys - - integer :: i, j, k, iseed, iskip, ix, nb, nblks, kdt_rad, vegtyp - real(kind=kind_phys) :: sec_zero, rsnow - real(kind=kind_phys) :: wrk(1) - real(kind=kind_phys) :: rannie(Model%cny) - real(kind=kind_phys) :: rndval(Model%cnx*Model%cny*Model%nrcm) - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - ! Check initialization status - if (.not.is_initialized) then - write(errmsg,'(*(a))') "Logic error: GFS_phys_time_vary_run called before GFS_phys_time_vary_init" - errflg = 1 - return - end if - - nblks = size(Model%blksz) - - !--- switch for saving convective clouds - cnvc90.f - !--- aka Ken Campana/Yu-Tai Hou legacy - if ((mod(Model%kdt,Model%nsswr) == 0) .and. (Model%lsswr)) then - !--- initialize,accumulate,convert - Model%clstp = 1100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (mod(Model%kdt,Model%nsswr) == 0) then - !--- accumulate,convert - Model%clstp = 0100 + min(Model%fhswr/con_hr,Model%fhour,con_99) - elseif (Model%lsswr) then - !--- initialize,accumulate - Model%clstp = 1100 - else - !--- accumulate - Model%clstp = 0100 - endif - -!$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nb,iskip,ix,i,j,k) & -!$OMP shared (Model,Data,iseed,wrk,rannie,rndval) & -!$OMP shared (nblks) - - !--- random number needed for RAS and old SAS and when cal_pre=.true. - ! Model%imfdeepcnv < 0 when Model%ras = .true. - if ( (Model%imfdeepcnv <= 0 .or. Model%cal_pre) .and. Model%random_clds ) then -!$OMP single - iseed = mod(con_100*sqrt(Model%fhour*con_hr),1.0d9) + Model%seed0 - call random_setseed(iseed) - call random_number(wrk) - do i = 1,Model%cnx*Model%nrcm - iseed = iseed + nint(wrk(1)*1000.0) * i - call random_setseed(iseed) - call random_number(rannie) - rndval(1+(i-1)*Model%cny:i*Model%cny) = rannie(1:Model%cny) - enddo -!$OMP end single - - do k = 1,Model%nrcm - iskip = (k-1)*Model%cnx*Model%cny -!$OMP do schedule (dynamic,1) - do nb=1,nblks - do ix=1,Model%blksz(nb) - j = Data(nb)%Tbd%jmap(ix) - i = Data(nb)%Tbd%imap(ix) - Data(nb)%Tbd%rann(ix,k) = rndval(i+Model%isc-1 + (j+Model%jsc-2)*Model%cnx + iskip) - enddo - enddo -!$OMP end do - enddo - endif ! imfdeepcnv, cal_re, random_clds - -!> - Call ozinterpol() to make ozone interpolation - if (Model%ntoz > 0) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call ozinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_o3, Data(nb)%Grid%jindx2_o3, & - Data(nb)%Tbd%ozpl, Data(nb)%Grid%ddy_o3) - enddo -!$OMP end do - endif - -!> - Call h2ointerpol() to make stratospheric water vapor data interpolation - if (Model%h2o_phys) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call h2ointerpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_h, Data(nb)%Grid%jindx2_h, & - Data(nb)%Tbd%h2opl, Data(nb)%Grid%ddy_h) - enddo -!$OMP end do - endif - -!> - Call aerinterpol() to make aerosol interpolation - if (Model%iaerclm) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call aerinterpol (Model%me, Model%master, Model%blksz(nb), & - Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_aer, Data(nb)%Grid%jindx2_aer, & - Data(nb)%Grid%ddy_aer,Data(nb)%Grid%iindx1_aer, & - Data(nb)%Grid%iindx2_aer,Data(nb)%Grid%ddx_aer, & - Model%levs,Data(nb)%Statein%prsl, & - Data(nb)%Tbd%aer_nm) - enddo -!$OMP end do - endif - -!> - Call ciinterpol() to make IN and CCN data interpolation - if (Model%iccn == 1) then -!$OMP do schedule (dynamic,1) - do nb = 1, nblks - call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & - Data(nb)%Grid%jindx1_ci, Data(nb)%Grid%jindx2_ci, & - Data(nb)%Grid%ddy_ci,Data(nb)%Grid%iindx1_ci, & - Data(nb)%Grid%iindx2_ci,Data(nb)%Grid%ddx_ci, & - Model%levs,Data(nb)%Statein%prsl, & - Data(nb)%Tbd%in_nm, Data(nb)%Tbd%ccn_nm) - enddo -!$OMP end do - endif - -!$OMP end parallel - -!> - Call gcycle() to repopulate specific time-varying surface properties for AMIP/forecast runs - if (Model%nscyc > 0) then - if (mod(Model%kdt,Model%nscyc) == 1) THEN - call gcycle (nblks, nthrds, Model, Data(:)%Grid, Data(:)%Sfcprop, Data(:)%Cldprop) - endif - endif - - !--- determine if diagnostics buckets need to be cleared - sec_zero = nint(Model%fhzero*con_hr) - if (sec_zero >= nint(max(Model%fhswr,Model%fhlwr))) then - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%rad_zero (Model) - call Data(nb)%Intdiag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - else - if (mod(Model%kdt,Model%nszero) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%phys_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - kdt_rad = nint(min(Model%fhswr,Model%fhlwr)/Model%dtp) - if (mod(Model%kdt, kdt_rad) == 1) then - do nb = 1,nblks - call Data(nb)%Intdiag%rad_zero (Model) - !!!! THIS IS THE POINT AT WHICH DIAG%ZHOUR NEEDS TO BE UPDATED - enddo - endif - endif -#if 0 - !Calculate sncovr if it was read in but empty (from FV3/io/FV3GFS_io.F90/sfc_prop_restart_read) - if (first_time_step) then - if (nint(Data(1)%Sfcprop%sncovr(1)) == -9999) then - !--- compute sncovr from existing variables - !--- code taken directly from read_fix.f - do nb = 1, nblks - do ix = 1, Model%blksz(nb) - Data(nb)%Sfcprop%sncovr(ix) = 0.0 - if (Data(nb)%Sfcprop%slmsk(ix) > 0.001) then - vegtyp = Data(nb)%Sfcprop%vtype(ix) - if (vegtyp == 0) vegtyp = 7 - rsnow = 0.001*Data(nb)%Sfcprop%weasd(ix)/snupx(vegtyp) - if (0.001*Data(nb)%Sfcprop%weasd(ix) < snupx(vegtyp)) then - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - (exp(-salp_data*rsnow) - rsnow*exp(-salp_data)) - else - Data(nb)%Sfcprop%sncovr(ix) = 1.0 - endif - endif - enddo - enddo - endif - endif -#endif - - end subroutine GFS_phys_time_vary_run -!> @} - end module GFS_phys_time_vary !> @} diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 566bee9cd..33c8a984c 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 566bee9cd6f9977e82d75d9b4964b20b1ff6163d +Subproject commit 33c8a984c17cf41be5d4c2928242e1b4239bfc40 From 22f45dde5467e51886c9bd622ee885e968ca17f0 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 9 Mar 2021 12:05:43 -0700 Subject: [PATCH 250/274] modify check for missing NoahMP input to initiate cold start in GFS_phys_time_vary.scm.F90 --- physics/GFS_phys_time_vary.scm.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index dabd53e94..a54ffa7a9 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -324,8 +324,7 @@ subroutine GFS_phys_time_vary_init ( endif if (lsm == lsm_noahmp) then - if (all(tvxy < zero)) then - + if (all(tvxy <= zero)) then allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) dzsno(:) = missing_value From fd8f925177daf5811e6998e1a48588611fee9191 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Tue, 9 Mar 2021 12:20:35 -0700 Subject: [PATCH 251/274] make cires_ugwpv1_module.F90/cires_ugwp1_init use the passed-in namelist --- physics/cires_ugwpv1_module.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/cires_ugwpv1_module.F90 b/physics/cires_ugwpv1_module.F90 index 13b7752a5..dbbd3cd2c 100644 --- a/physics/cires_ugwpv1_module.F90 +++ b/physics/cires_ugwpv1_module.F90 @@ -177,7 +177,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & real(kind=kind_phys), intent (in) :: con_pi, con_rerth character(len=64), intent (in) :: fn_nml2 - character(len=64), parameter :: fn_nml='input.nml' +! character(len=64), parameter :: fn_nml='input.nml' character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -194,15 +194,15 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & ! - if (me == master) print *, trim (fn_nml), ' GW-namelist file ' - inquire (file =trim (fn_nml) , exist = exists) + if (me == master) print *, trim (fn_nml2), ' GW-namelist file ' + inquire (file =trim (fn_nml2) , exist = exists) ! if (.not. exists) then if (me == master) & - write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' + write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml2), ' does not exist' else - open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios) + open (unit = nlunit, file = trim(fn_nml2), action = 'read', status = 'old', iostat = ios) endif rewind (nlunit) read (nlunit, nml = cires_ugwp_nml) From 51a6327cbf9f2168fcbf8f5583c8fe026d389cdc Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 11 Mar 2021 14:26:40 -0500 Subject: [PATCH 252/274] updating RAS with some minor modifications --- physics/rascnv.F90 | 72 ++++++++++++++++++++++++---------------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index 9c47144ac..e78570f34 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -8,7 +8,7 @@ module rascnv implicit none public :: rascnv_init, rascnv_run, rascnv_finalize private - logical, save :: is_initialized = .False. + logical :: is_initialized = .False. ! integer, parameter :: kp = kind_phys integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s @@ -30,9 +30,10 @@ module rascnv &, FOUR_P2=4.0e2_kp, ONE_M10=1.0e-10_kp& &, ONE_M6=1.0e-6_kp, ONE_M5=1.0e-5_kp & &, ONE_M2=1.0e-2_kp, ONE_M1=1.0e-1_kp & - &, oneolog10=one/log(10.0_kp) & - &, facmb = 0.01_kp & ! conversion factor from Pa to hPa (or mb) - &, cmb2pa = 100.0_kp ! Conversion from hPa to Pa + &, oneolog10=one/log(10.0_kp) & + &, rain_min=1.0e-13_kp & + &, facmb=0.01_kp & ! conversion factor from Pa to hPa (or mb) + &, cmb2pa=100.0_kp ! Conversion from hPa to Pa ! ! real (kind=kind_phys), parameter :: frac=0.5_kp, crtmsf=0.0_kp & real (kind=kind_phys), parameter :: frac=0.1_kp, crtmsf=0.0_kp & @@ -70,7 +71,7 @@ module rascnv ! ! For Tilting Angle Specification ! - real(kind=kind_phys), save :: REFP(6), REFR(6), TLAC(8), PLAC(8), & + real(kind=kind_phys) :: REFP(6), REFR(6), TLAC(8), PLAC(8), & TLBPL(7), drdp(5) ! DATA PLAC/100.0, 200.0, 300.0, 400.0, 500.0, 600.0, 700.0, 800.0/ @@ -78,16 +79,16 @@ module rascnv DATA REFP/500.0, 300.0, 250.0, 200.0, 150.0, 100.0/ DATA REFR/ 1.0, 2.0, 3.0, 4.0, 6.0, 8.0/ ! - real(kind=kind_phys), save :: AC(16), AD(16) + real(kind=kind_phys) :: AC(16), AD(16) ! integer, parameter :: nqrp=500001 - real(kind=kind_phys), save :: C1XQRP, C2XQRP, TBQRP(NQRP), & + real(kind=kind_phys) :: C1XQRP, C2XQRP, TBQRP(NQRP), & TBQRA(NQRP), TBQRB(NQRP) ! integer, parameter :: nvtp=10001 - real(kind=kind_phys), save :: C1XVTP, C2XVTP, TBVTP(NVTP) + real(kind=kind_phys) :: C1XVTP, C2XVTP, TBVTP(NVTP) ! - real(kind=kind_phys), save :: afc, facdt, & + real(kind=kind_phys) :: afc, facdt, & grav, cp, alhl, alhf, rgas, rkap, nu, pi, & t0c, rv, cvap, cliq, csol, ttp, eps, epsm1,& ! @@ -96,7 +97,6 @@ module rascnv deg2rad, PIINV, testmboalhl, & rvi, facw, faci, hsub, tmix, DEN - contains ! ----------------------------------------------------------------------- @@ -387,7 +387,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! integer :: nrcmax ! Maximum # of random clouds per 1200s ! Integer KCR, KFX, NCMX, NC, KTEM, I, ii, Lm1, l & - &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & + &, ntrc, ll, km1, kp1, ipt, lv, KBL, n & &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & &, kblmn, ksfc, ncrnd real(kind=kind_phys) sgcs(k) @@ -396,8 +396,8 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ! real fscav_(ntr+2) ! Fraction scavenged per km ! - fscav_ = zero ! By default no scavenging - if (ntr > 0) then + fscav_ = -999.0_kp ! By default no scavenging + if (ntr > 0 .and. fscav(1) > zero) then do i=1,ntr fscav_(i) = fscav(i) enddo @@ -476,7 +476,6 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & c0i = (psauras(1)*tem1 + psauras(2)*tem2) * tem c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem if (ccwfac == zero) ccwfac = half - ! ! ctei = .false. ! if (ctei_r(ipt) > ctei_rm) ctei = .true. @@ -511,7 +510,6 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ENDDO krmin = max(krmin,2) -! if (kdt == 1 .and. ipt == 1) write(0,*)' kblmn=',kblmn,kblmx ! if (fix_ncld_hr) then !!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 @@ -790,8 +788,6 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & IB = IC(NC) ! cloud top level index if (ib > kbl-1) cycle ! - -! !**************************************************************************** ! if (advtvd) then ! TVD flux limiter scheme for updraft ! l = ib @@ -943,6 +939,7 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & ENDDO ! End of the NC loop! ! RAINC(ipt) = rain * 0.001_kp ! Output rain is in meters + if (rainc(ipt) < rain_min) rainc(ipt) = zero ktop(ipt) = kp1 kbot(ipt) = 0 @@ -1160,9 +1157,9 @@ SUBROUTINE CLOUD( & ! &, HCRITS=2000.0_kp & ! Critical Moist Static Energy for Shallow clouds &, HCRITS=2500.0_kp & ! Critical Moist Static Energy for Shallow clouds &, pcrit_lcl=250.0_kp & ! Critical pressure difference between boundary layer top - ! layer top and lifting condensation level (hPa) -! &, hpert_fac=1.01_kp & ! Perturbation on hbl when ctei=.true. -! &, hpert_fac=1.005_kp & ! Perturbation on hbl when ctei=.true. + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01_kp !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005_kp !& ! Perturbation on hbl when ctei=.true. &, qudfac=quad_lam*half & &, shalfac=3.0_kp & ! &, qudfac=quad_lam*pt25, shalfac=3.0_kp !& ! Yogesh's @@ -1462,6 +1459,8 @@ SUBROUTINE CLOUD( & enddo endif +! if (klcl == kd .or. klcl < ktem) return + ! This is to handle mid-level convection from quasi-uniform h if (kmax < kmxb) then @@ -1507,6 +1506,7 @@ SUBROUTINE CLOUD( & ! endif ! if (kbl == kblmx .and. kmax >= km1) kbl = k - 1 !!! + KPBL = KBL ELSE @@ -1515,7 +1515,7 @@ SUBROUTINE CLOUD( & ! KBL = min(kmax,MAX(KBL,KD+2)) KB1 = KBL - 1 -!! +! if (PRL(Kmaxp1)-PRL(KBL) > bldmax .or. kb1 <= kd ) then ! & .or. PRL(Kmaxp1)-PRL(KBL) < bldmin) then return @@ -1722,7 +1722,6 @@ SUBROUTINE CLOUD( & qi00 = qi0 ii = 0 777 continue - ! ep_wfn = .false. RNN(KBL) = zero @@ -1784,7 +1783,7 @@ SUBROUTINE CLOUD( & ! clp = one st2 = hbl - hsu - +! if (tx2 == zero) then alm = - st2 / tx1 if (alm > almax) alm = -100.0_kp @@ -1799,6 +1798,7 @@ SUBROUTINE CLOUD( & if (tem1 > almax) tem1 = -100.0_kp if (tem2 > almax) tem2 = -100.0_kp alm = max(tem1,tem2) + endif endif ! @@ -2126,6 +2126,7 @@ SUBROUTINE CLOUD( & ENDDO ENDIF + ! !===> CALCULATE GAMMAS i.e. TENDENCIES PER UNIT CLOUD BASE MASSFLUX ! Includes downdraft terms! @@ -2230,6 +2231,7 @@ SUBROUTINE CLOUD( & GMS(K) = GMS(K) + TEM2 GHD(K) = GHD(K) + TEM1 GSD(K) = GSD(K) + TEM2 + ! avh = avh + gmh(K)*(prs(KP1)-prs(K)) ! @@ -2246,7 +2248,6 @@ SUBROUTINE CLOUD( & avh = avh + tx1*(prs(l+1)-prs(l)) ENDDO ! -! !*********************************************************************** !*********************************************************************** @@ -2307,7 +2308,7 @@ SUBROUTINE CLOUD( & ! hbl = hbl * hpert_fac ! qbl = qbl * hpert_fac ! endif - + !*********************************************************************** !===> CLOUD WORKFUNCTION FOR MODIFIED SOUNDING, THEN KERNEL (AKM) @@ -2389,7 +2390,6 @@ SUBROUTINE CLOUD( & AMBMAX = (PRL(KMAXP1)-PRL(KBL))*(FRACBL*GRAVCON) AMB = MAX(MIN(AMB, AMBMAX),ZERO) - !*********************************************************************** !*************************RESULTS*************************************** !*********************************************************************** @@ -2430,8 +2430,9 @@ SUBROUTINE CLOUD( & sigf(kd:k) = one endif - tx1 = max(1.0e-3_kp, abs(gms(kd) * onebcp * sigf(kd))) + tx1 = max(1.0e-6_kp, abs(gms(kd) * onebcp * sigf(kd))) amb = min(tx1*amb, tfrac_max*toi(kd)) / tx1 + ! avt = zero avq = zero @@ -2517,6 +2518,7 @@ SUBROUTINE CLOUD( & ! enddo ! endif +! ! TX1 = zero TX2 = zero @@ -2535,7 +2537,7 @@ SUBROUTINE CLOUD( & clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) cldfrd = clfrac - +! DO L=KD,KBL ! Testing on 20070926 ! for L=KD,K IF (L >= IDH .AND. DDFT) THEN @@ -2597,7 +2599,7 @@ SUBROUTINE CLOUD( & ! ST1 = ST1 * ELOCP - TOI(L) = TOI(L) - ST1 + TOI(L) = TOI(L) - ST1 TCU(L) = TCU(L) - ST1 ENDIF ENDIF @@ -2642,11 +2644,10 @@ SUBROUTINE CLOUD( & HOD(L) = HB ENDIF ENDDO - + DO L=KB1,KD,-1 HCC = HCC + (ETA(L)-ETA(L+1))*HOL(L) ENDDO - ! ! Scavenging -- fscav - fraction scavenged [km-1] ! delz - distance from the entrainment to detrainment layer [km] @@ -2694,7 +2695,7 @@ SUBROUTINE CLOUD( & RCU(L,N) = RCU(L,N) + ST1 st2 = zero endif - + ENDDO ENDDO ! Tracer loop NTRC endif @@ -3466,7 +3467,7 @@ SUBROUTINE DDRFT( & ! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 VT(1) = GMS(L-1) * QRPF(QRP(L-1)) RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) - +! ! TEM = MAX(ALM, 2.5E-4) * MAX(ETA(L), 1.0) TEM = MAX(ALM,ONE_M6) * MAX(ETA(L), ONE) ! TEM = MAX(ALM, 1.0E-5) * MAX(ETA(L), 1.0) @@ -3562,7 +3563,7 @@ SUBROUTINE DDRFT( & TEM2 = TX8 ST1 = zero ENDIF - +! st2 = tx5 TEM = ROR(L)*WVL(L) - ROR(L-1)*WVL(L-1) if (tem > zero) then @@ -3694,7 +3695,7 @@ SUBROUTINE DDRFT( & TEM1 = WVL(L) WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) -! + ! if (wvl(l) < zero) then ! WVL(L) = max(wvl(l), 0.1*tem1) @@ -3713,6 +3714,7 @@ SUBROUTINE DDRFT( & ! ERRQ = ERRQ + ABS(ERRW/MAX(WVL(L),ONE_M5)) + ! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN From f5733901180d8fe6919425c47b56aef5b7c44939 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 12 Mar 2021 16:38:07 -0700 Subject: [PATCH 253/274] physics/radlw_main.F90: apply local bounds for cloud effective radii instead of aborting the model run --- physics/radlw_main.F90 | 66 +++++++++++++++++++++--------------------- 1 file changed, 33 insertions(+), 33 deletions(-) diff --git a/physics/radlw_main.F90 b/physics/radlw_main.F90 index de8d9e973..7655e76d2 100644 --- a/physics/radlw_main.F90 +++ b/physics/radlw_main.F90 @@ -1250,7 +1250,7 @@ subroutine rrtmg_lw_run & endif !mz* HWRF: calculate taucmc with mcica - if (iovr == 4) then + if (iovr == 4) then call cldprmc(nlay, inflglw, iceflglw, liqflglw, & & cldfmc, ciwpmc, & & clwpmc, cswpmc, reicmc, relqmc, resnmc, & @@ -8854,25 +8854,25 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & abscosno(ig) = 0.0_rb elseif (iceflag .eq. 0) then - if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL' - abscoice(ig) = absice0(1) + absice0(2)/radice +! if (radice .lt. 10.0_rb) stop 'ICE RADIUS TOO SMALL' + abscoice(ig) = absice0(1) + absice0(2)/max(radice,10.0_rb) abscosno(ig) = 0.0_rb elseif (iceflag .eq. 1) then - if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop& - & 'ICE RADIUS OUT OF BOUNDS' +! if (radice .lt. 13.0_rb .or. radice .gt. 130._rb) stop& +! & 'ICE RADIUS OUT OF BOUNDS' ncbands = 5 ib = icb(ngb(ig)) - abscoice(ig) = absice1(1,ib) + absice1(2,ib)/radice + abscoice(ig) = absice1(1,ib) + absice1(2,ib)/min(max(radice,13.0_rb),130._rb) abscosno(ig) = 0.0_rb ! For iceflag=2 option, ice particle effective radius is limited to 5.0 to 131.0 microns elseif (iceflag .eq. 2) then - if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop& - & 'ICE RADIUS OUT OF BOUNDS' +! if (radice .lt. 5.0_rb .or. radice .gt. 131.0_rb) stop& +! & 'ICE RADIUS OUT OF BOUNDS' ncbands = 16 - factor = (radice - 2._rb)/3._rb + factor = (min(max(radice,5.0_rb),131._rb) - 2._rb)/3._rb index = int(factor) if (index .eq. 43) index = 42 fint = factor - float(index) @@ -8885,15 +8885,15 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & ! For iceflag=3 option, ice particle generalized effective size is limited to 5.0 to 140.0 microns elseif (iceflag .ge. 3) then - if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then - write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & - & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & - & ,ig, lay, ciwpmc(ig,lay), radice - errflg = 1 - return - end if +! if (radice .lt. 5.0_rb .or. radice .gt. 140.0_rb) then +! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +! & 'ERROR: ICE GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & +! & ,ig, lay, ciwpmc(ig,lay), radice +! errflg = 1 +! return +! end if ncbands = 16 - factor = (radice - 2._rb)/3._rb + factor = (min(max(radice,5.0_rb),140._rb) - 2._rb)/3._rb index = int(factor) if (index .eq. 46) index = 45 fint = factor - float(index) @@ -8908,15 +8908,15 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & !..Incorporate additional effects due to snow. if (cswpmc(ig,lay).gt.0.0_rb .and. iceflag .eq. 5) then radsno = resnmc(lay) - if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then - write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & - & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & - & ,ig, lay, cswpmc(ig,lay), radsno - errflg = 1 - return - end if +! if (radsno .lt. 5.0_rb .or. radsno .gt. 140.0_rb) then +! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +! & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' & +! & ,ig, lay, cswpmc(ig,lay), radsno +! errflg = 1 +! return +! end if ncbands = 16 - factor = (radsno - 2._rb)/3._rb + factor = (min(max(radsno,5.0_rb),140.0_rb) - 2._rb)/3._rb index = int(factor) if (index .eq. 46) index = 45 fint = factor - float(index) @@ -8937,14 +8937,14 @@ subroutine cldprmc(nlayers, inflag, iceflag, liqflag, cldfmc, & elseif (liqflag .eq. 1) then radliq = relqmc(lay) - if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) then - write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & -& 'ERROR: LIQUID EFFECTIVE SIZE OUT OF BOUNDS' & -& ,ig, lay, clwpmc(ig,lay), radliq - errflg = 1 - return - end if - index = int(radliq - 1.5_rb) +! if (radliq .lt. 2.5_rb .or. radliq .gt. 60._rb) then +! write(errmsg,'(a,i5,i5,f8.2,f8.2)' ) & +!& 'ERROR: LIQUID EFFECTIVE SIZE OUT OF BOUNDS' & +!& ,ig, lay, clwpmc(ig,lay), radliq +! errflg = 1 +! return +! end if + index = int(min(max(radliq,2.5_rb),60._rb) - 1.5_rb) if (index .eq. 0) index = 1 if (index .eq. 58) index = 57 fint = radliq - 1.5_rb - float(index) From c579871215ecfcc432ded8531f3a66defce4a9e6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 12 Mar 2021 16:38:40 -0700 Subject: [PATCH 254/274] Bugfix for uninitialized variable in physics/module_bl_mynn.F90 --- physics/module_bl_mynn.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/physics/module_bl_mynn.F90 b/physics/module_bl_mynn.F90 index fa892eba8..d691de909 100644 --- a/physics/module_bl_mynn.F90 +++ b/physics/module_bl_mynn.F90 @@ -2947,6 +2947,7 @@ SUBROUTINE mynn_tendencies(kts,kte, & khdz(k) = rhoz(k)*dfh(k) kmdz(k) = rhoz(k)*dfm(k) ENDDO + rhoz(kte+1)=rhoz(kte) khdz(kte+1)=rhoz(kte+1)*dfh(kte) kmdz(kte+1)=rhoz(kte+1)*dfm(kte) From b23f06a4bcdafd5effc20a20333eaa125c160ace Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 15 Mar 2021 05:42:25 -0600 Subject: [PATCH 255/274] Bugfix in physics/module_sf_noahmplsm.f90 for uninitialized variable in subroutine surrad --- physics/module_sf_noahmplsm.f90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index 567f4a0cf..54bec6de5 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -2597,6 +2597,12 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in ftid(ib) = 0. ftii(ib) = 0. if (ib.eq.1) fsun = 0. + frevd = 0. + frevi = 0. + fregd = 0. + fregi = 0. + bgap = 0. + wgap = 0. end do if(cosz <= 0) goto 100 @@ -3262,7 +3268,6 @@ subroutine twostream (parameters,ib ,ic ,vegtyp ,cosz ,vai , & ! frev(ib) = freveg freg(ib) = frebar - ! flux absorbed by vegetation fab(ib) = 1. - fre(ib) - (1.-albgrd(ib))*ftd(ib) & From b67acadf85ca69e274e24097b53efd77b75add39 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 15 Mar 2021 05:44:13 -0600 Subject: [PATCH 256/274] Bugfixes in UGWP v1 for uninitialized variable azmeti(jk-1) --- physics/cires_ugwpv1_module.F90 | 25 ++++++++++++++----------- physics/cires_ugwpv1_solv2.F90 | 19 +++++++++---------- physics/ugwpv1_gsldrag.F90 | 5 +++-- 3 files changed, 26 insertions(+), 23 deletions(-) diff --git a/physics/cires_ugwpv1_module.F90 b/physics/cires_ugwpv1_module.F90 index 13b7752a5..c8108cba2 100644 --- a/physics/cires_ugwpv1_module.F90 +++ b/physics/cires_ugwpv1_module.F90 @@ -191,16 +191,19 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & integer :: k integer :: ddd_ugwp, curday_ugwp ! integer :: version - + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! if (me == master) print *, trim (fn_nml), ' GW-namelist file ' inquire (file =trim (fn_nml) , exist = exists) ! if (.not. exists) then - if (me == master) & - write (6, *) 'separate ugwp :: namelist file: ', trim (fn_nml), ' does not exist' - + write(errmsg,'(3a)') 'cires_ugwpv1_init: namelist file: ', trim (fn_nml), ' does not exist' + errflg = 1 + return else open (unit = nlunit, file = trim(fn_nml), action = 'read', status = 'old', iostat = ios) endif @@ -209,11 +212,6 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & close (nlunit) ! - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - strsolver= knob_ugwp_orosolv curday_ugwp = jdat_gfs(1)*10000 + jdat_gfs(2)*100 +jdat_gfs(3) @@ -248,7 +246,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & ! allocate(fcor(latr), fcor2(latr) ) ! allocate( kvg(levs+1), ktg(levs+1) ) - allocate( krad(levs+1), kion(levs+1) ) + allocate( krad(levs+1), kion(levs+1) ) allocate( zkm(levs), pmb(levs) ) ! @@ -263,7 +261,12 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & ! ! find ilaunch ! - + if (knob_ugwp_palaunch gt 900.e2) then + write(errmsg,'(a,e16.7)') 'cires_ugwpv1_init: unrealistic value of knob_ugwp_palaunch', knob_ugwp_palaunch + errflg = 1 + return + endif + do k=levs, 1, -1 if (pmb(k) .gt. knob_ugwp_palaunch ) exit enddo diff --git a/physics/cires_ugwpv1_solv2.F90 b/physics/cires_ugwpv1_solv2.F90 index ee8f7bc83..afd94ff5c 100644 --- a/physics/cires_ugwpv1_solv2.F90 +++ b/physics/cires_ugwpv1_solv2.F90 @@ -267,15 +267,14 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & !=====ksrc - aum(km2:levs) = um(jl,km2:levs) - avm(km2:levs) = vm(jl,km2:levs) - atm(km2:levs) = tm(jl,km2:levs) - aqm(km2:levs) = qm(jl,km2:levs) - azmet(km2:levs) = zmet(jl,km2:levs) - aprsi(km2:levs+1) = prsi(jl,km2:levs+1) - azmeti(km2:levs+1) = zmeti(jl,km2:levs+1) + aum(1:levs) = um(jl,1:levs) + avm(1:levs) = vm(jl,1:levs) + atm(1:levs) = tm(jl,1:levs) + aqm(1:levs) = qm(jl,1:levs) + azmet(1:levs) = zmet(jl,1:levs) + aprsi(1:levs+1) = prsi(jl,1:levs+1) + azmeti(1:levs+1) = zmeti(jl,1:levs+1) - rho_src = aprsl(ksrc)*rdi/atm(ksrc) taub_ch = max(tau_ngw(jl), tau_min) taub_src = taub_ch @@ -288,8 +287,8 @@ subroutine cires_ugwpv1_ngw_solv2(mpi_id, master, im, levs, kdt, dtp, & ! do jk = km2, levs dz_meti(jk) = azmeti(jk+1)-azmeti(jk) - dz_met(jk) = azmet(jk)-azmeti(jk-1) - enddo + dz_met(jk) = azmet(jk)-azmeti(jk-1) + enddo ! --------------------------------------------- ! interface mean flow parameters launch -> levs+1 ! --------------------------------------------- diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 00fd42dbd..f473dc9bd 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -160,7 +160,7 @@ subroutine ugwpv1_gsldrag_init ( & if ( do_ugwp_v0_orog_only .or. do_ugwp_v0) then print *, ' ccpp do_ugwp_v0 active ', do_ugwp_v0 print *, ' ccpp do_ugwp_v1_orog_only active ', do_ugwp_v0_orog_only - write(errmsg,'(*(a))') " the CIRES CCPP-suite does not & + write(errmsg,'(*(a))') " the CIRES CCPP-suite does not & support schemes " errflg = 1 return @@ -171,7 +171,7 @@ subroutine ugwpv1_gsldrag_init ( & print *, ' do_ugwp_v1_w_gsldrag ', do_ugwp_v1_w_gsldrag print *, ' do_ugwp_v1_orog_only ', do_ugwp_v1_orog_only print *, ' do_gsl_drag_ls_bl ',do_gsl_drag_ls_bl - write(errmsg,'(*(a))') " the CIRES CCPP-suite intend to & + write(errmsg,'(*(a))') " the CIRES CCPP-suite intend to & support with but has Logic error" errflg = 1 return @@ -232,6 +232,7 @@ subroutine ugwpv1_gsldrag_init ( & call cires_ugwpv1_init (me, master, nlunit, logunit, jdat, con_pi, & con_rerth, fn_nml2, lonr, latr, levs, ak, bk, & con_p0, dtp, errmsg, errflg) + if (errflg/=0) return end if if (me == master) then From 8d3ed1d976949bcd9cf60fb364b6a881e9d02f25 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 15 Mar 2021 10:57:13 -0600 Subject: [PATCH 257/274] Turn on mass flux diagnostics --- physics/GFS_DCNV_generic.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index bfe97bc70..cbab52377 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -169,10 +169,10 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs dt3dt(i,k) = dt3dt(i,k) + (gt0(i,k)-save_t(i,k)) * frain du3dt(i,k) = du3dt(i,k) + (gu0(i,k)-save_u(i,k)) * frain dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k)-save_v(i,k)) * frain - -! upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) -! dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) -! det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) + ! convective mass fluxes + upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) + dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) + det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) enddo enddo if(qdiag3d) then From daca231e7f31a8e8579e9b18596444164607e447 Mon Sep 17 00:00:00 2001 From: pjpegion Date: Mon, 15 Mar 2021 19:44:20 +0000 Subject: [PATCH 258/274] Address Dom code review --- physics/GFS_rrtmg_pre.F90 | 31 +------------------------------ physics/GFS_stochastics.F90 | 20 ++++++++++---------- physics/dcyc2.f | 4 ++-- 3 files changed, 13 insertions(+), 42 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 351f9004c..4acabd8f4 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -183,7 +183,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & real(kind=kind_phys), dimension(im,lm+LTP) :: & htswc, htlwc, gcice, grain, grime, htsw0, htlw0, & rhly, tvly,qstl, vvel, clw, ciw, prslk1, tem2da, & - dzb, hzb, cldcov, deltaq, cnvc, cnvw, & + dzb, hzb, cldcov, deltaq, cnvc, cnvw, & effrl, effri, effrr, effrs, rho, orho, plyrpa ! for Thompson MP @@ -938,35 +938,6 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & ccnd(1:IM,1:LMK,1) = ccnd(1:IM,1:LMK,1) + cnvw(1:IM,1:LMK) endif -! perturb cld cover - !if (pert_clds) then - ! cldp1d(:) = 0. - ! do i=1,im - ! tmp_wt= -1*log( ( 2.0 / ( sppt_wts(i,38) ) ) - 1 ) - ! call cdfnor(tmp_wt,cdfz) - ! cldp1d(i) = cdfz - ! enddo - ! do i = 1, IM - ! do k = 1, LM - ! ! compute beta distribution parameters - ! m = cldcov(i,k+kd) - ! if (m<0.99 .AND. m > 0.01) then - ! s = sppt_amp*m*(1.-m) - ! alpha0 = m*m*(1.-m)/(s*s)-m - ! beta0 = alpha0*(1.-m)/m - ! ! compute beta distribution value corresponding - ! ! to the given percentile albPpert to use as new albedo - ! call ppfbet(cldp1d(i),alpha0,beta0,iflag,cldtmp) - ! cldcov(i,k+kd) = cldtmp - ! else - ! cldcov(i,k+kd) = m - ! endif - ! enddo ! end_do_i_loop - ! enddo ! end_do_k_loop - !endif - !print*,'after cld perts',minval(cldcov),maxval(cldcov) - - if (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_mg) then ! zhao/moorthi's prognostic cloud scheme ! or unified cloud and/or with MG microphysics diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index ab05afe5f..267f4b289 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -73,20 +73,20 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc real(kind_phys), dimension(1:im,1:km), intent(in) :: vgrs real(kind_phys), dimension(1:im,1:km), intent(in) :: tgrs real(kind_phys), dimension(1:im,1:km), intent(in) :: qgrs_wv - real(kind_phys), dimension(:,:), intent(in) :: qgrs_cw - real(kind_phys), dimension(:,:), intent(in) :: qgrs_rw - real(kind_phys), dimension(:,:), intent(in) :: qgrs_sw - real(kind_phys), dimension(:,:), intent(in) :: qgrs_iw - real(kind_phys), dimension(:,:), intent(in) :: qgrs_gl + real(kind_phys), dimension(:,:), intent(in) :: qgrs_cw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_rw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_sw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_iw + real(kind_phys), dimension(:,:), intent(in) :: qgrs_gl real(kind_phys), dimension(1:im,1:km), intent(inout) :: gu0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gv0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gt0 real(kind_phys), dimension(1:im,1:km), intent(inout) :: gq0_wv - real(kind_phys), dimension(:,:), intent(inout) :: gq0_cw - real(kind_phys), dimension(:,:), intent(inout) :: gq0_rw - real(kind_phys), dimension(:,:), intent(inout) :: gq0_sw - real(kind_phys), dimension(:,:), intent(inout) :: gq0_iw - real(kind_phys), dimension(:,:), intent(inout) :: gq0_gl + real(kind_phys), dimension(:,:), intent(inout) :: gq0_cw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_rw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_sw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_iw + real(kind_phys), dimension(:,:), intent(inout) :: gq0_gl integer, intent(in) :: ntcw integer, intent(in) :: ntrw integer, intent(in) :: ntsw diff --git a/physics/dcyc2.f b/physics/dcyc2.f index c00234ca2..f29d593a3 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -233,8 +233,8 @@ subroutine dcyc2t3_run & &, swhc, hlwc ! --- input/output: - real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt & - &, dtdtnp + real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdt + real(kind=kind_phys), dimension(:,:), intent(inout) :: dtdtnp ! --- outputs: real(kind=kind_phys), dimension(im), intent(out) :: & From 10f532cd7feb8b8a6f9a6028d8e061b2a70b2b91 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 15 Mar 2021 15:19:12 -0600 Subject: [PATCH 259/274] Bugfix in physics/cires_ugwpv1_module.F90 --- physics/cires_ugwpv1_module.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/cires_ugwpv1_module.F90 b/physics/cires_ugwpv1_module.F90 index c8108cba2..4746d61ff 100644 --- a/physics/cires_ugwpv1_module.F90 +++ b/physics/cires_ugwpv1_module.F90 @@ -261,7 +261,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & ! ! find ilaunch ! - if (knob_ugwp_palaunch gt 900.e2) then + if (knob_ugwp_palaunch > 900.e2) then write(errmsg,'(a,e16.7)') 'cires_ugwpv1_init: unrealistic value of knob_ugwp_palaunch', knob_ugwp_palaunch errflg = 1 return From 62df7ba52c8b559a7745a8e0382bf1503dd5337f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 15 Mar 2021 15:24:48 -0600 Subject: [PATCH 260/274] Adjust two tuning parameters for RUC LSM in physics/module_sf_ruclsm.F90 and physics/module_soil_pre.F90 --- physics/module_sf_ruclsm.F90 | 3 ++- physics/module_soil_pre.F90 | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index a0e74ce7a..1eceaf183 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -2586,7 +2586,8 @@ SUBROUTINE SOIL (debug_print, & ! evaporation, effects sparsely vegetated areas--> cooler during the day ! fc=max(qmin,ref*0.25) ! ! For now we'll go back to ref*0.5 - fc=max(qmin,ref*0.5) +! Replace 0.5 with 0.7 2021/03/15 + fc=max(qmin,ref*0.7) fex_fc=1. if((soilmois(1)+qmin) > fc .or. (qvatm-qvg) > 0.) then soilres = 1. diff --git a/physics/module_soil_pre.F90 b/physics/module_soil_pre.F90 index 82fe23f24..8eb5a5775 100644 --- a/physics/module_soil_pre.F90 +++ b/physics/module_soil_pre.F90 @@ -42,8 +42,8 @@ SUBROUTINE init_soil_depth_3 ( zs , dzs , num_soil_levels ) IF ( num_soil_levels .EQ. 6) THEN zs = (/ 0.00 , 0.05 , 0.20 , 0.40 , 1.60 , 3.00 /) ELSEIF ( num_soil_levels .EQ. 9) THEN - !zs = (/ 0.00 , 0.01 , 0.04 , 0.10 , 0.30, 0.60, 1.00 , 1.60, 3.00 /) - zs = (/ 0.00 , 0.05 , 0.20 , 0.40 , 0.60, 1.00, 1.60 , 2.20, 3.00 /) + zs = (/ 0.00 , 0.01 , 0.04 , 0.10 , 0.30, 0.60, 1.00 , 1.60, 3.00 /) + !zs = (/ 0.00 , 0.05 , 0.20 , 0.40 , 0.60, 1.00, 1.60 , 2.20, 3.00 /) ENDIF zs2(1) = 0. From bbec192809f8e283b79eced5d032faf45060b423 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 15 Mar 2021 15:36:53 -0600 Subject: [PATCH 261/274] Optimize initializing intent(out) variables in physics/module_sf_noahmplsm.f90 --- physics/module_sf_noahmplsm.f90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index 54bec6de5..8041d07b4 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -2583,6 +2583,10 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in mpe = 1.e-06 bgap = 0. wgap = 0. + frevd = 0. + frevi = 0. + fregd = 0. + fregi = 0. ! initialize output because solar radiation only done if cosz > 0 @@ -2597,12 +2601,6 @@ subroutine albedo (parameters,vegtyp ,ist ,ice ,nsoil , & !in ftid(ib) = 0. ftii(ib) = 0. if (ib.eq.1) fsun = 0. - frevd = 0. - frevi = 0. - fregd = 0. - fregi = 0. - bgap = 0. - wgap = 0. end do if(cosz <= 0) goto 100 From 7adf202c82d14ebecb1078bb17be85fc4abfeee8 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 16 Mar 2021 08:42:17 -0500 Subject: [PATCH 262/274] remove a space in aerinterp.F90 and aerclm_def.f --- physics/aerclm_def.F | 23 ----------------------- physics/aerinterp.F90 | 1 - 2 files changed, 24 deletions(-) delete mode 100644 physics/aerclm_def.F diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F deleted file mode 100644 index 426881fe4..000000000 --- a/physics/aerclm_def.F +++ /dev/null @@ -1,23 +0,0 @@ - module aerclm_def - use machine , only : kind_phys - implicit none - - integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=12 - integer :: latsaer, lonsaer, ntrcaer, levsw - - character*10 :: specname(ntrcaerm) - real (kind=kind_phys):: aer_time(13) - - real (kind=kind_phys), allocatable, dimension(:) :: aer_lat - real (kind=kind_phys), allocatable, dimension(:) :: aer_lon - real (kind=kind_phys), allocatable, dimension(:,:,:,:) :: aer_pres - real (kind=kind_phys), allocatable, dimension(:,:,:,:,:) :: aerin - - data aer_time/15.5, 45., 74.5, 105., 135.5, 166., 196.5, - & 227.5, 258., 288.5, 319., 349.5, 380.5/ - - data specname /'DU001','DU002','DU003','DU004','DU005', - & 'SS001','SS002','SS003','SS004','SS005','SO4', - & 'BCPHOBIC','BCPHILIC','OCPHOBIC','OCPHILIC'/ - - end module aerclm_def diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 8686bfa78..bed73c5be 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -339,7 +339,6 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& +tx2*(TEMI*TEMJ*aer_pres(I1,J1,L,n2)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n2) & +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) - ENDDO ENDDO From f34b1b0292b75a39a7452d1536f7d8646c6ed782 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 16 Mar 2021 08:50:51 -0500 Subject: [PATCH 263/274] remove aerclm_def.F in IPD and add it in CCPP --- physics/aerclm_def.F | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) create mode 100644 physics/aerclm_def.F diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F new file mode 100644 index 000000000..426881fe4 --- /dev/null +++ b/physics/aerclm_def.F @@ -0,0 +1,23 @@ + module aerclm_def + use machine , only : kind_phys + implicit none + + integer, parameter :: levsaer=72, ntrcaerm=15, timeaer=12 + integer :: latsaer, lonsaer, ntrcaer, levsw + + character*10 :: specname(ntrcaerm) + real (kind=kind_phys):: aer_time(13) + + real (kind=kind_phys), allocatable, dimension(:) :: aer_lat + real (kind=kind_phys), allocatable, dimension(:) :: aer_lon + real (kind=kind_phys), allocatable, dimension(:,:,:,:) :: aer_pres + real (kind=kind_phys), allocatable, dimension(:,:,:,:,:) :: aerin + + data aer_time/15.5, 45., 74.5, 105., 135.5, 166., 196.5, + & 227.5, 258., 288.5, 319., 349.5, 380.5/ + + data specname /'DU001','DU002','DU003','DU004','DU005', + & 'SS001','SS002','SS003','SS004','SS005','SO4', + & 'BCPHOBIC','BCPHILIC','OCPHOBIC','OCPHILIC'/ + + end module aerclm_def From bb0839e0c5db5eb320a599c37de4231c89ce3bda Mon Sep 17 00:00:00 2001 From: pjpegion Date: Thu, 18 Mar 2021 14:12:04 +0000 Subject: [PATCH 264/274] change declaration of dtdtnp in GFS_stochastics --- physics/GFS_stochastics.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index 267f4b289..b3dda08da 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -92,7 +92,7 @@ subroutine GFS_stochastics_run (im, km, kdt, delt, do_sppt, pert_mp, use_zmtnblc integer, intent(in) :: ntsw integer, intent(in) :: ntiw integer, intent(in) :: ntgl - real(kind_phys), dimension(1:im,1:km), intent(inout) :: dtdtnp + real(kind_phys), dimension(:,:), intent(inout) :: dtdtnp real(kind_phys), dimension(1:im), intent(in) :: rain real(kind_phys), dimension(1:im), intent(in) :: rainc real(kind_phys), dimension(1:im), intent(inout) :: tprcp From 96bb85e86f588de4583f29423e4c66b2fc85ac32 Mon Sep 17 00:00:00 2001 From: Xiaqiong Zhou Date: Thu, 18 Mar 2021 09:42:19 -0500 Subject: [PATCH 265/274] update GFDL_MP based on the FV3dycore 202101 upgrade --- physics/module_gfdl_cloud_microphys.F90 | 83 ++++++++++++++++++++----- 1 file changed, 67 insertions(+), 16 deletions(-) diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 5750d27fd..c21855ad4 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -47,6 +47,9 @@ module gfdl_cloud_microphys_mod public gfdl_cloud_microphys_mod_driver, gfdl_cloud_microphys_mod_init, & gfdl_cloud_microphys_mod_end, cloud_diagnosis + public wqs1, wqs2, qs_blend, wqsat_moist, wqsat2_moist + public qsmith_init, qsmith, es2_table1d, es3_table1d, esw_table1d + public setup_con, wet_bulb real :: missing_value = - 1.e10 @@ -116,7 +119,18 @@ module gfdl_cloud_microphys_mod real, parameter :: sfcrho = 1.2 !< surface air density real, parameter :: rhor = 1.e3 !< density of rain water, lin83 + ! intercept parameters + + real, parameter :: rnzr = 8.0e6 ! lin83 + real, parameter :: rnzs = 3.0e6 ! lin83 + real, parameter :: rnzg = 4.0e6 ! rh84 + real, parameter :: rnzh = 4.0e4 ! lin83 --- lmh 29 sep 17 + + ! density parameters + real, parameter :: rhoh = 0.917e3 ! lin83 --- lmh 29 sep 17 + + public rhor, rhos, rhog, rhoh, rnzr, rnzs, rnzg, rnzh real :: cracs, csacr, cgacr, cgacs, csacw, craci, csaci, cgacw, cgaci, cracw !< constants for accretions real :: acco (3, 4) !< constants for accretions real :: cssub (5), cgsub (5), crevp (5), cgfr (2), csmlt (5), cgmlt (5) @@ -283,6 +297,7 @@ module gfdl_cloud_microphys_mod logical :: use_ppm = .false. !< use ppm fall scheme logical :: mono_prof = .true. !< perform terminal fall with mono ppm scheme logical :: mp_print = .false. !< cloud microphysics debugging printout + logical :: do_hail = .false. !< use hail parameters instead of graupel ! real :: global_area = - 1. @@ -316,7 +331,7 @@ module gfdl_cloud_microphys_mod rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs + resmin, resmax, regmin, regmax, tintqs, do_hail public & mp_time, t_min, t_sub, tau_r2g, tau_smlt, tau_g2r, dw_land, dw_ocean, & @@ -330,7 +345,7 @@ module gfdl_cloud_microphys_mod rad_snow, rad_graupel, rad_rain, cld_min, use_ppm, mono_prof, & do_sedi_heat, sedi_transport, do_sedi_w, de_ice, icloud_f, irain_f, & mp_print, reiflag, rewmin, rewmax, reimin, reimax, rermin, rermax, & - resmin, resmax, regmin, regmax, tintqs + resmin, resmax, regmin, regmax, tintqs, do_hail contains @@ -1796,9 +1811,11 @@ subroutine icloud (ktop, kbot, tzk, p1, qvk, qlk, qrk, qik, qsk, qgk, dp1, & !! threshold from wsm6 scheme, Hong et al. (2004) \cite hong_et_al_2004, !! eq (13) : qi0_crt ~0.8e-4. ! ----------------------------------------------------------------------- - - qim = qi0_crt / den (k) - + if (qi0_crt < 0.) then + qim = - qi0_crt + else + qim = qi0_crt / den (k) + endif ! ----------------------------------------------------------------------- ! assuming linear subgrid vertical distribution of cloud ice ! the mismatch computation following lin et al. 1994, mwr @@ -3280,8 +3297,10 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) real, parameter :: vcons = 6.6280504 real, parameter :: vcong = 87.2382675 + real, parameter :: vconh = vcong * sqrt (rhoh / rhog) real, parameter :: norms = 942477796.076938 real, parameter :: normg = 5026548245.74367 + real, parameter :: normh = pi * rhoh * rnzh real, dimension (ktop:kbot) :: qden, tc, rhof @@ -3346,10 +3365,19 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) ! ----------------------------------------------------------------------- !> - graupel: ! ----------------------------------------------------------------------- - if (const_vg) then vtg (:) = vg_fac ! 2. else + if (do_hail) then + do k = ktop, kbot + if (qg (k) < thg) then + vtg (k) = vf_min + else + vtg (k) = vg_fac * vconh * rhof (k) * sqrt (sqrt (sqrt (qg (k) * den (k) / normh))) + vtg (k) = min (vg_max, max (vf_min, vtg (k))) + endif + enddo + else do k = ktop, kbot if (qg (k) < thg) then vtg (k) = vf_min @@ -3359,6 +3387,7 @@ subroutine fall_speed (ktop, kbot, den, qs, qi, qg, ql, tk, vts, vti, vtg) endif enddo endif + endif end subroutine fall_speed @@ -3382,9 +3411,9 @@ subroutine setupm ! intercept parameters - real, parameter :: rnzr = 8.0e6 ! lin83 - real, parameter :: rnzs = 3.0e6 ! lin83 - real, parameter :: rnzg = 4.0e6 ! rh84 +! real, parameter :: rnzr = 8.0e6 ! lin83 +! real, parameter :: rnzs = 3.0e6 ! lin83 +! real, parameter :: rnzg = 4.0e6 ! rh84 ! density parameters @@ -3427,8 +3456,13 @@ subroutine setupm cracs = pisq * rnzr * rnzs * rhos csacr = pisq * rnzr * rnzs * rhor - cgacr = pisq * rnzr * rnzg * rhor - cgacs = pisq * rnzg * rnzs * rhos + if (do_hail) then + cgacr = pisq * rnzr * rnzh * rhor + cgacs = pisq * rnzh * rnzs * rhos + else + cgacr = pisq * rnzr * rnzg * rhor + cgacs = pisq * rnzg * rnzs * rhos + endif cgacs = cgacs * c_pgacs ! act: 1 - 2:racs (s - r) ; 3 - 4:sacr (r - s) ; @@ -3436,7 +3470,11 @@ subroutine setupm act (1) = pie * rnzs * rhos act (2) = pie * rnzr * rhor - act (6) = pie * rnzg * rhog + if (do_hail) then + act (6) = pie * rnzh * rhoh + else + act (6) = pie * rnzg * rhog + endif act (3) = act (2) act (4) = act (1) act (5) = act (2) @@ -3457,7 +3495,11 @@ subroutine setupm craci = pie * rnzr * alin * gam380 / (4. * act (2) ** 0.95) csaci = csacw * c_psaci - cgacw = pie * rnzg * gam350 * gcon / (4. * act (6) ** 0.875) + if (do_hail) then + cgacw = pie * rnzh * gam350 * gcon / (4. * act (6) ** 0.875) + else + cgacw = pie * rnzg * gam350 * gcon / (4. * act (6) ** 0.875) + endif ! cgaci = cgacw * 0.1 ! sjl, may 28, 2012 @@ -3470,7 +3512,11 @@ subroutine setupm ! subl and revp: five constants for three separate processes cssub (1) = 2. * pie * vdifu * tcond * rvgas * rnzs - cgsub (1) = 2. * pie * vdifu * tcond * rvgas * rnzg + if (do_hail) then + cgsub (1) = 2. * pie * vdifu * tcond * rvgas * rnzh + else + cgsub (1) = 2. * pie * vdifu * tcond * rvgas * rnzg + endif crevp (1) = 2. * pie * vdifu * tcond * rvgas * rnzr cssub (2) = 0.78 / sqrt (act (1)) cgsub (2) = 0.78 / sqrt (act (6)) @@ -3498,8 +3544,13 @@ subroutine setupm ! gmlt: five constants - cgmlt (1) = 2. * pie * tcond * rnzg / hltf - cgmlt (2) = 2. * pie * vdifu * rnzg * hltc / hltf + if (do_hail) then + cgmlt (1) = 2. * pie * tcond * rnzh / hltf + cgmlt (2) = 2. * pie * vdifu * rnzh * hltc / hltf + else + cgmlt (1) = 2. * pie * tcond * rnzg / hltf + cgmlt (2) = 2. * pie * vdifu * rnzg * hltc / hltf + endif cgmlt (3) = cgsub (2) cgmlt (4) = cgsub (3) cgmlt (5) = ch2o / hltf From 02ee43319fd2160628c1cbf32a802e5cecb2376f Mon Sep 17 00:00:00 2001 From: "xiaqiong.zhou" Date: Sat, 27 Mar 2021 01:05:10 +0000 Subject: [PATCH 266/274] Comment out public statements not used --- physics/module_gfdl_cloud_microphys.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index c21855ad4..6cc9275dc 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -47,9 +47,9 @@ module gfdl_cloud_microphys_mod public gfdl_cloud_microphys_mod_driver, gfdl_cloud_microphys_mod_init, & gfdl_cloud_microphys_mod_end, cloud_diagnosis - public wqs1, wqs2, qs_blend, wqsat_moist, wqsat2_moist - public qsmith_init, qsmith, es2_table1d, es3_table1d, esw_table1d - public setup_con, wet_bulb +! public wqs1, wqs2, qs_blend, wqsat_moist, wqsat2_moist +! public qsmith_init, qsmith, es2_table1d, es3_table1d, esw_table1d +! public setup_con, wet_bulb real :: missing_value = - 1.e10 From e47c6acbc503e22178dcde84995dada2287d80a4 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 30 Mar 2021 08:08:21 -0600 Subject: [PATCH 267/274] Add logic to convert dry/moist mixing ratios based on flag to GFS_suite_interstitial_4_run --- physics/GFS_suite_interstitial.F90 | 85 ++++++++++++++++++----------- physics/GFS_suite_interstitial.meta | 8 +++ 2 files changed, 60 insertions(+), 33 deletions(-) diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index 4af19296a..a0361b6e3 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -155,11 +155,10 @@ end subroutine GFS_suite_interstitial_2_init subroutine GFS_suite_interstitial_2_finalize() end subroutine GFS_suite_interstitial_2_finalize -#if 0 + !> \section arg_table_GFS_suite_interstitial_2_run Argument Table !! \htmlinclude GFS_suite_interstitial_2_run.html !! -#endif subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplflx, flag_cice, shal_cnv, old_monin, mstrat, & do_shoc, frac_grid, imfshalcnv, dtf, xcosz, adjsfcdsw, adjsfcdlw, cice, pgr, ulwsfc_cice, lwhd, htrsw, htrlw, xmu, ctei_rm, & work1, work2, prsi, tgrs, prsl, qgrs_water_vapor, qgrs_cloud_water, cp, hvap, prslk, suntim, adjsfculw, adjsfculw_lnd, & @@ -475,11 +474,9 @@ end subroutine GFS_suite_interstitial_3_init subroutine GFS_suite_interstitial_3_finalize() end subroutine GFS_suite_interstitial_3_finalize -#if 0 !> \section arg_table_GFS_suite_interstitial_3_run Argument Table !! \htmlinclude GFS_suite_interstitial_3_run.html !! -#endif subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, & @@ -513,7 +510,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & real(kind=kind_phys), dimension(im, levs), intent(inout) :: rhc, save_qc ! save_qi is not allocated for Zhao-Carr MP real(kind=kind_phys), dimension(:, :), intent(inout) :: save_qi - real(kind=kind_phys), dimension(:, :), intent(inout) :: save_tcp ! ONLY ALLOCATE FOR THOMPSON! TODO + real(kind=kind_phys), dimension(:, :), intent(inout) :: save_tcp real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw character(len=*), intent(out) :: errmsg @@ -652,7 +649,7 @@ end subroutine GFS_suite_interstitial_4_finalize !! subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & - imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, dtf, save_qc, save_qi, con_pi, & + imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi, & gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, errmsg, errflg) use machine, only: kind_phys @@ -666,7 +663,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf - logical, intent(in) :: ltaerosol, cplchm + logical, intent(in) :: ltaerosol, cplchm, convert_dry_rho real(kind=kind_phys), intent(in) :: con_pi, dtf real(kind=kind_phys), dimension(im,levs), intent(in) :: save_qc @@ -739,33 +736,55 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to enddo if (imp_physics == imp_physics_thompson .and. (ntlnc>0 .or. ntinc>0)) then - do k=1,levs - do i=1,im - !> - Convert specific humidity to dry mixing ratio - qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k)) - !> - Density of air in kg m-3 and inverse density - rho = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+0.622)) - orho = one/rho - if (ntlnc>0) then - !> - Convert moist mixing ratio to dry mixing ratio - qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k)) - !> - Convert number concentration from moist to dry - nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k)) - nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) - !> - Convert number concentrations from dry to moist - gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k)) - endif - if (ntinc>0) then - !> - Convert moist mixing ratio to dry mixing ratio - qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k)) - !> - Convert number concentration from moist to dry - ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) - ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) - !> - Convert number concentrations from dry to moist - gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k)) - endif + if_convert_dry_rho: if (convert_dry_rho) then + do k=1,levs + do i=1,im + !> - Convert specific humidity to dry mixing ratio + qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k)) + !> - Density of air in kg m-3 and inverse density + rho = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+0.622)) + orho = one/rho + if (ntlnc>0) then + !> - Convert moist mixing ratio to dry mixing ratio + qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k)) + !> - Convert number concentration from moist to dry + nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k)) + nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + !> - Convert number concentrations from dry to moist + gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k)) + endif + if (ntinc>0) then + !> - Convert moist mixing ratio to dry mixing ratio + qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k)) + !> - Convert number concentration from moist to dry + ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) + ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + !> - Convert number concentrations from dry to moist + gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k)) + endif + enddo enddo - enddo + else + do k=1,levs + do i=1,im + !> - Density of air in kg m-3 and inverse density + rho = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(spechum(i,k)+0.622)) + orho = one/rho + if (ntlnc>0) then + !> - Update cloud water mixing ratio + qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) + !> - Update cloud water number concentration + gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho) + endif + if (ntinc>0) then + !> - Update cloud ice mixing ratio + qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) + !> - Update cloud ice number concentration + gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho) + endif + enddo + enddo + end if if_convert_dry_rho endif else diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index c09d02434..b7c1c2f67 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1769,6 +1769,14 @@ type = integer intent = in optional = F +[convert_dry_rho] + standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air + long_name = flag for converting hydrometeors from moist to dry air + units = flag + dimensions = () + type = logical + intent = in + optional = F [dtf] standard_name = time_step_for_dynamics long_name = dynamics timestep From 92e0702a1010345e59cc5102f596af250d5910fe Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 30 Mar 2021 08:10:51 -0600 Subject: [PATCH 268/274] Revert CODEOWNERS change --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index b6c597371..0d5230f89 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @DomHeinzeller +* @climbfuji @llpcarson @grantfirl @JulieSchramm # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From 252d0d38d75330a6e267dd4cd6d08a28c3abb917 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 30 Mar 2021 14:08:44 -0600 Subject: [PATCH 269/274] Bugfix in cires_ugwpv1_module.F90: add missing INTERNAL_FILE_NML logic --- physics/cires_ugwpv1_module.F90 | 14 ++++++++------ physics/ugwpv1_gsldrag.F90 | 4 ++-- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/physics/cires_ugwpv1_module.F90 b/physics/cires_ugwpv1_module.F90 index c1fd53523..f5fe7f2ec 100644 --- a/physics/cires_ugwpv1_module.F90 +++ b/physics/cires_ugwpv1_module.F90 @@ -143,8 +143,8 @@ module cires_ugwpv1_module !----------------------------------------------------------------------------------- subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & - con_rerth, fn_nml2, lonr, latr, levs, ak, bk, pref, dtp, & - errmsg, errflg) + con_rerth, fn_nml2, input_nml_file, lonr, latr, levs, ak, bk, & + pref, dtp, errmsg, errflg) ! ! input_nml_file ='input.nml'=fn_nml ..... OLD_namelist and cdmvgwd(4) Corrected Bug Oct 4 ! @@ -177,7 +177,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & real(kind=kind_phys), intent (in) :: con_pi, con_rerth character(len=64), intent (in) :: fn_nml2 -! character(len=64), parameter :: fn_nml='input.nml' + character(len=*), intent (in) :: input_nml_file(:) character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -187,7 +187,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & integer :: ios logical :: exists - integer :: ncid, iernc, vid, dimid, status + integer :: ncid, iernc, vid, dimid, status integer :: k integer :: ddd_ugwp, curday_ugwp ! integer :: version @@ -196,7 +196,9 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & errmsg = '' errflg = 0 -! +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml = cires_ugwp_nml) +#else if (me == master) print *, trim (fn_nml2), ' GW-namelist file ' inquire (file =trim (fn_nml2) , exist = exists) ! @@ -210,7 +212,7 @@ subroutine cires_ugwpv1_init (me, master, nlunit, logunit, jdat_gfs, con_pi, & rewind (nlunit) read (nlunit, nml = cires_ugwp_nml) close (nlunit) -! +#endif strsolver= knob_ugwp_orosolv diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index f473dc9bd..649d994a8 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -230,8 +230,8 @@ subroutine ugwpv1_gsldrag_init ( & if ( do_ugwp_v1 ) then call cires_ugwpv1_init (me, master, nlunit, logunit, jdat, con_pi, & - con_rerth, fn_nml2, lonr, latr, levs, ak, bk, & - con_p0, dtp, errmsg, errflg) + con_rerth, fn_nml2, input_nml_file, lonr, latr, & + levs, ak, bk, con_p0, dtp, errmsg, errflg) if (errflg/=0) return end if From 5dbb259348ecd70f2e10f6aab57d42c303c11c1c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 30 Mar 2021 15:39:30 -0600 Subject: [PATCH 270/274] Cleanup: use con_eps = con_rd/con_rv instead of 0.622 in many places --- physics/GFS_phys_time_vary.fv3.F90 | 3 -- physics/GFS_phys_time_vary.scm.F90 | 3 -- physics/GFS_rrtmg_pre.F90 | 10 ++--- physics/GFS_rrtmg_pre.meta | 2 +- physics/GFS_rrtmgp_thompsonmp_pre.F90 | 7 ++-- physics/GFS_rrtmgp_thompsonmp_pre.meta | 55 +++++++++++++++----------- physics/GFS_suite_interstitial.F90 | 8 ++-- physics/GFS_suite_interstitial.meta | 9 +++++ physics/gcm_shoc.F90 | 14 ++++--- physics/gcm_shoc.meta | 9 +++++ physics/gfdl_cloud_microphys.F90 | 6 +-- physics/gfdl_cloud_microphys.meta | 9 +++++ physics/gfdl_sfc_layer.F90 | 14 ++++--- physics/gfdl_sfc_layer.meta | 6 +++ physics/mp_thompson.F90 | 15 +++---- physics/mp_thompson.meta | 18 +++++++++ 16 files changed, 124 insertions(+), 64 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 57d253083..0cc6a66b8 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -446,9 +446,6 @@ subroutine GFS_phys_time_vary_init ( eahxy(ix) = 2000.0_kind_phys -! eahxy = psfc*qv/(0.622+qv); qv is mixing ratio, converted from sepcific -! humidity specific humidity /(1.0 - specific humidity) - cmxy(ix) = zero chxy(ix) = zero fwetxy(ix) = zero diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index a54ffa7a9..fb46de2bd 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -387,9 +387,6 @@ subroutine GFS_phys_time_vary_init ( eahxy(ix) = 2000.0_kind_phys -! eahxy = psfc*qv/(0.622+qv); qv is mixing ratio, converted from sepcific -! humidity specific humidity /(1.0 - specific humidity) - cmxy(ix) = zero chxy(ix) = zero fwetxy(ix) = zero diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index a622cf8f0..0c9eaf3f0 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -24,7 +24,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & imp_physics_zhao_carr_pdf, imp_physics_mg, imp_physics_wsm6, & imp_physics_fer_hires, julian, yearlen, lndp_var_list, lsswr, lslwr, & ltaerosol, lgfdlmprad, uni_cld, effr_in, do_mynnedmf, lmfshal, & - lmfdeep2, fhswr, fhlwr, solhr, sup, eps, epsm1, fvirt, & + lmfdeep2, fhswr, fhlwr, solhr, sup, con_eps, epsm1, fvirt, & rog, rocp, con_rd, xlat_d, xlat, xlon, coslat, sinlat, tsfc, slmsk, & prsi, prsl, prslk, tgrs, sfc_wts, mg_cld, effrr_in, pert_clds,sppt_wts,& sppt_amp, cnvw_in, cnvc_in, qgrs, aer_nm, dx, icloud, & !inputs from here and above @@ -103,7 +103,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & lmfshal, lmfdeep2, pert_clds real(kind=kind_phys), intent(in) :: fhswr, fhlwr, solhr, sup, julian, sppt_amp - real(kind=kind_phys), intent(in) :: eps, epsm1, fvirt, rog, rocp, con_rd + real(kind=kind_phys), intent(in) :: con_eps, epsm1, fvirt, rog, rocp, con_rd real(kind=kind_phys), dimension(:), intent(in) :: xlat_d, xlat, xlon, & coslat, sinlat, tsfc, & @@ -300,7 +300,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & !> - Compute relative humidity. es = min( prsl(i,k2), fpvs( tgrs(i,k2) ) ) ! fpvs and prsl in pa - qs = max( QMIN, eps * es / (prsl(i,k2) + epsm1*es) ) + qs = max( QMIN, con_eps * es / (prsl(i,k2) + epsm1*es) ) rhly(i,k1) = max( 0.0, min( 1.0, max(QMIN, qgrs(i,k2,ntqv))/qs ) ) qstl(i,k1) = qs enddo @@ -643,7 +643,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do i=1,IM qvs = qgrs(i,k,ntqv) qv_mp (i,k) = qvs/(1.-qvs) - rho (i,k) = 0.622*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+0.622)) + rho (i,k) = con_eps*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+con_eps)) orho (i,k) = 1.0/rho(i,k) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) @@ -658,7 +658,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & do i=1,IM qvs = qgrs(i,k,ntqv) qv_mp (i,k) = qvs/(1.-qvs) - rho (i,k) = 0.622*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+0.622)) + rho (i,k) = con_eps*prsl(i,k)/(con_rd*tgrs(i,k)*(qv_mp(i,k)+con_eps)) orho (i,k) = 1.0/rho(i,k) qc_mp (i,k) = tracer1(i,k,ntcw)/(1.-qvs) qi_mp (i,k) = tracer1(i,k,ntiw)/(1.-qvs) diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index 14403f63d..e26cdeac1 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -481,7 +481,7 @@ kind = kind_phys intent = in optional = F -[eps] +[con_eps] standard_name = ratio_of_dry_air_to_water_vapor_gas_constants long_name = rd/rv units = none diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.F90 b/physics/GFS_rrtmgp_thompsonmp_pre.F90 index c6661d948..b54f27d65 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.F90 +++ b/physics/GFS_rrtmgp_thompsonmp_pre.F90 @@ -41,7 +41,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do i_cldliq, i_cldice, i_cldrain, i_cldsnow, i_cldgrpl, i_cldtot, i_cldliq_nc, & i_cldice_nc, i_twa, effr_in, p_lev, p_lay, tv_lay, t_lay, effrin_cldliq, & effrin_cldice, effrin_cldsnow, tracer, qs_lay, q_lay, relhum, cld_frac_mg, con_g, & - con_rd, uni_cld, lmfshal, lmfdeep2, ltaerosol, do_mynnedmf, imfdeepcnv, & + con_rd, con_eps, uni_cld, lmfshal, lmfdeep2, ltaerosol, do_mynnedmf, imfdeepcnv, & imfdeepcnv_gf, doGP_cldoptics_PADE, doGP_cldoptics_LUT, & cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & cld_rerain, precip_frac, errmsg, errflg) @@ -76,7 +76,8 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do doGP_cldoptics_PADE ! (PADE approximation) real(kind_phys), intent(in) :: & con_g, & ! Physical constant: gravitational constant - con_rd ! Physical constant: gas-constant for dry air + con_rd, & ! Physical constant: gas-constant for dry air + con_eps ! Physical constant: gas constant air / gas constant H2O real(kind_phys), dimension(nCol,nLev), intent(in) :: & tv_lay, & ! Virtual temperature (K) @@ -155,7 +156,7 @@ subroutine GFS_rrtmgp_thompsonmp_pre_run(nCol, nLev, nTracers, ncnd, doSWrad, do do iLay = 1, nLev do iCol = 1, nCol qv_mp(iCol,iLay) = q_lay(iCol,iLay)/(1.-q_lay(iCol,iLay)) - rho = 0.622*p_lay(iCol,iLay)/(con_rd*t_lay(iCol,iLay)*(qv_mp(iCol,iLay)+0.622)) + rho = con_eps*p_lay(iCol,iLay)/(con_rd*t_lay(iCol,iLay)*(qv_mp(iCol,iLay)+con_eps)) orho = 1./rho qc_mp(iCol,iLay) = tracer(iCol,iLay,i_cldliq) / (1.-q_lay(iCol,iLay)) qi_mp(iCol,iLay) = tracer(iCol,iLay,i_cldice) / (1.-q_lay(iCol,iLay)) diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index 90ec59760..54d266b67 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -171,7 +171,7 @@ standard_name = effective_radius_of_stratiform_cloud_liquid_water_particle_in_um long_name = eff. radius of cloud liquid water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -180,7 +180,7 @@ standard_name = effective_radius_of_stratiform_cloud_ice_particle_in_um long_name = eff. radius of cloud ice water particle in micrometer units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -189,7 +189,7 @@ standard_name = effective_radius_of_stratiform_cloud_snow_particle_in_um long_name = effective radius of cloud snow particle in micrometers units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -247,7 +247,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -256,7 +256,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -265,7 +265,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -283,7 +283,7 @@ standard_name = saturation_vapor_pressure long_name = saturation vapor pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -292,7 +292,7 @@ standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio units = kg/kg - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -301,7 +301,7 @@ standard_name = relative_humidity long_name = layer relative humidity units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -310,7 +310,7 @@ standard_name = chemical_tracers long_name = chemical tracers units = g g-1 - dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + dimensions = (horizontal_loop_extent,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = in @@ -330,14 +330,23 @@ units = J kg-1 K-1 dimensions = () type = real - kind = kind_phys + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys intent = in - optional = F + optional = F [cld_frac] standard_name = total_cloud_fraction long_name = layer total cloud fraction units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -346,7 +355,7 @@ standard_name = cloud_liquid_water_path long_name = layer cloud liquid water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -355,7 +364,7 @@ standard_name = mean_effective_radius_for_liquid_cloud long_name = mean effective radius for liquid cloud units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -364,7 +373,7 @@ standard_name = cloud_ice_water_path long_name = layer cloud ice water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -373,7 +382,7 @@ standard_name = mean_effective_radius_for_ice_cloud long_name = mean effective radius for ice cloud units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -382,7 +391,7 @@ standard_name = cloud_snow_water_path long_name = layer cloud snow water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -391,7 +400,7 @@ standard_name = mean_effective_radius_for_snow_flake long_name = mean effective radius for snow cloud units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -400,7 +409,7 @@ standard_name = cloud_rain_water_path long_name = layer cloud rain water path units = g m-2 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -409,7 +418,7 @@ standard_name = mean_effective_radius_for_rain_drop long_name = mean effective radius for rain cloud units = um - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -418,11 +427,11 @@ standard_name = precipitation_fraction_by_layer long_name = precipitation fraction in each layer units = frac - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout - optional = F + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index a0361b6e3..93106d2de 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -650,7 +650,7 @@ end subroutine GFS_suite_interstitial_4_finalize subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_total, ntrac, ntcw, ntiw, ntclamt, & ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, ntlnc, ntinc, nn, imp_physics, imp_physics_gfdl, imp_physics_thompson, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, convert_dry_rho, dtf, save_qc, save_qi, con_pi, & - gq0, clw, prsl, save_tcp, con_rd, nwfa, spechum, dqdti, errmsg, errflg) + gq0, clw, prsl, save_tcp, con_rd, con_eps, nwfa, spechum, dqdti, errmsg, errflg) use machine, only: kind_phys use module_mp_thompson_make_number_concentrations, only: make_IceNumber, make_DropletNumber @@ -673,7 +673,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to real(kind=kind_phys), dimension(im,levs,ntrac), intent(inout) :: gq0 real(kind=kind_phys), dimension(im,levs,nn), intent(inout) :: clw real(kind=kind_phys), dimension(im,levs), intent(in) :: prsl - real(kind=kind_phys), intent(in) :: con_rd + real(kind=kind_phys), intent(in) :: con_rd, con_eps real(kind=kind_phys), dimension(:,:), intent(in) :: nwfa, save_tcp real(kind=kind_phys), dimension(im,levs), intent(in) :: spechum @@ -742,7 +742,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to !> - Convert specific humidity to dry mixing ratio qv_mp(i,k) = spechum(i,k) / (one-spechum(i,k)) !> - Density of air in kg m-3 and inverse density - rho = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+0.622)) + rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(qv_mp(i,k)+con_eps)) orho = one/rho if (ntlnc>0) then !> - Convert moist mixing ratio to dry mixing ratio @@ -768,7 +768,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to do k=1,levs do i=1,im !> - Density of air in kg m-3 and inverse density - rho = 0.622*prsl(i,k) / (con_rd*save_tcp(i,k)*(spechum(i,k)+0.622)) + rho = con_eps*prsl(i,k) / (con_rd*save_tcp(i,k)*(spechum(i,k)+con_eps)) orho = one/rho if (ntlnc>0) then !> - Update cloud water mixing ratio diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index b7c1c2f67..5b4b0dbf9 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -1858,6 +1858,15 @@ kind = kind_phys intent = in optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [nwfa] standard_name = water_friendly_aerosol_number_concentration long_name = number concentration of water-friendly aerosols diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index dd7791e18..af7d6db49 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -24,7 +24,7 @@ end subroutine shoc_finalize !! \htmlinclude shoc_run.html !! subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, & - con_pi, con_fvirt, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & + con_pi, con_fvirt, con_eps, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & cld_sgs, tke, tkh, wthv_sec, errmsg, errflg) @@ -32,7 +32,8 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ implicit none integer, intent(in) :: nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc - real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & + real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, & + con_rd, con_pi, con_fvirt, con_eps, & dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt ! real(kind=kind_phys), intent(in), dimension(nx) :: hflx, evap @@ -118,7 +119,8 @@ subroutine shoc_run (nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_ rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, & ntlnc, ncpl, ncpi, & - con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) + con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, & + con_fvirt, con_eps) if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme do k=1,nzm @@ -166,13 +168,13 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & pcrit, cefac, cesfac, tkef1, dis_opt, & cld_sgs, tke, hflx, evap, prnum, tkh, & wthv_sec, ntlnc, ncpl, ncpi, & - cp, ggr, lcond, lfus, rv, rgas, pi, epsv) + cp, ggr, lcond, lfus, rv, rgas, pi, epsv, eps) use funcphys , only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice implicit none - real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv + real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv, eps integer, intent(in) :: ix ! max number of points in the physics window in the x integer, intent(in) :: nx ! Number of points in the physics window in the x @@ -219,7 +221,7 @@ subroutine shoc_work (ix, nx, nzm, nz, dtn, & real, intent(in) :: prnum (nx,nzm) ! turbulent Prandtl number real, intent(inout) :: wthv_sec (ix,nzm) ! Buoyancy flux, K*m/s - real, parameter :: zero=0.0_kp, one=1.0_kp, half=0.5_kp, two=2.0_kp, eps=0.622_kp, & + real, parameter :: zero=0.0_kp, one=1.0_kp, half=0.5_kp, two=2.0_kp, & three=3.0_kp, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.0_kp, & nmin = 1.0_kp, RI_cub = 6.4e-14_kp, RL_cub = 1.0e-15_kp, & diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 8cb03727d..047286317 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -113,6 +113,15 @@ kind = kind_phys intent = in optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [dtp] standard_name = time_step_for_physics long_name = time step for physics diff --git a/physics/gfdl_cloud_microphys.F90 b/physics/gfdl_cloud_microphys.F90 index 1ccedb956..c41323ad5 100644 --- a/physics/gfdl_cloud_microphys.F90 +++ b/physics/gfdl_cloud_microphys.F90 @@ -113,7 +113,7 @@ end subroutine gfdl_cloud_microphys_finalize !! \htmlinclude gfdl_cloud_microphys_run.html !! subroutine gfdl_cloud_microphys_run( & - levs, im, con_g, con_fvirt, con_rd, frland, garea, islmsk, & + levs, im, con_g, con_fvirt, con_rd, con_eps, frland, garea, islmsk, & gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, gq0_ntsw, gq0_ntgl, gq0_ntclamt, & gt0, gu0, gv0, vvl, prsl, phii, del, & rain0, ice0, snow0, graupel0, prcp0, sr, & @@ -134,7 +134,7 @@ subroutine gfdl_cloud_microphys_run( & ! interface variables integer, intent(in ) :: levs, im - real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd + real(kind=kind_phys), intent(in ) :: con_g, con_fvirt, con_rd, con_eps real(kind=kind_phys), intent(in ), dimension(1:im) :: frland, garea integer, intent(in ), dimension(1:im) :: islmsk real(kind=kind_phys), intent(inout), dimension(1:im,1:levs) :: gq0, gq0_ntcw, gq0_ntrw, gq0_ntiw, & @@ -295,7 +295,7 @@ subroutine gfdl_cloud_microphys_run( & allocate(den(1:im,1:levs)) do k=1,levs do i=1,im - den(i,k)=0.622*prsl(i,k)/(con_rd*gt0(i,k)*(gq0(i,k)+0.622)) + den(i,k)=con_eps*prsl(i,k)/(con_rd*gt0(i,k)*(gq0(i,k)+con_eps)) enddo enddo call cloud_diagnosis (1, im, 1, levs, den(1:im,1:levs), & diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index 07847ed17..961a3e33f 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -168,6 +168,15 @@ kind = kind_phys intent = in optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [frland] standard_name = land_area_fraction_for_microphysics long_name = land area fraction used in microphysics schemes diff --git a/physics/gfdl_sfc_layer.F90 b/physics/gfdl_sfc_layer.F90 index 93e38c982..008e716e2 100644 --- a/physics/gfdl_sfc_layer.F90 +++ b/physics/gfdl_sfc_layer.F90 @@ -377,7 +377,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & xxfh(i), ztmax(i), z0max(i), tstrc(i), & pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & scurx(i), scury(i), pert_Cd, ens_random_seed, ens_Cdamp, upc(i), vpc(i), t1(i), q1(i), & - dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & + dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), ep2, errmsg, & errflg) if (errflg /= 0) return @@ -526,7 +526,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & xxfh(i), ztmax(i), z0max(i), tstrc(i), & pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & scurx(i), scury(i), pert_Cd, ens_random_seed, ens_Cdamp, upc(i), vpc(i), t1(i), q1(i), & - dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & + dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), ep2, errmsg, & errflg) if (errflg /= 0) return @@ -633,7 +633,7 @@ subroutine gfdl_sfc_layer_run (im, nsoil, km, xlat, xlon, flag_iter, lsm, & xxfh(i), znt_ocn(i), mznt(i), tstrc(i), & pspc(i), pkmax(i), wetc(i), slwdc(i), z1_cm(i), icoef_sf, iwavecpl, lcurr_sf, charn(i), msang(i), & scurx(i), scury(i), pert_Cd, ens_random_seed, ens_Cdamp, upc(i), vpc(i), t1(i), q1(i), & - dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), errmsg, & + dt, wind10(i), xxfh2(i), ntsflg, sfenth, tzot(i), ep2, errmsg, & errflg) if (errflg /= 0) return @@ -756,7 +756,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m icoef_sf,iwavecpl,lcurr_sf,alpha,gamma,xcur,ycur, & pert_Cd, ens_random_seed, ens_Cdamp, & upc,vpc,tpc,rpc,dt,wind10,xxfh2,ntsflg,sfenth, & - tzot, errmsg, errflg) + tzot, ep2, errmsg, errflg) !------------------------------------------------------------------------ ! @@ -819,6 +819,8 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: tpc real(kind=kind_phys), intent ( in), dimension (ims :ime ) :: rpc + real(kind=kind_phys), intent ( in) :: ep2 + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -1207,7 +1209,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m if(psps1 .EQ. 0.0)then psps1 = .1 endif - rstso(i) = 0.622*estso(i)/psps1 + rstso(i) = ep2*estso(i)/psps1 vrts (i) = 1. + boycon*ecof(i)*rstso(i) enddo @@ -1735,7 +1737,7 @@ SUBROUTINE MFLUX2( fxh,fxe,fxmx,fxmy,cdm,rib,xxfh,zoc,mzoc,tstrc, & !m if(psps2 .EQ. 0.0)then psps2 = .1 endif - rstsop(i) = 0.622*estsop(i)/psps2 + rstsop(i) = ep2*estsop(i)/psps2 rdiff (i) = amin1(0.0,(rkmaxp(i) - rstsop(i))) foft(i) = tss(i) + delsrad(i)*(slwa(i) - aap(i)*tsp(i)**4 - & diff --git a/physics/gfdl_sfc_layer.meta b/physics/gfdl_sfc_layer.meta index 77024c813..a9829fec3 100644 --- a/physics/gfdl_sfc_layer.meta +++ b/physics/gfdl_sfc_layer.meta @@ -783,6 +783,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + intent = inout + optional = F [qss_lnd] standard_name = surface_specific_humidity_over_land long_name = surface air saturation specific humidity over land @@ -790,6 +792,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + intent = inout + optional = F [qss_ice] standard_name = surface_specific_humidity_over_ice long_name = surface air saturation specific humidity over ice @@ -797,6 +801,8 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 5d5e631f5..6031af94a 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -28,9 +28,9 @@ module mp_thompson !! \section arg_table_mp_thompson_init Argument Table !! \htmlinclude mp_thompson_init.html !! - subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & - imp_physics, imp_physics_thompson, & - convert_dry_rho, & + subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, con_eps, & + restart, imp_physics, & + imp_physics_thompson, convert_dry_rho,& spechum, qc, qr, qi, qs, qg, ni, nr, & is_aerosol_aware, nc, nwfa2d, nifa2d, & nwfa, nifa, tgrs, prsl, phil, area, & @@ -43,7 +43,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & ! Interface variables integer, intent(in ) :: ncol integer, intent(in ) :: nlev - real(kind_phys), intent(in ) :: con_g, con_rd + real(kind_phys), intent(in ) :: con_g, con_rd, con_eps logical, intent(in ) :: restart integer, intent(in ) :: imp_physics integer, intent(in ) :: imp_physics_thompson @@ -160,7 +160,7 @@ subroutine mp_thompson_init(ncol, nlev, con_g, con_rd, restart, & end if ! Density of moist air in kg m-3 and inverse density of air - rho = 0.622*prsl/(con_rd*tgrs*(qv+0.622)) + rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) orho = 1.0/rho ! Ensure we have 1st guess ice number where mass non-zero but no number. @@ -324,7 +324,7 @@ end subroutine mp_thompson_init !>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & - convert_dry_rho, & + con_eps, convert_dry_rho, & spechum, qc, qr, qi, qs, qg, ni, nr, & is_aerosol_aware, nc, nwfa, nifa, & nwfa2d, nifa2d, & @@ -344,6 +344,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & integer, intent(in ) :: nlev real(kind_phys), intent(in ) :: con_g real(kind_phys), intent(in ) :: con_rd + real(kind_phys), intent(in ) :: con_eps ! Hydrometeors logical, intent(in ) :: convert_dry_rho real(kind_phys), intent(inout) :: spechum(1:ncol,1:nlev) @@ -474,7 +475,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & end if !> - Density of air in kg m-3 - rho = 0.622*prsl/(con_rd*tgrs*(qv+0.622)) + rho = con_eps*prsl/(con_rd*tgrs*(qv+con_eps)) !> - Convert omega in Pa s-1 to vertical velocity w in m s-1 w = -omega/(rho*con_g) diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index ed54f8d02..7f1e9197e 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -41,6 +41,15 @@ kind = kind_phys intent = in optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [restart] standard_name = flag_for_restart long_name = flag for restart (warmstart) or coldstart @@ -349,6 +358,15 @@ kind = kind_phys intent = in optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [convert_dry_rho] standard_name = flag_for_converting_hydrometeors_from_moist_to_dry_air long_name = flag for converting hydrometeors from moist to dry air From 21df4016f4d435ed531b773e80b462d57e1f4213 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 31 Mar 2021 20:11:05 -0600 Subject: [PATCH 271/274] Fix CODEOWNERS --- CODEOWNERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CODEOWNERS b/CODEOWNERS index 0d5230f89..b6c597371 100644 --- a/CODEOWNERS +++ b/CODEOWNERS @@ -3,7 +3,7 @@ # These owners will be the default owners for everything in the repo. #* @defunkt -* @climbfuji @llpcarson @grantfirl @JulieSchramm +* @DomHeinzeller # Order is important. The last matching pattern has the most precedence. # So if a pull request only touches javascript files, only these owners From 59e807567f9220e7f8f39782a4ed7ade1f5d298f Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 8 Apr 2021 08:34:45 -0600 Subject: [PATCH 272/274] Bug fixes in physics/GFS_rrtmg_pre.F90 physics/GFS_rrtmg_pre.meta from merge with gsl/develop --- physics/GFS_rrtmg_pre.F90 | 5 ++++- physics/GFS_rrtmg_pre.meta | 17 +++++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index b7c92a798..2f94498e3 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -33,7 +33,7 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & gasvmr_o2, gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, gasvmr_cfc22, & gasvmr_ccl4, gasvmr_cfc113, aerodp, clouds6, clouds7, clouds8, & clouds9, cldsa, cldfra, faersw1, faersw2, faersw3, faerlw1, faerlw2, & - faerlw3, alpha, errmsg, errflg) + faerlw3, alpha, cplchm_rad_opt, faersw_cpl, errmsg, errflg) use machine, only: kind_phys @@ -169,6 +169,9 @@ subroutine GFS_rrtmg_pre_run (im, levs, lm, lmk, lmp, n_var_lndp, & faerlw3 real(kind=kind_phys), dimension(im,lm+LTP), intent(out) :: alpha + logical, intent(in) :: cplchm_rad_opt + real(kind=kind_phys), dimension(im,lm+LTP,14,NF_AESW), intent(in) :: faersw_cpl + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/GFS_rrtmg_pre.meta b/physics/GFS_rrtmg_pre.meta index e26cdeac1..6ecbd573c 100644 --- a/physics/GFS_rrtmg_pre.meta +++ b/physics/GFS_rrtmg_pre.meta @@ -1177,6 +1177,23 @@ kind = kind_phys intent = out optional = F +[cplchm_rad_opt] + standard_name = flag_for_chemistry_coupling_radiation_feedback + long_name = flag controlling cplchm radiation feedback + units = flag + dimensions = () + type = logical + intent = in + optional = F +[faersw_cpl] + standard_name = gsdchem_aerosol_optical_properties_for_shortwave_bands_01_14 + long_name = gsdchem aerosol optical properties for shortwave bands 01-14 + units = various + dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation,14,3) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 6ac62720adbd33b7d62de97540e48c9bdc60939c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 8 Apr 2021 08:36:24 -0600 Subject: [PATCH 273/274] Bugfixes for uninitialized variables in several files --- gsdchem/gsd_chem_dust_wrapper.F90 | 13 ++++++++++--- physics/samfaerosols.F | 3 ++- physics/samfdeepcnv.f | 3 +++ physics/samfshalcnv.f | 4 ++++ 4 files changed, 19 insertions(+), 4 deletions(-) diff --git a/gsdchem/gsd_chem_dust_wrapper.F90 b/gsdchem/gsd_chem_dust_wrapper.F90 index d476cbd88..ad8c03c40 100644 --- a/gsdchem/gsd_chem_dust_wrapper.F90 +++ b/gsdchem/gsd_chem_dust_wrapper.F90 @@ -128,6 +128,9 @@ subroutine gsd_chem_dust_wrapper_run(im, kte, kme, ktau, dt, garea, land, & dust_opt = dust_opt_in dust_calcdrag = dust_calcdrag_in + ! -- initialize dust emissions + emis_dust = 0._kind_phys + ! -- set domain ide=im ime=im @@ -178,7 +181,7 @@ subroutine gsd_chem_dust_wrapper_run(im, kte, kme, ktau, dt, garea, land, & dust_gamma = afwa_gamma call gocart_dust_afwa_driver(ktau,dt,rri,t_phy,moist,u_phy, & v_phy,chem,rho_phy,dz8w,smois,u10,v10,p8w,erod,ivgtyp,isltyp, & - vegfrac,xland,xlat,xlong,gsw,dxy,g,emis_dust,srce_dust, & + vegfrac,xland,xlat,xlong,gsw,dxy,g,emis_dust,srce_dust, & dusthelp,ust,znt,clayf,sandf, & num_emis_dust,num_moist,num_chem,nsoil, & ids,ide, jds,jde, kds,kde, & @@ -189,7 +192,7 @@ subroutine gsd_chem_dust_wrapper_run(im, kte, kme, ktau, dt, garea, land, & dust_alpha = dust_alpha_in !fengsha_alpha dust_gamma = dust_gamma_in !fengsha_gamma call gocart_dust_fengsha_driver(dt,chem,rho_phy,smois,p8w,ssm, & - isltyp,vegfrac,snowh,xland,dxy,g,emis_dust,ust,znt, & + isltyp,vegfrac,snowh,xland,dxy,g,emis_dust,ust,znt, & clayf,sandf,rdrag,uthr, & num_emis_dust,num_moist,num_chem,nsoil, & random_factor, & @@ -202,12 +205,16 @@ subroutine gsd_chem_dust_wrapper_run(im, kte, kme, ktau, dt, garea, land, & dust_gamma = gocart_gamma call gocart_dust_driver(chem_opt,ktau,dt,rri,t_phy,moist,u_phy, & v_phy,chem,rho_phy,dz8w,smois,u10,v10,p8w,erod,ivgtyp,isltyp, & - vegfrac,xland,xlat,xlong,gsw,dxy,g,emis_dust,srce_dust, & + vegfrac,xland,xlat,xlong,gsw,dxy,g,emis_dust,srce_dust, & dusthelp,num_emis_dust,num_moist,num_chem,nsoil, & current_month, & ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte) + case default + errmsg = 'Logic error in gsd_chem_dust_wrapper_run: invalid dust_opt' + errflg = 1 + return !store_arrays = .true. end select diff --git a/physics/samfaerosols.F b/physics/samfaerosols.F index 24a281064..99436e9bb 100644 --- a/physics/samfaerosols.F +++ b/physics/samfaerosols.F @@ -70,9 +70,9 @@ subroutine samfdeepcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, c -- initialize work variables km1 = km - 1 + wet_dep = zero chem_c = zero chem_pw = zero - !wet_dep = zero ctro2 = zero dellae2 = zero ecdo2 = zero @@ -471,6 +471,7 @@ subroutine samfshalcnv_aerosols(im, ix, km, itc, ntc, ntr, delt, c -- initialize work variables km1 = km - 1 + wet_dep = zero chem_c = zero chem_pw = zero ctro2 = zero diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 2cc025ab0..1a8ceabef 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -271,6 +271,9 @@ subroutine samfdeepcnv_run (im,km,itc,ntc,cliq,cp,cvap, & errmsg = '' errflg = 0 +! Initialize local variables + xmb = 0.0 + xmbmax = 0.0 elocp = hvap/cp el2orc = hvap*hvap/(rv*cp) diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index f84e3488c..4918e96f4 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -212,6 +212,10 @@ subroutine samfshalcnv_run(im,km,itc,ntc,cliq,cp,cvap, & cinacrmn=-80. endif +! Initialize local variables + xmb = 0.0 + xmbmax = 0.0 + c----------------------------------------------------------------------- if (.not.hwrf_samfshal) then !> ## Determine whether to perform aerosol transport From 471a66a720e2d2a8527adde6259c990e7c399102 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 8 Apr 2021 08:36:45 -0600 Subject: [PATCH 274/274] Comment out weird errflg logic in physics/GFS_PBL_generic.F90 --- physics/GFS_PBL_generic.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index 6bcb26acc..075745c64 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -247,11 +247,11 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, imp_physics_mg, ntgl, imp_physics_gfdl, & imp_physics_zhao_carr, kk, & errmsg, errflg) - if (cplchm) then + !if (cplchm) then if (errflg==1) return - else - if (.not.errflg==1) return - endif + !else + ! if (.not.errflg==1) return + !endif ! k1 = kk do n=ntchs,ntchm+ntchs-1 @@ -408,11 +408,11 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, imp_physics_mg, ntgl, imp_physics_gfdl, & imp_physics_zhao_carr, kk, & errmsg, errflg) - if (cplchm) then + !if (cplchm) then if (errflg==1) return - else - if (.not.errflg==1) return - endif + !else + ! if (.not.errflg==1) return + !endif ! k1 = kk do n=ntchs,ntchm+ntchs-1